282 files changed, 181399 insertions, 0 deletions

diff --git a/COPYING b/COPYING
new file mode 100644
index 000000000..d60c31a97
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,340 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    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
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year  name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/back_end.adb b/back_end.adb
new file mode 100644
index 000000000..034aa23eb
--- /dev/null
+++ b/back_end.adb
@@ -0,0 +1,37 @@
+--  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 GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Flags;
+with Types; use Types;
+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 Flags.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";
+      end case;
+   end Default_Library_To_File_Name;
+end Back_End;
diff --git a/back_end.ads b/back_end.ads
new file mode 100644
index 000000000..3ff6fb1f7
--- /dev/null
+++ b/back_end.ads
@@ -0,0 +1,53 @@
+--  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 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 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;
+
+   --  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;
+
+   --procedure Finish_Compilation
+   --  (Unit : Iir_Design_Unit; Main : Boolean := False);
+end Back_End;
+
diff --git a/bug.adb b/bug.adb
new file mode 100644
index 000000000..770114ea8
--- /dev/null
+++ b/bug.adb
@@ -0,0 +1,73 @@
+--  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 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.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.
+   GNAT_Version : constant String (1 .. 31);
+   pragma Import (C, GNAT_Version, "__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 to ghdl@free.fr, with all the output.");
+      Put_Line (Standard_Error, "GHDL version: " & Ghdl_Version);
+      Put_Line (Standard_Error, "Compiled with " & 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/bug.ads b/bug.ads
new file mode 100644
index 000000000..ce57a35a7
--- /dev/null
+++ b/bug.ads
@@ -0,0 +1,22 @@
+--  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 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.Exceptions; use Ada.Exceptions;
+
+package Bug is
+   procedure Disp_Bug_Box (Except : Exception_Occurrence);
+end Bug;
diff --git a/canon.adb b/canon.adb
new file mode 100644
index 000000000..1ac67b4e5
--- /dev/null
+++ b/canon.adb
@@ -0,0 +1,2316 @@
+--  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 GCC; 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 Std_Names;
+with Types; use Types;
+with Iir_Chains; use Iir_Chains;
+with Flags;
+
+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);
+
+   --  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)
+     return Iir;
+
+   function Canon_Association_Chain_And_Actuals
+     (Interface_Chain : Iir; Association_Chain : Iir)
+     return 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);
+
+   function Is_Signal_Object (Decl: Iir) return Boolean is
+      Adecl: Iir;
+   begin
+      Adecl := Get_Base_Name (Decl);
+      case Get_Kind (Adecl) is
+         when Iir_Kind_Variable_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Constant_Interface_Declaration =>
+            return False;
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Signal_Interface_Declaration =>
+            return True;
+         when others =>
+            Error_Kind ("is_signal_object", Adecl);
+      end case;
+   end Is_Signal_Object;
+
+   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 (Assoc), Sensitivity_List, Is_Target);
+            Assoc := Get_Chain (Assoc);
+         end loop;
+      else
+         while Assoc /= Null_Iir loop
+            Canon_Extract_Sensitivity_Aggregate
+              (Get_Associated (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 =>
+            --  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_Signal_Interface_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_Constant_Interface_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Variable_Interface_Declaration =>
+            null;
+
+         when Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_High_Array_Attribute =>
+            null;
+            --Canon_Extract_Sensitivity
+            --  (Get_Prefix (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 (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;
+
+--   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;
+
+   -- 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_Name =>
+--             -- Use this order to allow tail recursion optimisation.
+--             Canon_Expression (Get_Suffix (Expr));
+--             Canon_Expression (Get_Prefix (Expr));
+         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_Kind_Simple_Name
+           | Iir_Kind_Selected_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 =>
+            declare
+               Imp : Iir;
+               Assoc_Chain : Iir;
+            begin
+               Imp := Get_Implementation (Expr);
+               if Get_Kind (Imp) /= Iir_Kind_Implicit_Function_Declaration then
+                  Assoc_Chain := Canon_Association_Chain_And_Actuals
+                    (Get_Interface_Declaration_Chain (Imp),
+                     Get_Parameter_Association_Chain (Expr));
+                  Set_Parameter_Association_Chain (Expr, Assoc_Chain);
+               else
+                  -- FIXME:
+                  -- should canon concatenation.
+                  null;
+               end if;
+            end;
+         when Iir_Kind_Type_Conversion
+           | Iir_Kind_Qualified_Expression =>
+            Canon_Expression (Get_Expression (Expr));
+         when Iir_Kind_Aggregate =>
+            --  FIXME
+            null;
+         when Iir_Kind_Allocator_By_Expression =>
+            Canon_Expression (Get_Expression (Expr));
+         when Iir_Kind_Allocator_By_Subtype =>
+            null;
+
+         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 : Iir;
+            begin
+               Prefix := Get_Prefix (Expr);
+               case Get_Kind (Prefix) is
+                  when Iir_Kind_Type_Declaration
+                    | Iir_Kind_Subtype_Declaration =>
+                     null;
+                  when others =>
+                     Canon_Expression (Prefix);
+               end case;
+            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_Signal_Interface_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Constant_Interface_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_File_Interface_Declaration
+           | Iir_Kind_Object_Alias_Declaration =>
+            null;
+
+         when Iir_Kind_Enumeration_Literal =>
+            null;
+
+         when Iir_Kind_Element_Declaration =>
+            null;
+
+         when Iir_Kind_Attribute_Value =>
+            null;
+
+         when others =>
+            Error_Kind ("canon_expression", Expr);
+            null;
+      end case;
+   end Canon_Expression;
+
+   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)
+     return Iir
+   is
+      -- The canon list of association.
+      N_Chain, Last : Iir;
+      Interface : 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
+         if Association_Chain /= Null_Iir then
+            raise Internal_Error;
+         end if;
+         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.
+      Interface := Interface_Chain;
+      while Interface /= 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, Interface);
+            end if;
+            if Get_Associated_Formal (Assoc_El) = Interface 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 others =>
+                     Error_Kind ("canon_association_list", 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);
+         --  FIXME: association_list can be null_iir_list!
+         --Location_Copy (Assoc_El, Association_List);
+         Set_Formal (Assoc_El, Interface);
+         Sub_Chain_Append (N_Chain, Last, Assoc_El);
+
+         << Done >> null;
+         Interface := Get_Chain (Interface);
+      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)
+     return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Canon_Association_Chain (Interface_Chain, Association_Chain);
+      Canon_Association_Chain_Actuals (Res);
+      return Res;
+   end Canon_Association_Chain_And_Actuals;
+
+   function Canon_Subprogram_Call (Call : Iir) return Iir
+   is
+      Imp : Iir;
+      Assoc_Chain : Iir;
+      Inter_Chain : Iir;
+   begin
+      Imp := Get_Implementation (Call);
+      Inter_Chain := Get_Interface_Declaration_Chain (Imp);
+      Assoc_Chain := Get_Parameter_Association_Chain (Call);
+      Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain);
+      Set_Parameter_Association_Chain (Call, Assoc_Chain);
+      return Assoc_Chain;
+   end Canon_Subprogram_Call;
+
+   --  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_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_Procedure_Call (Call : Iir_Procedure_Call)
+   is
+      Assoc_Chain : Iir;
+   begin
+      Assoc_Chain := Canon_Association_Chain_And_Actuals
+        (Get_Interface_Declaration_Chain (Get_Implementation (Call)),
+         Get_Parameter_Association_Chain (Call));
+      Set_Parameter_Association_Chain (Call, Assoc_Chain);
+   end Canon_Procedure_Call;
+
+   procedure Canon_Sequential_Stmts (First : Iir)
+   is
+      Stmt: Iir;
+      Expr: Iir;
+      Prev_Loop : Iir;
+      Label : 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 (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;
+               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 =>
+               Expr := Get_Condition (Stmt);
+               if Expr /= Null_Iir then
+                  Canon_Expression (Expr);
+               end if;
+               Label := Get_Loop (Stmt);
+               if Label = Null_Iir then
+                  Set_Loop (Stmt, Cur_Loop);
+               end if;
+
+            when Iir_Kind_Procedure_Call_Statement =>
+               Canon_Procedure_Call (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;
+
+   procedure Add_Driver_For_Signal (Driver_List : Iir_List;
+                                    Signal : Iir)
+   is
+      Choice : Iir;
+   begin
+      if Get_Kind (Signal) = Iir_Kind_Aggregate then
+         Choice := Get_Association_Choices_Chain (Signal);
+         while Choice /= Null_Iir loop
+            Add_Driver_For_Signal (Driver_List, Get_Associated (Choice));
+            Choice := Get_Chain (Choice);
+         end loop;
+      else
+         Add_Element (Driver_List, Get_Longuest_Static_Prefix (Signal));
+      end if;
+   end Add_Driver_For_Signal;
+
+   -- 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: in out 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);
+
+      --  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));
+
+      Set_Driver_List (Proc, Create_Iir_List);
+      Add_Driver_For_Signal (Get_Driver_List (Proc), Get_Target (Stmt));
+
+      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_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_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,t hen 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 : Iir_Procedure_Call;
+      Assoc_Chain : Iir;
+      Assoc : Iir;
+      Imp : Iir;
+      Driver_List : Iir_Driver_List;
+      Interface : Iir;
+      Sensitivity_List : Iir_List;
+      Is_Sensitized : Boolean;
+   begin
+      Call := Get_Procedure_Call (El);
+      Imp := Get_Implementation (Call);
+
+      --  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));
+
+      --  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_Procedure_Call (Call_Stmt, Call);
+      Assoc_Chain := Canon_Association_Chain
+        (Get_Interface_Declaration_Chain (Imp),
+         Get_Parameter_Association_Chain (Call));
+      Set_Parameter_Association_Chain (Call, Assoc_Chain);
+      Driver_List := Null_Iir_List;
+      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 =>
+               Interface := Get_Associated_Formal (Assoc);
+               if Get_Mode (Interface) in Iir_In_Modes then
+                  Canon_Extract_Sensitivity
+                    (Get_Actual (Assoc), Sensitivity_List, False);
+               end if;
+               --  LRM 2.1.1.2 Signal Parameters
+               if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration
+                 and then Get_Mode (Interface) in Iir_Out_Modes
+               then
+                  if Driver_List = Null_Iir_List then
+                     Driver_List := Create_Iir_List;
+                     Set_Driver_List (Proc, Driver_List);
+                  end if;
+                  Add_Element
+                    (Driver_List,
+                     Get_Longuest_Static_Prefix (Get_Actual (Assoc)));
+               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 Get_Nbr_Elements (Sensitivity_List) = 0 then
+         Destroy_Iir_List (Sensitivity_List);
+      end if;
+      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;
+
+   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);
+         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);
+            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_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 (Selected_Waveform);
+         if Assoc /= Null_Iir then
+            Stmt := Canon_Wave_Transform (Conc_Stmt, Assoc, Proc);
+            Set_Associated (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
+           and then 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;
+
+         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));
+
+               --  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);
+               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;
+
+            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
+                    (Get_Generic_Chain (Inst),
+                     Get_Generic_Map_Aspect_Chain (El));
+                  Set_Generic_Map_Aspect_Chain (El, Assoc_Chain);
+
+                  Assoc_Chain := Canon_Association_Chain
+                    (Get_Port_Chain (Inst),
+                     Get_Port_Map_Aspect_Chain (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
+                          (Get_Generic_Chain (Header), 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
+                          (Get_Port_Chain (Header), 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 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;
+      Unit : 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
+               Unit := Aspect;
+            else
+               Unit := Get_Entity (Aspect);
+            end if;
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Unit := Get_Configuration (Aspect);
+         when Iir_Kind_Entity_Aspect_Open =>
+            Unit := Null_Iir;
+         when others =>
+            Error_Kind ("add_binding_indication_dependence", Aspect);
+      end case;
+      if Unit /= Null_Iir then
+         Add_Dependence (Top, Unit);
+      end if;
+   end Add_Binding_Indication_Dependence;
+
+   procedure Canon_Component_Configuration (Top : Iir_Design_Unit; Cfg : Iir)
+   is
+      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_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
+               Map_Chain := Get_Default_Generic_Map_Aspect_Chain (Bind);
+            else
+               Map_Chain := Canon_Association_Chain
+                 (Get_Generic_Chain (Entity), 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
+               Map_Chain := Get_Default_Port_Map_Aspect_Chain (Bind);
+            else
+               Map_Chain := Canon_Association_Chain
+                 (Get_Port_Chain (Entity), 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_Library_Unit (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_Associated_Formal (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_Associated_Formal (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.
+            if Get_Associated_Formal (F_El) /= Inter then
+               raise Internal_Error;
+            end if;
+            --  Find the associated in the second chain.
+            S_El := Sec_Chain;
+            while S_El /= Null_Iir loop
+               exit when Get_Associated_Formal (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;
+      Res_Binding : Iir_Binding_Indication;
+      Entity : Iir;
+      Instance_List : Iir_List;
+      Conf_Instance_List : Iir_List;
+      Instance : 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.
+      Set_Generic_Map_Aspect_Chain
+        (Res_Binding,
+         Merge_Association_Chain (Get_Generic_Chain (Entity),
+                                  Get_Generic_Map_Aspect_Chain (Cs_Binding),
+                                  Get_Generic_Map_Aspect_Chain (Cc_Binding)));
+
+      --  merge port map aspect
+      Set_Port_Map_Aspect_Chain
+        (Res_Binding,
+         Merge_Association_Chain (Get_Port_Chain (Entity),
+                                  Get_Port_Map_Aspect_Chain (Cs_Binding),
+                                  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 := Get_Nth_Element (Conf_Instance_List, I);
+         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);
+         else
+            Replace_Nth_Element (Conf_Instance_List, N_Nbr, Instance);
+            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 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, 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 Flags.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;
+         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 : Iir_List;
+      List : Iir_Designator_List;
+   begin
+      Spec := Get_Instantiation_List (Conf);
+
+      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_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;
+   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;
+      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) = Get_Type (Dis)
+           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_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 (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_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 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;
+      El : Iir;
+      Spec : Iir;
+      Stmts : Iir;
+      Blk : 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?
+      Spec := Get_Block_Specification (Conf);
+      Blk := Get_Block_From_Block_Specification (Spec);
+      Stmts := Get_Concurrent_Statement_Chain (Blk);
+
+      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 := 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 := 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;
+                  Comp : Iir;
+                  Res : Iir_Component_Configuration;
+                  Designator_List : Iir_List;
+                  Inst_List : Iir_List;
+                  Inst : Iir;
+               begin
+                  Comp_Conf := Get_Component_Configuration (El);
+                  if Comp_Conf = Null_Iir then
+                     Comp := Get_Instantiated_Unit (El);
+                     if Get_Kind (Comp) = Iir_Kind_Component_Declaration 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, Comp);
+                        Designator_List := Create_Iir_List;
+                        Append_Element (Designator_List, 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 := Get_Nth_Element (Inst_List, I);
+                        if Get_Component_Configuration (Inst) = Comp_Conf
+                          and then Get_Parent (Inst) = Blk
+                        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, 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 := 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_Selected_Name);
+                        Location_Copy (Blk_Spec, Res);
+                        Set_Suffix_Identifier
+                          (Blk_Spec, Std_Names.Name_Others);
+                        Set_Prefix (Blk_Spec, El);
+                        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 =>
+               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 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;
+         end loop;
+      end if;
+
+      El := Get_Library_Unit (Unit);
+      case Get_Kind (El) is
+         when Iir_Kind_Entity_Declaration =>
+            Canon_Declarations (Unit, El, El);
+            Canon_Concurrent_Stmts (Unit, El);
+         when Iir_Kind_Architecture_Declaration =>
+            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 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_Declaration)
+     return Iir_Design_Unit
+   is
+      Loc : Location_Type;
+      Config : Iir_Configuration_Declaration;
+      Res : Iir_Design_Unit;
+      Entity : Iir_Entity_Declaration;
+      Blk_Cfg : Iir_Block_Configuration;
+   begin
+      Loc := Get_Location (Arch);
+      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);
+      Entity := Get_Entity (Arch);
+      Set_Entity (Config, Get_Design_Unit (Entity));
+      Set_Dependence_List (Res, Create_Iir_List);
+      Add_Dependence (Res, Get_Design_Unit (Entity));
+      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/canon.ads b/canon.ads
new file mode 100644
index 000000000..fe30b4569
--- /dev/null
+++ b/canon.ads
@@ -0,0 +1,61 @@
+--  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 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 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, 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_Declaration)
+     return Iir_Design_Unit;
+
+   --  Canonicalize a subprogram call.
+   --  Return the new association chain.
+   function Canon_Subprogram_Call (Call : Iir) return 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);
+end Canon;
diff --git a/configuration.adb b/configuration.adb
new file mode 100644
index 000000000..8192ac2b3
--- /dev/null
+++ b/configuration.adb
@@ -0,0 +1,548 @@
+--  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 GCC; 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;
+
+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);
+
+   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;
+
+      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) = Iir_Kind_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_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_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_Declaration =>
+            --  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");
+                  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 =>
+               declare
+                  Unit : Iir;
+               begin
+                  Unit := Get_Instantiated_Unit (Stmt);
+                  if Get_Kind (Unit) /= Iir_Kind_Component_Declaration then
+                     Add_Design_Aspect (Unit);
+                  end if;
+               end;
+            when Iir_Kind_Generate_Statement
+              | Iir_Kind_Block_Statement =>
+               Add_Design_Concurrent_Stmts (Stmt);
+            when Iir_Kind_Process_Statement
+              | Iir_Kind_Sensitized_Process_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)
+   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 =>
+            Entity := Get_Entity (Aspect);
+            Entity_Lib := Get_Library_Unit (Entity);
+            Add_Design_Unit (Entity, Aspect);
+            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_Declaration =>
+                     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);
+            Config := Get_Default_Configuration_Declaration
+              (Get_Library_Unit (Arch));
+            if Config /= Null_Iir then
+               Add_Design_Unit (Config, Aspect);
+            end if;
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Add_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_Unconstrained_Array_Type_Definition
+            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_Formal (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;
+         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_Base_Name (Get_Formal (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_Base_Name (Get_Formal (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);
+               end if;
+               if Actual /= Null_Iir then
+                  Actual := Get_Base_Name (Actual);
+               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_Base_Name (Get_Formal (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_Base_Name (Get_Formal (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.
+   procedure Add_Design_Binding_Indication (Conf : Iir)
+   is
+      Bind : Iir_Binding_Indication;
+      Inst : Iir;
+   begin
+      Bind := Get_Binding_Indication (Conf);
+      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));
+   end Add_Design_Binding_Indication;
+
+   procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration)
+   is
+      Item : 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);
+            when Iir_Kind_Component_Configuration =>
+               Add_Design_Binding_Indication (Item);
+               Add_Design_Block_Configuration (Get_Block_Configuration (Item));
+            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_Declaration;
+               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;
+
+end Configuration;
diff --git a/configuration.ads b/configuration.ads
new file mode 100644
index 000000000..081099876
--- /dev/null
+++ b/configuration.ads
@@ -0,0 +1,49 @@
+--  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 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 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;
+end Configuration;
diff --git a/disp_tree.adb b/disp_tree.adb
new file mode 100644
index 000000000..6b3203f33
--- /dev/null
+++ b/disp_tree.adb
@@ -0,0 +1,1853 @@
+--  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 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 System.Storage_Elements;
+with Ada.Unchecked_Conversion;
+with Types; use Types;
+with Name_Table;
+with Iirs_Utils; use Iirs_Utils;
+with Tokens;
+with Errorout;
+with Files_Map;
+
+package body Disp_Tree is
+   procedure Disp_Tab (Tab: Natural) is
+      Blanks : String (1 .. Tab) := (others => ' ');
+   begin
+      Put (Blanks);
+   end Disp_Tab;
+
+   function Addr_Image (A : System.Address) return String is
+      Res : String (1 .. System.Address'Size / 4);
+      Hex_Digits : constant array (Integer range 0 .. 15) of Character
+        := "0123456789abcdef";
+      use System;
+      use System.Storage_Elements;
+      Addr_Num : Integer_Address := To_Integer (A);
+   begin
+      for I in reverse Res'Range loop
+         Res (I) := Hex_Digits (Integer (Addr_Num mod 16));
+         Addr_Num := Addr_Num / 16;
+      end loop;
+      return Res;
+   end Addr_Image;
+
+   procedure Disp_Iir_Address (Node: Iir)
+   is
+      function To_Addr is new Ada.Unchecked_Conversion
+        (Source => Iir, Target => System.Address);
+   begin
+      Put ('[' & Addr_Image (To_Addr (Node)) & ']');
+   end Disp_Iir_Address;
+
+   function Inc_Tab (Tab: Natural) return Natural is
+   begin
+      return Tab + 4;
+   end Inc_Tab;
+
+
+   -- For iir.
+
+   procedure Disp_Tree_Flat (Tree: Iir; Tab: Natural);
+
+   procedure Disp_Tree_List
+     (Tree_List: Iir_List; Tab: Natural; Flat_Decl : Boolean := False)
+   is
+      El: Iir;
+   begin
+      if Tree_List = Null_Iir_List then
+         Disp_Tab (Tab);
+         Put_Line (" null-list");
+      elsif Tree_List = Iir_List_All then
+         Disp_Tab (Tab);
+         Put_Line (" list-all");
+      elsif Tree_List = Iir_List_Others then
+         Disp_Tab (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 (El, Tab, Flat_Decl);
+         end loop;
+      end if;
+   end Disp_Tree_List;
+
+   procedure Disp_Tree_Chain
+     (Tree_Chain: Iir; Tab: Natural; Flat_Decl : Boolean := False)
+   is
+      El: Iir;
+   begin
+      El := Tree_Chain;
+      while El /= Null_Iir loop
+         Disp_Tree (El, Tab, Flat_Decl);
+         El := Get_Chain (El);
+      end loop;
+   end Disp_Tree_Chain;
+
+   procedure Disp_Tree_Flat_Chain (Tree_Chain: Iir; Tab: Natural)
+   is
+      El: Iir;
+   begin
+      El := Tree_Chain;
+      while El /= Null_Iir loop
+         Disp_Tree_Flat (El, Tab);
+         El := Get_Chain (El);
+      end loop;
+   end 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
+         Disp_Tab (Tab);
+         Put_Line (" null-list");
+      elsif Tree_List = Iir_List_All then
+         Disp_Tab (Tab);
+         Put_Line (" list-all");
+      elsif Tree_List = Iir_List_Others then
+         Disp_Tab (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;
+
+   procedure Disp_Ident (Ident: Name_Id)
+   is
+      use Name_Table;
+   begin
+      if Ident /= Null_Identifier then
+         Image (Ident);
+         Put_Line (" '" & Name_Buffer (1 .. Name_Length) & ''');
+      else
+         Put_Line (" <anonymous>");
+      end if;
+   end Disp_Ident;
+
+   procedure Disp_Tree_Flat (Tree: Iir; Tab: Natural)
+   is
+      procedure Disp_Identifier (Identifying: Iir)
+      is
+         Ident : Name_Id;
+      begin
+         if Identifying /= Null_Iir then
+            Ident := Get_Identifier (Identifying);
+            Disp_Ident (Ident);
+         else
+            New_Line;
+         end if;
+      end Disp_Identifier;
+
+      procedure Disp_Decl_Ident
+      is
+         A_Type: Iir;
+      begin
+         A_Type := Get_Type_Declarator (Tree);
+         if A_Type /= Null_Iir then
+            Disp_Identifier (A_Type);
+         else
+            Put_Line (" <unnamed>");
+            return;
+         end if;
+      end Disp_Decl_Ident;
+   begin
+      Disp_Tab (Tab);
+      Disp_Iir_Address (Tree);
+
+      if Tree = Null_Iir then
+         Put_Line (" *NULL*");
+         return;
+      else
+         Put (' ');
+      end if;
+
+      case Get_Kind (Tree) is
+         when Iir_Kind_Design_File =>
+            Put_Line ("design file");
+
+         when Iir_Kind_Design_Unit =>
+            Put ("design_unit");
+            Disp_Identifier (Tree);
+
+         when Iir_Kind_Use_Clause =>
+            Put_Line ("use_clause");
+
+         when Iir_Kind_Library_Clause =>
+            Put ("library clause");
+            Disp_Identifier (Tree);
+
+         when Iir_Kind_Library_Declaration =>
+            Put ("library declaration");
+            Disp_Identifier (Tree);
+
+         when Iir_Kind_Proxy =>
+            Put_Line ("proxy");
+
+         when Iir_Kind_Waveform_Element =>
+            Put_Line ("waveform_element");
+
+         when Iir_Kind_Package_Declaration =>
+            Put ("package_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Package_Body =>
+            Put ("package_body");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Entity_Declaration =>
+            Put ("entity_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Architecture_Declaration =>
+            Put ("architecture_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Configuration_Declaration =>
+            Put ("configuration_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Function_Declaration =>
+            Put ("function_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Function_Body =>
+            Put_Line ("function_body");
+         when Iir_Kind_Procedure_Declaration =>
+            Put ("procedure_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Procedure_Body =>
+            Put_Line ("procedure_body");
+         when Iir_Kind_Object_Alias_Declaration =>
+            Put ("object_alias_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            Put ("non_object_alias_declaration");
+            Disp_Identifier (Tree);
+
+         when Iir_Kind_Signal_Interface_Declaration =>
+            Put ("signal_interface_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Signal_Declaration =>
+            Put ("signal_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Variable_Interface_Declaration =>
+            Put ("variable_interface_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Variable_Declaration =>
+            if Get_Shared_Flag (Tree) then
+               Put ("(shared) ");
+            end if;
+            Put ("variable_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Constant_Interface_Declaration =>
+            Put ("constant_interface_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Constant_Declaration =>
+            Put ("constant_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Iterator_Declaration =>
+            Put ("iterator_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_File_Interface_Declaration =>
+            Put ("file_interface_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_File_Declaration =>
+            Put ("file_declaration");
+            Disp_Identifier (Tree);
+
+         when Iir_Kind_Type_Declaration =>
+            Put ("type_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            Put ("anonymous_type_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Subtype_Declaration =>
+            Put ("subtype_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Component_Declaration =>
+            Put ("component_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Element_Declaration =>
+            Put ("element_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Attribute_Declaration =>
+            Put ("attribute_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Group_Template_Declaration =>
+            Put ("group_template_declaration");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Group_Declaration =>
+            Put ("group_declaration");
+            Disp_Identifier (Tree);
+
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Put ("enumeration_type_definition");
+            Disp_Decl_Ident;
+         when Iir_Kind_Enumeration_Subtype_Definition =>
+            Put ("enumeration_subtype_definition");
+            Disp_Decl_Ident;
+         when Iir_Kind_Integer_Subtype_Definition =>
+            Put ("integer_subtype_definition");
+            Disp_Decl_Ident;
+         when Iir_Kind_Integer_Type_Definition =>
+            Put ("integer_type_definition");
+            Disp_Identifier (Get_Type_Declarator (Tree));
+         when Iir_Kind_Floating_Subtype_Definition =>
+            Put ("floating_subtype_definition");
+            Disp_Decl_Ident;
+         when Iir_Kind_Floating_Type_Definition =>
+            Put ("floating_type_definition");
+            Disp_Identifier (Get_Type_Declarator (Tree));
+         when Iir_Kind_Array_Subtype_Definition =>
+            Put ("array_subtype_definition");
+            Disp_Decl_Ident;
+         when Iir_Kind_Array_Type_Definition =>
+            Put ("array_type_definition");
+            Disp_Decl_Ident;
+         when Iir_Kind_Record_Type_Definition =>
+            Put ("record_type_definition");
+            Disp_Decl_Ident;
+         when Iir_Kind_Access_Type_Definition =>
+            Put ("access_type_definition");
+            Disp_Decl_Ident;
+         when Iir_Kind_File_Type_Definition =>
+            Put ("file_type_definition");
+            Disp_Identifier (Get_Type_Declarator (Tree));
+         when Iir_Kind_Subtype_Definition =>
+            Put_Line ("subtype_definition");
+         when Iir_Kind_Physical_Type_Definition =>
+            Put ("physical_type_definition");
+            Disp_Identifier (Get_Type_Declarator (Tree));
+         when Iir_Kind_Physical_Subtype_Definition =>
+            Put_Line ("physical_subtype_definition");
+
+         when Iir_Kind_Simple_Name =>
+            Put ("simple_name ");
+            Disp_Identifier (Tree);
+
+         when Iir_Kind_Operator_Symbol =>
+            Put ("operator_symbol """);
+            Name_Table.Image (Get_Identifier (Tree));
+            Put (Name_Table.Name_Buffer (1 .. Name_Table.Name_Length));
+            Put_Line ("""");
+
+         when Iir_Kind_Null_Literal =>
+            Put_Line ("null_literal");
+
+         when Iir_Kind_Physical_Int_Literal =>
+            Put_Line ("physical_int_literal");
+
+         when Iir_Kind_Physical_Fp_Literal =>
+            Put_Line ("physical_fp_literal");
+
+         when Iir_Kind_Component_Instantiation_Statement =>
+            Put ("component_instantiation_statement");
+            Disp_Ident (Get_Label (Tree));
+         when Iir_Kind_Block_Statement =>
+            Put ("block_statement");
+            Disp_Ident (Get_Label (Tree));
+         when Iir_Kind_Sensitized_Process_Statement =>
+            Put ("sensitized_process_statement");
+            Disp_Ident (Get_Label (Tree));
+         when Iir_Kind_Process_Statement =>
+            Put ("process_statement");
+            Disp_Ident (Get_Label (Tree));
+         when Iir_Kind_Case_Statement =>
+            Put_Line ("case_statement");
+         when Iir_Kind_If_Statement =>
+            Put_Line ("if_statement");
+         when Iir_Kind_Elsif =>
+            Put_Line ("Elsif");
+         when Iir_Kind_For_Loop_Statement =>
+            Put_Line ("for_loop_statement");
+         when Iir_Kind_While_Loop_Statement =>
+            Put_Line ("while_loop_statement");
+         when Iir_Kind_Exit_Statement =>
+            Put_Line ("exit_statement");
+         when Iir_Kind_Next_Statement =>
+            Put_Line ("next_statement");
+         when Iir_Kind_Wait_Statement =>
+            Put_Line ("wait_statement");
+         when Iir_Kind_Assertion_Statement =>
+            Put_Line ("assertion_statement");
+         when Iir_Kind_Variable_Assignment_Statement =>
+            Put_Line ("variable_assignment_statement");
+         when Iir_Kind_Signal_Assignment_Statement =>
+            Put_Line ("signal_assignment_statement");
+         when Iir_Kind_Concurrent_Assertion_Statement =>
+            Put_Line ("concurrent_assertion_statement");
+         when Iir_Kind_Procedure_Call_Statement =>
+            Put_Line ("procedure_call_statement");
+         when Iir_Kind_Concurrent_Procedure_Call_Statement =>
+            Put_Line ("concurrent_procedure_call_statement");
+         when Iir_Kind_Return_Statement =>
+            Put_Line ("return_statement");
+         when Iir_Kind_Null_Statement =>
+            Put_Line ("null_statement");
+
+         when Iir_Kind_Enumeration_Literal =>
+            Put ("enumeration_literal");
+            Disp_Identifier (Tree);
+
+         when Iir_Kind_Character_Literal =>
+            Put_Line ("character_literal");
+         when Iir_Kind_Integer_Literal =>
+            Put_Line ("integer_literal: "
+                      & Iir_Int64'Image (Get_Value (Tree)));
+         when Iir_Kind_Floating_Point_Literal =>
+            Put_Line ("floating_point_literal: "
+                      & Iir_Fp64'Image (Get_Fp_Value (Tree)));
+         when Iir_Kind_String_Literal =>
+            Put_Line ("string_literal: " & Image_String_Lit (Tree));
+         when Iir_Kind_Unit_Declaration =>
+            Put ("physical unit");
+            Disp_Identifier (Tree);
+         when Iir_Kind_Entity_Class =>
+            Put_Line ("entity_class '"
+                      & Tokens.Image (Get_Entity_Class (Tree)) & ''');
+
+         when Iir_Kind_Attribute_Name =>
+            Put ("attribute_name");
+            Disp_Ident (Get_Attribute_Identifier (Tree));
+
+         when Iir_Kind_Implicit_Function_Declaration =>
+            Put ("implicit_function_declaration: ");
+            Put_Line (Iirs_Utils.Get_Predefined_Function_Name
+                      (Get_Implicit_Definition (Tree)));
+         when Iir_Kind_Implicit_Procedure_Declaration =>
+            Put ("implicit_procedure_declaration: ");
+            Put_Line (Iirs_Utils.Get_Predefined_Function_Name
+                      (Get_Implicit_Definition (Tree)));
+
+         when others =>
+            Put_Line (Iir_Kind'Image (Get_Kind (Tree)));
+      end case;
+   end Disp_Tree_Flat;
+
+   procedure Disp_Staticness (Static: Iir_Staticness) is
+   begin
+      case Static is
+         when Unknown =>
+            Put ("???");
+         when None =>
+            Put ("none");
+         when Globally =>
+            Put ("global");
+         when Locally =>
+            Put ("local");
+      end case;
+   end Disp_Staticness;
+
+   procedure Disp_Flag (Bool : Boolean) is
+   begin
+      if Bool then
+         Put ("true");
+      else
+         Put ("false");
+      end if;
+      New_Line;
+   end Disp_Flag;
+
+   procedure Disp_Expr_Staticness (Expr: Iir) is
+   begin
+      Put (" expr: ");
+      Disp_Staticness (Get_Expr_Staticness (Expr));
+      New_Line;
+   end Disp_Expr_Staticness;
+
+   procedure Disp_Type_Staticness (Atype: Iir) is
+   begin
+      Put (" type: ");
+      Disp_Staticness (Get_Type_Staticness (Atype));
+      New_Line;
+   end Disp_Type_Staticness;
+
+   procedure Disp_Name_Staticness (Expr: Iir) is
+   begin
+      Put (" expr: ");
+      Disp_Staticness (Get_Expr_Staticness (Expr));
+      Put (", name: ");
+      Disp_Staticness (Get_Name_Staticness (Expr));
+      New_Line;
+   end Disp_Name_Staticness;
+
+   procedure Disp_Choice_Staticness (Expr: Iir) is
+   begin
+      Put (" choice: ");
+      Disp_Staticness (Get_Choice_Staticness (Expr));
+      New_Line;
+   end Disp_Choice_Staticness;
+
+   procedure Disp_Type_Resolved_Flag (Atype : Iir) is
+   begin
+      if Get_Resolved_Flag (Atype) then
+         Put_Line ("resolved");
+      else
+         New_Line;
+      end if;
+   end Disp_Type_Resolved_Flag;
+
+   procedure Disp_Lexical_Layout (Decl : Iir)
+   is
+      V : Iir_Lexical_Layout_Type;
+   begin
+      V := Get_Lexical_Layout (Decl);
+      if (V and Iir_Lexical_Has_Mode) /= 0 then
+         Put (" +mode");
+      end if;
+      if (V and Iir_Lexical_Has_Class) /= 0 then
+         Put (" +class");
+      end if;
+      if (V and Iir_Lexical_Has_Type) /= 0 then
+         Put (" +type");
+      end if;
+      New_Line;
+   end Disp_Lexical_Layout;
+
+   procedure Disp_Purity_State (State : Iir_Pure_State)
+   is
+   begin
+      case State is
+         when Pure =>
+            Put (" pure");
+         when Impure =>
+            Put (" impure");
+         when Maybe_Impure =>
+            Put (" maybe_impure");
+         when Unknown =>
+            Put (" unknown");
+      end case;
+      New_Line;
+   end Disp_Purity_State;
+
+   procedure Disp_State (State : Tri_State_Type)
+   is
+   begin
+      case State is
+         when True =>
+            Put (" true");
+         when False =>
+            Put (" false");
+         when Unknown =>
+            Put (" unknown");
+      end case;
+      New_Line;
+   end Disp_State;
+
+   procedure Disp_Depth (Depth : Iir_Int32) is
+   begin
+      Put (Iir_Int32'Image (Depth));
+      New_Line;
+   end Disp_Depth;
+
+   procedure Disp_Tree (Tree: Iir;
+                        Tab: Natural := 0;
+                        Flat_Decl: Boolean := false) is
+      Ntab: Natural := Inc_Tab (Tab);
+      Kind : Iir_Kind;
+
+      procedure Header (Str: String; Nl: Boolean := true) is
+      begin
+         Disp_Tab (Ntab);
+         Put (Str);
+         if Nl then
+            New_Line;
+         end if;
+      end Header;
+
+      procedure Disp_Label (Tree: Iir)is
+         Label : Name_Id;
+      begin
+         Label := Get_Label (Tree);
+         if Label /= Null_Identifier then
+            Header ("label: "  & Name_Table.Image (Label));
+         else
+            Header ("label: -");
+         end if;
+      end Disp_Label;
+   begin
+      Disp_Tree_Flat (Tree, Tab);
+      if Tree = Null_Iir then
+         return;
+      end if;
+
+      if Get_Location (Tree) /= Location_Nil then
+         Header ("loc: " & Errorout.Get_Location_Str (Get_Location (Tree)));
+      end if;
+      if False then
+         Header ("parent:");
+         Disp_Tree_Flat (Get_Parent (Tree), Ntab);
+      end if;
+
+      Kind := Get_Kind (Tree);
+      case Kind is
+         when Iir_Kind_Overload_List =>
+            Header ("overload_list");
+            Disp_Tree_List (Get_Overload_List (Tree), Ntab, Flat_Decl);
+
+         when Iir_Kind_Error =>
+            null;
+
+         when Iir_Kind_Design_File =>
+            Header ("design_file_filename: "
+                    & Name_Table.Image (Get_Design_File_Filename (Tree)));
+            Header ("design_file_directory: "
+                    & Name_Table.Image (Get_Design_File_Directory (Tree)));
+            Header ("analysis_time_stamp: "
+                    & Files_Map.Get_Time_Stamp_String
+                    (Get_Analysis_Time_Stamp (Tree)));
+            Header ("file_time_stamp: "
+                    & Files_Map.Get_Time_Stamp_String
+                    (Get_File_Time_Stamp (Tree)));
+            Header ("library:");
+            Disp_Tree_Flat (Get_Parent (Tree), Ntab);
+            Header ("design_unit_chain:");
+            Disp_Tree_Chain (Get_First_Design_Unit (Tree), Ntab, Flat_Decl);
+
+         when Iir_Kind_Design_Unit =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("flags: date_state: "
+                    & Date_State_Type'Image (Get_Date_State (Tree))
+                    & ", elab: "
+                    & Boolean'Image (Get_Elab_Flag (Tree)));
+            Header ("date:" & Date_Type'Image (Get_Date (Tree)));
+            Header ("parent (design file):");
+            Disp_Tree_Flat (Get_Design_File (Tree), Ntab);
+            Header ("dependence list:");
+            Disp_Tree_List_Flat (Get_Dependence_List (Tree), Ntab);
+            if Get_Date_State (Tree) /= Date_Disk then
+               Header ("context items:");
+               Disp_Tree_Chain (Get_Context_Items (Tree), Ntab);
+            end if;
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+            Header ("library unit:");
+            Disp_Tree (Get_Library_Unit (Tree), Ntab);
+         when Iir_Kind_Use_Clause =>
+            Header ("selected name:");
+            Disp_Tree (Get_Selected_Name (Tree), Ntab, True);
+            Header ("use_clause_chain:");
+            Disp_Tree (Get_Use_Clause_Chain (Tree), Ntab);
+         when Iir_Kind_Library_Clause =>
+            Header ("library declaration:");
+            Disp_Tree_Flat (Get_Library_Declaration (Tree), Ntab);
+
+         when Iir_Kind_Library_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("library_directory: "
+                    & Name_Table.Image (Get_Library_Directory (Tree)));
+            Header ("design file list:");
+            Disp_Tree_Chain (Get_Design_File_Chain (Tree), Ntab);
+
+         when Iir_Kind_Entity_Declaration =>
+            Header ("generic chain:");
+            Disp_Tree_Chain (Get_Generic_Chain (Tree), Ntab);
+            Header ("port chain:");
+            Disp_Tree_Chain (Get_Port_Chain (Tree), Ntab);
+            Header ("declaration chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+            Header ("concurrent_statements:");
+            Disp_Tree_Chain (Get_Concurrent_Statement_Chain (Tree), Ntab);
+         when Iir_Kind_Package_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("need_body: " & Boolean'Image (Get_Need_Body (Tree)));
+            Header ("declaration chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+         when Iir_Kind_Package_Body =>
+            Header ("package:");
+            Disp_Tree_Flat (Get_Package (Tree), Ntab);
+            Header ("declaration:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+         when Iir_Kind_Architecture_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("entity:");
+            Disp_Tree_Flat (Get_Entity (Tree), Ntab);
+            Header ("declaration_chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+            Header ("concurrent_statements:");
+            Disp_Tree_Chain (Get_Concurrent_Statement_Chain (Tree), Ntab);
+            Header ("default configuration:");
+            Disp_Tree_Flat
+              (Get_Default_Configuration_Declaration (Tree), Ntab);
+         when Iir_Kind_Configuration_Declaration =>
+            Header ("entity:");
+            Disp_Tree_Flat (Get_Entity (Tree), Ntab);
+            Header ("declaration_chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+            Header ("block_configuration:");
+            Disp_Tree (Get_Block_Configuration (Tree), Ntab, True);
+
+         when Iir_Kind_Entity_Aspect_Entity =>
+            Header ("entity:");
+            Disp_Tree_Flat (Get_Entity (Tree), Ntab);
+            Header ("architecture:");
+            Disp_Tree_Flat (Get_Architecture (Tree), Ntab);
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Header ("configuration:");
+            Disp_Tree (Get_Configuration (Tree), Ntab, True);
+         when Iir_Kind_Entity_Aspect_Open =>
+            null;
+
+         when Iir_Kind_Block_Configuration =>
+            Header ("block_specification:");
+            Disp_Tree (Get_Block_Specification (Tree), Ntab, True);
+            Header ("declaration_chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+            Header ("configuration_item_chain:");
+            Disp_Tree_Chain (Get_Configuration_Item_Chain (Tree), Ntab);
+            Header ("prev_block_configuration:");
+            Disp_Tree_Flat (Get_Prev_Block_Configuration (Tree), Ntab);
+         when Iir_Kind_Attribute_Specification =>
+            Header ("attribute_designator:");
+            Disp_Tree (Get_Attribute_Designator (Tree), Ntab, True);
+            Header ("entity_name_list:");
+            Disp_Tree_List_Flat (Get_Entity_Name_List (Tree), Ntab);
+            Header ("entity_class: "
+                    & Tokens.Image (Get_Entity_Class (Tree)));
+            Header ("expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab);
+            Header ("attribute_value_spec_chain:");
+            Disp_Tree_Chain (Get_Attribute_Value_Spec_Chain (Tree), Ntab);
+         when Iir_Kind_Configuration_Specification
+           | Iir_Kind_Component_Configuration =>
+            Header ("instantiation_list:");
+            Disp_Tree_List_Flat (Get_Instantiation_List (Tree), Ntab);
+            Header ("component_name:");
+            Disp_Tree (Get_Component_Name (Tree), Ntab, True);
+            Header ("binding_indication:");
+            Disp_Tree (Get_Binding_Indication (Tree), Ntab);
+            if Kind = Iir_Kind_Component_Configuration then
+               Header ("block_configuration:");
+               Disp_Tree (Get_Block_Configuration (Tree), Ntab);
+            end if;
+         when Iir_Kind_Binding_Indication =>
+            Header ("entity_aspect:");
+            Disp_Tree (Get_Entity_Aspect (Tree), Ntab, True);
+            Header ("generic_map_aspect_chain:");
+            Disp_Tree_Chain (Get_Generic_Map_Aspect_Chain (Tree), Ntab);
+            Header ("port_map_aspect_chain:");
+            Disp_Tree_Chain (Get_Port_Map_Aspect_Chain (Tree), Ntab);
+            Header ("default_generic_map_aspect_chain:");
+            Disp_Tree_Chain
+              (Get_Default_Generic_Map_Aspect_Chain (Tree), Ntab);
+            Header ("default_port_map_aspect_chain:");
+            Disp_Tree_Chain (Get_Default_Port_Map_Aspect_Chain (Tree), Ntab);
+         when Iir_Kind_Block_Header =>
+            Header ("generic chain:");
+            Disp_Tree_Chain (Get_Generic_Chain (Tree), Ntab);
+            Header ("generic_map_aspect_chain:");
+            Disp_Tree_Chain (Get_Generic_Map_Aspect_Chain (Tree), Ntab);
+            Header ("port chain:");
+            Disp_Tree_Chain (Get_Port_Chain (Tree), Ntab);
+            Header ("port_map_aspect_chain:");
+            Disp_Tree_Chain (Get_Port_Map_Aspect_Chain (Tree), Ntab);
+         when Iir_Kind_Attribute_Value =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("attribute_specification:");
+            Disp_Tree_Flat (Get_Attribute_Specification (Tree), Ntab);
+            Header ("designated_entity:");
+            Disp_Tree_Flat (Get_Designated_Entity (Tree), Ntab);
+         when Iir_Kind_Signature =>
+            Header ("return_type:");
+            Disp_Tree_Flat (Get_Return_Type (Tree), Ntab);
+            Header ("type_marks_list:");
+            Disp_Tree_List (Get_Type_Marks_List (Tree), Ntab);
+         when Iir_Kind_Disconnection_Specification =>
+            Header ("signal_list:");
+            Disp_Tree_List (Get_Signal_List (Tree), Ntab, True);
+            Header ("type_mark:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            Header ("time expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab);
+
+         when Iir_Kind_Association_Element_By_Expression =>
+            Header ("whole_association_flag: ", False);
+            Disp_Flag (Get_Whole_Association_Flag (Tree));
+            Header ("collapse_signal_flag: ", False);
+            Disp_Flag (Get_Collapse_Signal_Flag (Tree));
+            Header ("formal:");
+            Disp_Tree (Get_Formal (Tree), Ntab, True);
+            Header ("out_conversion:");
+            Disp_Tree (Get_Out_Conversion (Tree), Ntab, True);
+            Header ("actual:");
+            Disp_Tree (Get_Actual (Tree), Ntab, True);
+            Header ("in_conversion:");
+            Disp_Tree (Get_In_Conversion (Tree), Ntab, True);
+         when Iir_Kind_Association_Element_By_Individual =>
+            Header ("whole_association_flag: ", False);
+            Disp_Flag (Get_Whole_Association_Flag (Tree));
+            Header ("formal:");
+            Disp_Tree (Get_Formal (Tree), Ntab, True);
+            Header ("actual_type:");
+            Disp_Tree (Get_Actual_Type (Tree), Ntab, True);
+            Header ("individual_association_chain:");
+            Disp_Tree_Chain (Get_Individual_Association_Chain (Tree), Ntab);
+         when Iir_Kind_Association_Element_Open =>
+            Header ("formal:");
+            Disp_Tree (Get_Formal (Tree), Ntab, True);
+
+         when Iir_Kind_Waveform_Element =>
+            Header ("value:");
+            Disp_Tree (Get_We_Value (Tree), Ntab, True);
+            Header ("time:");
+            Disp_Tree (Get_Time (Tree), Ntab);
+         when Iir_Kind_Conditional_Waveform =>
+            Header ("condition:");
+            Disp_Tree (Get_Condition (Tree), Ntab);
+            Header ("waveform_chain:");
+            Disp_Tree_Chain (Get_Waveform_Chain (Tree), Ntab);
+
+         when Iir_Kind_Choice_By_Name =>
+            Header ("name:");
+            Disp_Tree (Get_Name (Tree), Ntab);
+            Header ("associated:");
+            Disp_Tree (Get_Associated (Tree), Ntab, True);
+         when Iir_Kind_Choice_By_Others =>
+            Header ("associated");
+            Disp_Tree (Get_Associated (Tree), Ntab, True);
+         when Iir_Kind_Choice_By_None =>
+            Header ("associated");
+            Disp_Tree (Get_Associated (Tree), Ntab, True);
+         when Iir_Kind_Choice_By_Range =>
+            Header ("staticness: ", False);
+            Disp_Choice_Staticness (Tree);
+            Header ("range:");
+            Disp_Tree (Get_Expression (Tree), Ntab);
+            Header ("associated");
+            Disp_Tree (Get_Associated (Tree), Ntab, True);
+         when Iir_Kind_Choice_By_Expression =>
+            Header ("expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab);
+            Header ("staticness: ", False);
+            Disp_Choice_Staticness (Tree);
+            Header ("associated");
+            Disp_Tree (Get_Associated (Tree), Ntab, True);
+
+         when Iir_Kind_Signal_Interface_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Name_Staticness (Tree);
+            Header ("lexical layout:", False);
+            Disp_Lexical_Layout (Tree);
+            Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree)));
+            Header ("signal kind: "
+                    & Iir_Signal_Kind'Image (Get_Signal_Kind (Tree)));
+            Header ("has_active_flag: ", False);
+            Disp_Flag (Get_Has_Active_Flag (Tree));
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            Header ("default value:");
+            Disp_Tree (Get_Default_Value (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Variable_Interface_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Name_Staticness (Tree);
+            Header ("lexical layout:", False);
+            Disp_Lexical_Layout (Tree);
+            Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree)));
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            Header ("default value:");
+            Disp_Tree (Get_Default_Value (Tree), Ntab, True);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Constant_Interface_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Name_Staticness (Tree);
+            Header ("lexical layout:", False);
+            Disp_Lexical_Layout (Tree);
+            Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree)));
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            Header ("default value:");
+            Disp_Tree (Get_Default_Value (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_File_Interface_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Name_Staticness (Tree);
+            Header ("lexical layout:", False);
+            Disp_Lexical_Layout (Tree);
+            Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree)));
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("kind: " & Iir_Signal_Kind'Image (Get_Signal_Kind (Tree)));
+            Header ("has_active_flag: ", False);
+            Disp_Flag (Get_Has_Active_Flag (Tree));
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            if Kind = Iir_Kind_Signal_Declaration then
+               Header ("default value:");
+               Disp_Tree (Get_Default_Value (Tree), Ntab, True);
+               Header ("signal_driver:");
+               Disp_Tree_Flat (Get_Signal_Driver (Tree), Ntab);
+            else
+               Header ("guard expr:");
+               Disp_Tree (Get_Guard_Expression (Tree), Ntab);
+               Header ("guard sensitivity list:");
+               Disp_Tree_List (Get_Guard_Sensitivity_List (Tree), Ntab);
+            end if;
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            if Kind = Iir_Kind_Constant_Declaration then
+               Header ("deferred flag: " & Boolean'Image
+                       (Get_Deferred_Declaration_Flag (Tree)));
+               Header ("deferred: ");
+               Disp_Tree (Get_Deferred_Declaration (Tree), Ntab, True);
+               Header ("default value:");
+               Disp_Tree (Get_Default_Value (Tree), Ntab, True);
+            end if;
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Variable_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("default value:");
+            Disp_Tree (Get_Default_Value (Tree), Ntab, True);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_File_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("logical name:");
+            Disp_Tree (Get_File_Logical_Name (Tree), Ntab);
+            Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree)));
+            Header ("file_open_kind:");
+            Disp_Tree (Get_File_Open_Kind (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("type (definition):");
+            Disp_Tree (Get_Type (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("type (definition):");
+            Disp_Tree (Get_Type (Tree), Ntab);
+         when Iir_Kind_Component_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("generic chain:");
+            Disp_Tree_Chain (Get_Generic_Chain (Tree), Ntab);
+            Header ("port chain:");
+            Disp_Tree_Chain (Get_Port_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Element_Declaration =>
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+         when Iir_Kind_Attribute_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("interface_declaration_chain:");
+            Disp_Tree_Chain (Get_Interface_Declaration_Chain (Tree), Ntab);
+            if Kind = Iir_Kind_Function_Declaration then
+               Header ("return type:");
+               Disp_Tree (Get_Return_Type (Tree), Ntab, True);
+               Header ("pure_flag: ", False);
+               Disp_Flag (Get_Pure_Flag (Tree));
+            else
+               Header ("purity_state:", False);
+               Disp_Purity_State (Get_Purity_State (Tree));
+            end if;
+            Header ("wait_state:", False);
+            Disp_State (Get_Wait_State (Tree));
+
+            Header ("subprogram_depth:", False);
+            Disp_Depth (Get_Subprogram_Depth (Tree));
+            Header ("subprogram_body:");
+            Disp_Tree_Flat (Get_Subprogram_Body (Tree), Ntab);
+            Header ("driver list:");
+            Disp_Tree_List (Get_Driver_List (Tree), Ntab, True);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Procedure_Body
+           | Iir_Kind_Function_Body =>
+            Header ("specification:");
+            Disp_Tree_Flat (Get_Subprogram_Specification (Tree), Ntab);
+            Header ("declaration_chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+            Header ("statements:");
+            Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab);
+         when Iir_Kind_Implicit_Function_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("operation: "
+                    & Iir_Predefined_Functions'Image
+                    (Get_Implicit_Definition (Tree)));
+            Header ("interface declaration chain:");
+            Disp_Tree_Chain (Get_Interface_Declaration_Chain (Tree), Ntab);
+            Header ("return type:");
+            Disp_Tree (Get_Return_Type (Tree), Ntab, True);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Implicit_Procedure_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("interface declaration chain:");
+            Disp_Tree_Chain (Get_Interface_Declaration_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Object_Alias_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("name:");
+            Disp_Tree (Get_Name (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("name:");
+            Disp_Tree (Get_Name (Tree), Ntab);
+            Header ("signature:");
+            Disp_Tree (Get_Signature (Tree), Ntab, True);
+
+         when Iir_Kind_Group_Template_Declaration =>
+            Header ("entity_class_entry:");
+            Disp_Tree_Chain (Get_Entity_Class_Entry_Chain (Tree), Ntab);
+         when Iir_Kind_Group_Declaration =>
+            Header ("group_constituent_list:");
+            Disp_Tree_List_Flat (Get_Group_Constituent_List (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+
+         when Iir_Kind_Enumeration_Type_Definition =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("type declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("literals:");
+            Disp_Tree_List (Get_Enumeration_Literal_List (Tree), Ntab);
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition =>
+            if Flat_Decl and then not Is_Anonymous_Type_Definition (Tree)
+            then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("type_declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Subtype_Definition =>
+            if Flat_Decl
+              and then Kind /= Iir_Kind_Subtype_Definition
+              and then Get_Type_Declarator (Tree) /= Null_Iir
+            then
+               return;
+            end if;
+            if Kind /= Iir_Kind_Subtype_Definition then
+               Header ("staticness: ", False);
+               Disp_Type_Staticness (Tree);
+               Header ("resolved flag: ", False);
+               Disp_Type_Resolved_Flag (Tree);
+               Header ("signal_type_flag: ", False);
+               Disp_Flag (Get_Signal_Type_Flag (Tree));
+               Header ("type declarator:");
+               Disp_Tree (Get_Type_Declarator (Tree), Ntab, True);
+               Header ("base type:");
+               Disp_Tree (Get_Base_Type (Tree), Ntab, True);
+            end if;
+            Header ("type mark:");
+            Disp_Tree (Get_Type_Mark (Tree), Ntab, True);
+            Header ("resolution function:");
+            Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab);
+            Header ("range constraint:");
+            Disp_Tree (Get_Range_Constraint (Tree), Ntab);
+         when Iir_Kind_Range_Expression =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("left limit:");
+            Disp_Tree (Get_Left_Limit (Tree), Ntab, True);
+            Header ("right limit:");
+            Disp_Tree (Get_Right_Limit (Tree), Ntab, True);
+            Header ("direction: "
+                    & Iir_Direction'Image (Get_Direction (Tree)));
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+         when Iir_Kind_Array_Subtype_Definition =>
+            if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then
+               return;
+            end if;
+            Header ("staticness:", false);
+            Disp_Type_Staticness (Tree);
+            Header ("resolved flag: ", False);
+            Disp_Type_Resolved_Flag (Tree);
+            Header ("signal_type_flag: ", False);
+            Disp_Flag (Get_Signal_Type_Flag (Tree));
+            Header ("type declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("base type:");
+            declare
+               Base : Iir := Get_Base_Type (Tree);
+               Fl : Boolean;
+            begin
+               if Base /= Null_Iir
+                 and then Kind = Iir_Kind_Array_Type_Definition
+               then
+                  Fl := Get_Type_Declarator (Base)
+                    /= Get_Type_Declarator (Tree);
+               else
+                  Fl := False;
+               end if;
+               Disp_Tree (Base, Ntab, Fl);
+            end;
+            Header ("type mark:");
+            Disp_Tree (Get_Type_Mark (Tree), Ntab, True);
+            Header ("index_subtype_list:");
+            Disp_Tree_List (Get_Index_Subtype_List (Tree), Ntab, True);
+            Header ("element_subtype:");
+            Disp_Tree_Flat (Get_Element_Subtype (Tree), Ntab);
+            Header ("resolution function:");
+            Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab);
+         when Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then
+               return;
+            end if;
+            Header ("type declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("resolved flag: ", False);
+            Disp_Type_Resolved_Flag (Tree);
+            Header ("signal_type_flag: ", False);
+            Disp_Flag (Get_Signal_Type_Flag (Tree));
+            Header ("base type:");
+            Disp_Tree (Get_Base_Type (Tree), Ntab, True);
+            Header ("type mark:");
+            Disp_Tree (Get_Type_Mark (Tree), Ntab, True);
+            Header ("resolution function:");
+            Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab);
+            Header ("index_subtype_list:");
+            Disp_Tree_List (Get_Index_Subtype_List (Tree), Ntab, True);
+         when Iir_Kind_Array_Type_Definition  =>
+            if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("resolved flag: ", False);
+            Disp_Type_Resolved_Flag (Tree);
+            Header ("signal_type_flag: ", False);
+            Disp_Flag (Get_Signal_Type_Flag (Tree));
+            Header ("index_subtype_list:");
+            Disp_Tree_List (Get_Index_Subtype_List (Tree), Ntab, True);
+            Header ("element_subtype:");
+            Disp_Tree (Get_Element_Subtype (Tree), Ntab, True);
+         when Iir_Kind_Record_Type_Definition =>
+            if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("resolved flag: ", False);
+            Disp_Type_Resolved_Flag (Tree);
+            Header ("signal_type_flag: ", False);
+            Disp_Flag (Get_Signal_Type_Flag (Tree));
+            Header ("elements:");
+            Disp_Tree_Chain (Get_Element_Declaration_Chain (Tree), Ntab, True);
+         when Iir_Kind_Record_Subtype_Definition =>
+            if Flat_Decl and then not Is_Anonymous_Type_Definition (Tree) then
+               return;
+            end if;
+            Header ("type declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("resolved flag: ", False);
+            Disp_Type_Resolved_Flag (Tree);
+            Header ("signal_type_flag: ", False);
+            Disp_Flag (Get_Signal_Type_Flag (Tree));
+            Header ("base type:");
+            Disp_Tree (Get_Base_Type (Tree), Ntab, True);
+            Header ("type mark:");
+            Disp_Tree (Get_Type_Mark (Tree), Ntab, True);
+            Header ("resolution function:");
+            Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab);
+         when Iir_Kind_Physical_Type_Definition =>
+            if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("resolved flag: ", False);
+            Disp_Type_Resolved_Flag (Tree);
+            Header ("declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("unit chain:");
+            Disp_Tree_Chain (Get_Unit_Chain (Tree), Ntab);
+         when Iir_Kind_Unit_Declaration =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("physical_literal:");
+            Disp_Tree (Get_Physical_Literal (Tree), Ntab, True);
+            Header ("physical_Unit_Value:");
+            Disp_Tree (Get_Physical_Unit_Value (Tree), Ntab, True);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+
+         when Iir_Kind_Access_Type_Definition =>
+            if Flat_Decl then
+               return;
+            end if;
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("resolved flag: ", False);
+            Disp_Type_Resolved_Flag (Tree);
+            Header ("signal_type_flag: ", False);
+            Disp_Flag (Get_Signal_Type_Flag (Tree));
+            Header ("declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("designated type:");
+            Disp_Tree_Flat (Get_Designated_Type (Tree), Ntab);
+         when Iir_Kind_Access_Subtype_Definition =>
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("resolved flag: ", False);
+            Disp_Type_Resolved_Flag (Tree);
+            Header ("declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("base type:");
+            Disp_Tree (Get_Base_Type (Tree), Ntab, True);
+            Header ("type mark:");
+            Disp_Tree (Get_Type_Mark (Tree), Ntab, True);
+            Header ("designated type:");
+            Disp_Tree_Flat (Get_Designated_Type (Tree), Ntab);
+            Header ("resolution function:");
+            Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab);
+
+         when Iir_Kind_Incomplete_Type_Definition =>
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("base type:");
+            Disp_Tree (Get_Base_Type (Tree), Ntab, True);
+
+         when Iir_Kind_File_Type_Definition =>
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("type mark:");
+            Disp_Tree_Flat (Get_Type_Mark (Tree), Ntab);
+         when Iir_Kind_Protected_Type_Declaration =>
+            Header ("staticness: ", False);
+            Disp_Type_Staticness (Tree);
+            Header ("declarator:");
+            Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
+            Header ("protected_type_body:");
+            Disp_Tree_Flat (Get_Protected_Type_Body (Tree), Ntab);
+            Header ("declarative_part:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+         when Iir_Kind_Protected_Type_Body =>
+            Header ("protected_type_declaration:");
+            Disp_Tree_Flat (Get_Protected_Type_Declaration (Tree), Ntab);
+            Header ("declarative_part:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+
+         when Iir_Kind_Block_Statement =>
+            if Flat_Decl then
+               return;
+            end if;
+            Disp_Label (Tree);
+            Header ("guard decl:");
+            Disp_Tree (Get_Guard_Decl (Tree), Ntab);
+            Header ("block header:");
+            Disp_Tree (Get_Block_Header (Tree), Ntab);
+            Header ("declaration_chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+            Header ("concurrent statements:");
+            Disp_Tree_Chain (Get_Concurrent_Statement_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Generate_Statement =>
+            if Flat_Decl then
+               return;
+            end if;
+            Disp_Label (Tree);
+            Header ("generation_scheme:");
+            Disp_Tree (Get_Generation_Scheme (Tree), Ntab);
+            Header ("declaration_chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+            Header ("concurrent statements:");
+            Disp_Tree_Chain (Get_Concurrent_Statement_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+
+         when Iir_Kind_Component_Instantiation_Statement =>
+            Disp_Label (Tree);
+            Header ("instantiated unit:");
+            Disp_Tree (Get_Instantiated_Unit (Tree), Ntab, True);
+            Header ("generic map aspect chain:");
+            Disp_Tree_Chain (Get_Generic_Map_Aspect_Chain (Tree), Ntab);
+            Header ("port map aspect chain:");
+            Disp_Tree_Chain (Get_Port_Map_Aspect_Chain (Tree), Ntab);
+            Header ("component_configuration:");
+            Disp_Tree (Get_Component_Configuration (Tree), Ntab);
+            Header ("default binding indication:");
+            Disp_Tree (Get_Default_Binding_Indication (Tree), Ntab, True);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+            Header ("guarded_target_flag: "
+                    & Tri_State_Type'Image (Get_Guarded_Target_State (Tree)));
+            Header ("target:");
+            Disp_Tree (Get_Target (Tree), Ntab, True);
+            if Get_Guard (Tree) = Tree then
+               Header ("guard: guarded");
+            else
+               Header ("guard:");
+               Disp_Tree_Flat (Get_Guard (Tree), Ntab);
+            end if;
+            Header ("conditional waveform chain:");
+            Disp_Tree_Chain (Get_Conditional_Waveform_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            Header ("guarded_target_flag: "
+                    & Tri_State_Type'Image (Get_Guarded_Target_State (Tree)));
+            Header ("target:");
+            Disp_Tree (Get_Target (Tree), Ntab, True);
+            if Get_Guard (Tree) = Tree then
+               Header ("guard: guarded");
+            else
+               Header ("guard:");
+               Disp_Tree_Flat (Get_Guard (Tree), Ntab);
+            end if;
+            Header ("choices:");
+            Disp_Tree_Chain (Get_Selected_Waveform_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Concurrent_Assertion_Statement =>
+            Header ("condition:");
+            Disp_Tree (Get_Assertion_Condition (Tree), Ntab);
+            Header ("report expression:");
+            Disp_Tree (Get_Report_Expression (Tree), Ntab);
+            Header ("severity expression:");
+            Disp_Tree (Get_Severity_Expression (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            Disp_Label (Tree);
+            Header ("passive: " & Boolean'Image (Get_Passive_Flag (Tree)));
+            if Kind = Iir_Kind_Sensitized_Process_Statement then
+               Header ("sensivity list:");
+               Disp_Tree_List (Get_Sensitivity_List (Tree), Ntab, True);
+            end if;
+            Header ("driver list:");
+            Disp_Tree_List (Get_Driver_List (Tree), Ntab, True);
+            Header ("declaration_chain:");
+            Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab);
+            Header ("process statements:");
+            Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_If_Statement =>
+            Header ("condition:");
+            Disp_Tree (Get_Condition (Tree), Ntab, True);
+            Header ("then sequence:");
+            Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab);
+            Header ("elsif:");
+            Disp_Tree (Get_Else_Clause (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Elsif =>
+            Header ("condition:");
+            Disp_Tree (Get_Condition (Tree), Ntab);
+            Header ("then sequence:");
+            Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab);
+            Header ("elsif:");
+            Disp_Tree (Get_Else_Clause (Tree), Tab);
+         when Iir_Kind_For_Loop_Statement =>
+            Header ("iterator:");
+            Disp_Tree (Get_Iterator_Scheme (Tree), Ntab);
+            Header ("statements:");
+            Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_While_Loop_Statement =>
+            Header ("condition:");
+            Disp_Tree (Get_Condition (Tree), Ntab);
+            Header ("statements:");
+            Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Case_Statement =>
+            Header ("expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab, True);
+            Header ("choices chain:");
+            Disp_Tree_Chain
+              (Get_Case_Statement_Alternative_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Signal_Assignment_Statement =>
+            Header ("guarded_target_flag: "
+                    & Tri_State_Type'Image (Get_Guarded_Target_State (Tree)));
+            Header ("target:");
+            Disp_Tree (Get_Target (Tree), Ntab, True);
+            Header ("waveform_chain:");
+            Disp_Tree_Chain (Get_Waveform_Chain (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Variable_Assignment_Statement =>
+            Header ("target:");
+            Disp_Tree (Get_Target (Tree), Ntab, True);
+            Header ("expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Assertion_Statement =>
+            Header ("condition:");
+            Disp_Tree (Get_Assertion_Condition (Tree), Ntab);
+            Header ("report expression:");
+            Disp_Tree (Get_Report_Expression (Tree), Ntab);
+            Header ("severity expression:");
+            Disp_Tree (Get_Severity_Expression (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Report_Statement =>
+            Header ("report expression:");
+            Disp_Tree (Get_Report_Expression (Tree), Ntab);
+            Header ("severity expression:");
+            Disp_Tree (Get_Severity_Expression (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Return_Statement =>
+            Header ("expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab, True);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Wait_Statement =>
+            Header ("sensitivity list:");
+            Disp_Tree_List (Get_Sensitivity_List (Tree), Ntab, True);
+            Header ("condition:");
+            Disp_Tree (Get_Condition_Clause (Tree), Ntab);
+            Header ("timeout:");
+            Disp_Tree (Get_Timeout_Clause (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement =>
+            Disp_Label (Tree);
+            Header ("procedure_call:");
+            Disp_Tree (Get_Procedure_Call (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Procedure_Call =>
+            Header ("implementation:");
+            Disp_Tree (Get_Implementation (Tree), Ntab, True);
+            Header ("method_object:");
+            Disp_Tree (Get_Method_Object (Tree), Ntab);
+            Header ("parameters:");
+            Disp_Tree_Chain (Get_Parameter_Association_Chain (Tree), Ntab);
+         when Iir_Kind_Exit_Statement
+           | Iir_Kind_Next_Statement =>
+            Header ("loop:");
+            Disp_Tree_Flat (Get_Loop (Tree), Ntab);
+            Header ("condition:");
+            Disp_Tree (Get_Condition (Tree), Ntab);
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+         when Iir_Kind_Null_Statement =>
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+
+         when Iir_Kinds_Dyadic_Operator =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("implementation:");
+            Disp_Tree (Get_Implementation (Tree), Ntab, True);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("left:");
+            Disp_Tree (Get_Left (Tree), Ntab, True);
+            Header ("right:");
+            Disp_Tree (Get_Right (Tree), Ntab, True);
+
+         when Iir_Kinds_Monadic_Operator =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("implementation:");
+            Disp_Tree (Get_Implementation (Tree), Ntab, True);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("operand:");
+            Disp_Tree (Get_Operand (Tree), Ntab, True);
+
+         when Iir_Kind_Function_Call =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("implementation:");
+            Disp_Tree_Flat (Get_Implementation (Tree), Ntab);
+            Header ("method_object:");
+            Disp_Tree (Get_Method_Object (Tree), Ntab);
+            Header ("parameters:");
+            Disp_Tree_Chain (Get_Parameter_Association_Chain (Tree), Ntab);
+         when Iir_Kind_Qualified_Expression =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("type mark:");
+            Disp_Tree (Get_Type_Mark (Tree), Ntab, True);
+            Header ("expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab, True);
+         when Iir_Kind_Type_Conversion =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab, True);
+         when Iir_Kind_Allocator_By_Expression =>
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("expression:");
+            Disp_Tree (Get_Expression (Tree), Ntab, True);
+         when Iir_Kind_Allocator_By_Subtype =>
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("subtype indication:");
+            Disp_Tree (Get_Expression (Tree), Ntab, True);
+         when Iir_Kind_Selected_Element =>
+            Header ("prefix:");
+            Disp_Tree (Get_Prefix (Tree), Ntab, True);
+            Header ("selected element:");
+            Disp_Tree (Get_Selected_Element (Tree), Ntab, True);
+         when Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Dereference =>
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("prefix:");
+            Disp_Tree (Get_Prefix (Tree), Ntab, True);
+
+         when Iir_Kind_Aggregate =>
+            Header ("staticness: value: ", false);
+            Disp_Staticness (Get_Value_Staticness (Tree));
+            Disp_Expr_Staticness (Tree);
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            Header ("aggregate_info:");
+            Disp_Tree (Get_Aggregate_Info (Tree), Ntab);
+            Header ("associations:");
+            Disp_Tree_Chain (Get_Association_Choices_Chain (Tree), Ntab);
+         when Iir_Kind_Aggregate_Info =>
+            Header ("aggr_others_flag: ", False);
+            Disp_Flag (Get_Aggr_Others_Flag (Tree));
+            Header ("aggr_named_flag: ", False);
+            Disp_Flag (Get_Aggr_Named_Flag (Tree));
+            Header ("aggr_dynamic_flag: ", False);
+            Disp_Flag (Get_Aggr_Dynamic_Flag (Tree));
+            Header ("aggr_low_limit:");
+            Disp_Tree (Get_Aggr_Low_Limit (Tree), Ntab, False);
+            Header ("aggr_high_limit:");
+            Disp_Tree (Get_Aggr_High_Limit (Tree), Ntab, False);
+            Header ("aggr_max_length:" &
+                    Iir_Int32'Image (Get_Aggr_Max_Length (Tree)));
+            Header ("sub_aggregate_info:");
+            Disp_Tree (Get_Sub_Aggregate_Info (Tree), Ntab);
+         when Iir_Kind_Operator_Symbol =>
+            null;
+         when Iir_Kind_Simple_Name =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+         when Iir_Kind_Indexed_Name =>
+            Header ("staticness:", false);
+            Disp_Name_Staticness (Tree);
+            Header ("prefix:");
+            Disp_Tree (Get_Prefix (Tree), Ntab, True);
+            Header ("index:");
+            Disp_Tree_List (Get_Index_List (Tree), Ntab, True);
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+         when Iir_Kind_Slice_Name =>
+            Header ("staticness:", false);
+            Disp_Name_Staticness (Tree);
+            Header ("prefix:");
+            Disp_Tree (Get_Prefix (Tree), Ntab, True);
+            Header ("suffix:");
+            Disp_Tree (Get_Suffix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+         when Iir_Kind_Parenthesis_Name =>
+            Header ("prefix:");
+            Disp_Tree (Get_Prefix (Tree), Ntab, Flat_Decl);
+            Header ("association chain:");
+            Disp_Tree_Chain (Get_Association_Chain (Tree), Ntab);
+         when Iir_Kind_Selected_By_All_Name =>
+            Header ("prefix:");
+            Disp_Tree (Get_Prefix (Tree), Ntab, True);
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+         when Iir_Kind_Selected_Name =>
+            Header ("prefix:");
+            Disp_Tree (Get_Prefix (Tree), Ntab, True);
+            Header ("identifier: ", False);
+            Disp_Ident (Get_Suffix_Identifier (Tree));
+
+         when Iir_Kind_Attribute_Name =>
+            Header ("prefix:");
+            Disp_Tree (Get_Prefix (Tree), Ntab, True);
+            Header ("signature:");
+            Disp_Tree (Get_Signature (Tree), Ntab);
+
+         when Iir_Kind_Base_Attribute =>
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+         when 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 =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+         when Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute =>
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("parameter:");
+            Disp_Tree (Get_Parameter (Tree), Ntab);
+         when Iir_Kind_Pos_Attribute
+            | Iir_Kind_Val_Attribute
+            | Iir_Kind_Succ_Attribute
+            | Iir_Kind_Pred_Attribute
+            | Iir_Kind_Leftof_Attribute
+            | Iir_Kind_Rightof_Attribute =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("parameter:");
+            Disp_Tree (Get_Parameter (Tree), Ntab);
+         when Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("parameter:");
+            Disp_Tree (Get_Parameter (Tree), Ntab);
+         when Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("has_active_flag: ", False);
+            Disp_Flag (Get_Has_Active_Flag (Tree));
+         when 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 =>
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+         when Iir_Kind_Behavior_Attribute
+           | Iir_Kind_Structure_Attribute =>
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+         when Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute =>
+            Header ("prefix:");
+            Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+
+         when Iir_Kind_Enumeration_Literal =>
+            if Flat_Decl and then Get_Literal_Origin (Tree) = Null_Iir then
+               return;
+            end if;
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("value:" & Iir_Int32'Image (Get_Enum_Pos (Tree)));
+            Header ("attribute_value_chain:");
+            Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab);
+            Header ("origin:");
+            Disp_Tree (Get_Literal_Origin (Tree), Ntab, True);
+         when Iir_Kind_Integer_Literal =>
+            Header ("staticness:", false);
+            Disp_Expr_Staticness (Tree);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("origin:");
+            Disp_Tree (Get_Literal_Origin (Tree), Ntab, True);
+         when Iir_Kind_Floating_Point_Literal =>
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("origin:");
+            Disp_Tree (Get_Literal_Origin (Tree), Ntab, True);
+         when Iir_Kind_String_Literal =>
+            Header ("value: """ & Iirs_Utils.Image_String_Lit (Tree) & """");
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            Header ("origin:");
+            Disp_Tree (Get_Literal_Origin (Tree), Ntab, True);
+         when Iir_Kind_Bit_String_Literal =>
+            Header ("base:" & Base_Type'Image (Get_Bit_String_Base (Tree)));
+            Header ("value: """ & Iirs_Utils.Image_String_Lit (Tree) & """");
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+         when Iir_Kind_Character_Literal =>
+            Header ("value: '" &
+                    Name_Table.Get_Character (Get_Identifier (Tree)) &
+                    ''');
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+         when Iir_Kind_Physical_Int_Literal =>
+            Header ("staticness:", False);
+            Disp_Expr_Staticness (Tree);
+            Header ("value: " & Iir_Int64'Image (Get_Value (Tree)));
+            Header ("unit_name: ");
+            Disp_Tree_Flat (Get_Unit_Name (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("origin:");
+            Disp_Tree (Get_Literal_Origin (Tree), Ntab);
+         when Iir_Kind_Physical_Fp_Literal =>
+            Header ("staticness:", False);
+            Disp_Expr_Staticness (Tree);
+            Header ("fp_value: " & Iir_Fp64'Image (Get_Fp_Value (Tree)));
+            Header ("unit_name: ");
+            Disp_Tree_Flat (Get_Unit_Name (Tree), Ntab);
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+            Header ("origin:");
+            Disp_Tree (Get_Literal_Origin (Tree), Ntab);
+         when Iir_Kind_Null_Literal =>
+            Header ("type:");
+            Disp_Tree_Flat (Get_Type (Tree), Ntab);
+         when Iir_Kind_Simple_Aggregate =>
+            Header ("simple_aggregate_list:");
+            Disp_Tree_List (Get_Simple_Aggregate_List (Tree), Ntab, True);
+            Header ("type:");
+            Disp_Tree (Get_Type (Tree), Ntab, True);
+            Header ("origin:");
+            Disp_Tree (Get_Literal_Origin (Tree), Ntab, True);
+
+         when Iir_Kind_Proxy =>
+            Header ("proxy:");
+            Disp_Tree_Flat (Get_Proxy (Tree), Ntab);
+         when Iir_Kind_Entity_Class =>
+            null;
+      end case;
+   end Disp_Tree;
+end Disp_Tree;
diff --git a/disp_tree.ads b/disp_tree.ads
new file mode 100644
index 000000000..6e3e3d714
--- /dev/null
+++ b/disp_tree.ads
@@ -0,0 +1,30 @@
+--  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 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 Disp_Tree is
+   --  Disp NODE as an address.  The format is "[XXXXXXXX]", where each X is
+   --  an hexadecimal digit (quotes are not displayed).
+   procedure Disp_Iir_Address (Node: Iir);
+
+   --  Disp TREE recursively.
+   procedure Disp_Tree (Tree: Iir;
+                        Tab: Natural := 0;
+                        Flat_Decl: Boolean := false);
+
+end Disp_Tree;
diff --git a/disp_vhdl.adb b/disp_vhdl.adb
new file mode 100644
index 000000000..1976f0324
--- /dev/null
+++ b/disp_vhdl.adb
@@ -0,0 +1,2369 @@
+--  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 GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+
+-- Disp an iir tree.
+-- Try to be as pretty as possible, and to keep line numbers and positions
+-- of the identifiers.
+with Ada.Text_IO; use Ada.Text_IO;
+with Types; use Types;
+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;
+
+package body Disp_Vhdl is
+
+   --  Disp the name of DECL.
+   procedure Disp_Name_Of (Decl: Iir);
+
+   Indentation: constant Count := 2;
+
+   -- 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_Expression (Expr: 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_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_Label (Node : Iir) is
+      Ident : Name_Id;
+   begin
+      Ident := Get_Label (Node);
+      if Ident /= Null_Identifier then
+         Disp_Ident (Ident);
+      else
+         Put ("<anonymous>");
+      end if;
+   end Disp_Label;
+
+   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_Declaration
+           | Iir_Kind_Constant_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_File_Interface_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_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 =>
+            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 =>
+            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 =>
+            Disp_Label (Decl);
+         when others =>
+            Error_Kind ("disp_name_of", Decl);
+      end case;
+   end Disp_Name_Of;
+
+   procedure Disp_Range (Decl: Iir) is
+   begin
+      if Get_Kind (Decl) = Iir_Kind_Range_Expression then
+         Disp_Expression (Get_Left_Limit (Decl));
+         if Get_Direction (Decl) = Iir_To then
+            Put (" to ");
+         else
+            Put (" downto ");
+         end if;
+         Disp_Expression (Get_Right_Limit (Decl));
+      else
+         Disp_Name_Of (Get_Type_Declarator (Decl));
+      end if;
+   end Disp_Range;
+
+   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 =>
+            Put (Iirs_Utils.Image_Identifier (Name));
+         when Iir_Kind_Selected_Name =>
+            Disp_Name (Get_Prefix (Name));
+            Put (".");
+            Disp_Ident (Get_Suffix_Identifier (Name));
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            Disp_Name_Of (Name);
+         when others =>
+            Error_Kind ("disp_name", Name);
+      end case;
+   end Disp_Name;
+
+   procedure Disp_Use_Clause (Clause: Iir_Use_Clause) is
+   begin
+      Put ("use ");
+      Disp_Name (Get_Selected_Name (Clause));
+      Put_Line (";");
+   end Disp_Use_Clause;
+
+   -- Disp the resolution function (if any) of type definition DEF.
+   procedure Disp_Resolution_Function (Def: Iir) is
+      Decl: Iir;
+   begin
+      Decl := Get_Resolution_Function (Def);
+      if Decl /= Null_Iir then
+         Disp_Name (Decl);
+         Put (' ');
+      end if;
+   end Disp_Resolution_Function;
+
+   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_Function (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_Function (Def);
+      Put ("range ");
+      Disp_Expression (Get_Range_Constraint (Def));
+      Put (";");
+   end Disp_Floating_Subtype_Definition;
+
+   procedure Disp_Subtype_Indication (Def: Iir; Full_Decl: Boolean := False)
+   is
+      Type_Mark: Iir;
+      Base_Type : Iir;
+      Index: Iir;
+      Decl: Iir;
+   begin
+      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_Function (Def);
+
+      -- type mark.
+      Type_Mark := Get_Type_Mark (Def);
+      if Type_Mark /= Null_Iir then
+         Decl := Get_Type_Declarator (Type_Mark);
+         Disp_Name_Of (Decl);
+      end if;
+
+      if Get_Kind (Def) = Iir_Kind_Unconstrained_Array_Subtype_Definition then
+         return;
+      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;
+         when Iir_Kind_Array_Type_Definition =>
+            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 (Get_Range_Constraint (Index);
+            end loop;
+            Put (")");
+         when Iir_Kind_Record_Type_Definition =>
+            null;
+         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
+      Base_Type: Iir;
+   begin
+      Base_Type := Get_Base_Type (Def);
+      Disp_Resolution_Function (Def);
+      Put ("range ");
+      Disp_Range (Def);
+      Put (";");
+   end Disp_Enumeration_Subtype_Definition;
+
+   procedure Disp_Array_Subtype_Definition
+     (Def: Iir_Array_Subtype_Definition)
+   is
+      Index: Iir;
+      A_Type: Iir_Array_Type_Definition;
+   begin
+      Disp_Resolution_Function (Def);
+
+      A_Type := Get_Base_Type (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_Subtype_Indication (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_Subtype_Indication (Index);
+         Put (" range <>");
+      end loop;
+      Put (") of ");
+      Disp_Type (Get_Element_Subtype (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 others =>
+            Error_Kind ("disp_physical_literal", Lit);
+      end case;
+      Put (' ');
+      Disp_Identifier (Get_Unit_Name (Lit));
+   end Disp_Physical_Literal;
+
+   procedure Disp_Physical_Subtype_Definition
+     (Def: Iir_Physical_Subtype_Definition; Indent: Count)
+   is
+      Base_Type: Iir;
+      Unit: Iir_Unit_Declaration;
+   begin
+      Disp_Resolution_Function (Def);
+      Put ("range ");
+      Disp_Expression (Get_Range_Constraint (Def));
+      Base_Type := Get_Base_Type (Def);
+      if Get_Type_Declarator (Base_Type) = Get_Type_Declarator (Def) then
+         Put_Line (" units");
+         Set_Col (Indent + Indentation);
+         Unit := Get_Unit_Chain (Base_Type);
+         Disp_Identifier (Unit);
+         Put_Line (";");
+         Unit := Get_Chain (Unit);
+         while Unit /= Null_Iir loop
+            Set_Col (Indent + Indentation);
+            Disp_Identifier (Unit);
+            Put (" = ");
+            Disp_Physical_Literal (Get_Physical_Literal (Unit));
+            Put_Line (";");
+            Unit := Get_Chain (Unit);
+         end loop;
+         Set_Col (Indent);
+         Put ("end units;");
+      end if;
+   end Disp_Physical_Subtype_Definition;
+
+   procedure Disp_Record_Type_Definition
+     (Def: Iir_Record_Type_Definition; Indent: Count)
+   is
+      El: Iir_Element_Declaration;
+   begin
+      Put_Line ("record");
+      Set_Col (Indent);
+      Put_Line ("begin");
+      El := Get_Element_Declaration_Chain (Def);
+      while El /= Null_Iir loop
+         Set_Col (Indent + Indentation);
+         Disp_Identifier (El);
+         Put (" : ");
+         Disp_Subtype_Indication (Get_Type (El));
+         Put_Line (";");
+         El := Get_Chain (El);
+      end loop;
+      Set_Col (Indent);
+      Put ("end record;");
+   end Disp_Record_Type_Definition;
+
+   procedure Disp_Designator_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;
+         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 (Decl: in Iir; Indent: Count) is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Disp_Enumeration_Type_Definition (Decl);
+         when Iir_Kind_Enumeration_Subtype_Definition =>
+            Disp_Enumeration_Subtype_Definition (Decl);
+         when Iir_Kind_Integer_Subtype_Definition =>
+            Disp_Integer_Subtype_Definition (Decl);
+         when Iir_Kind_Floating_Subtype_Definition =>
+            Disp_Floating_Subtype_Definition (Decl);
+         when Iir_Kind_Array_Type_Definition =>
+            Disp_Array_Type_Definition (Decl);
+         when Iir_Kind_Array_Subtype_Definition =>
+            Disp_Array_Subtype_Definition (Decl);
+         when Iir_Kind_Physical_Subtype_Definition =>
+            Disp_Physical_Subtype_Definition (Decl, Indent);
+         when Iir_Kind_Record_Type_Definition =>
+            Disp_Record_Type_Definition (Decl, Indent);
+         when Iir_Kind_Access_Type_Definition =>
+            Put ("access ");
+            Disp_Subtype_Indication (Get_Designated_Type (Decl));
+            Put (';');
+         when Iir_Kind_File_Type_Definition =>
+            Put ("file of ");
+            Disp_Subtype_Indication (Get_Type_Mark (Decl));
+            Put (';');
+         when Iir_Kind_Protected_Type_Declaration =>
+            Put_Line ("protected");
+            Disp_Declaration_Chain (Decl, Indent + Indentation);
+            Set_Col (Indent);
+            Put ("end 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", Decl);
+      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 (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
+      Indent: Count;
+      Def : Iir;
+   begin
+      Indent := Col;
+      Put ("-- type ");
+      Disp_Name_Of (Decl);
+      Put (" is ");
+      Def := Get_Type (Decl);
+      Disp_Type_Definition (Def, Indent);
+      if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then
+         declare
+            Unit : Iir_Unit_Declaration;
+         begin
+            Put_Line (" units");
+            Set_Col (Indent);
+            Put ("--   ");
+            Unit := Get_Unit_Chain (Def);
+            Disp_Identifier (Unit);
+            Put_Line (";");
+            Unit := Get_Chain (Unit);
+            while Unit /= Null_Iir loop
+               Set_Col (Indent);
+               Put ("--   ");
+               Disp_Identifier (Unit);
+               Put (" = ");
+               Disp_Physical_Literal (Get_Physical_Literal (Unit));
+               Put_Line (";");
+               Unit := Get_Chain (Unit);
+            end loop;
+            Set_Col (Indent);
+            Put ("-- end units;");
+         end;
+      end if;
+      New_Line;
+   end Disp_Anonymous_Type_Declaration;
+
+   procedure Disp_Subtype_Declaration (Decl: in Iir_Subtype_Declaration) is
+   begin
+      Put ("subtype ");
+      Disp_Name_Of (Decl);
+      Put (" is ");
+      Disp_Subtype_Indication (Get_Type (Decl), 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 =>
+               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_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_Declaration (Interface: Iir) is
+      Default: Iir;
+   begin
+      case Get_Kind (Interface) is
+         when Iir_Kind_Signal_Interface_Declaration =>
+            Put ("signal ");
+         when Iir_Kind_Variable_Interface_Declaration =>
+            Put ("variable ");
+         when Iir_Kind_Constant_Interface_Declaration =>
+            Put ("constant ");
+         when others =>
+            Error_Kind ("disp_interface_declaration", Interface);
+      end case;
+      Disp_Name_Of (Interface);
+      Put (": ");
+      Disp_Mode (Get_Mode (Interface));
+      Disp_Type (Get_Type (Interface));
+      if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration then
+         Disp_Signal_Kind (Get_Signal_Kind (Interface));
+      end if;
+      Default := Get_Default_Value (Interface);
+      if Default /= Null_Iir then
+         Put (" := ");
+         Disp_Expression (Default);
+      end if;
+   end Disp_Interface_Declaration;
+
+   procedure Disp_Interface_Chain (Chain: Iir; Str: String)
+   is
+      Interface: Iir;
+      Start: Count;
+   begin
+      if Chain = Null_Iir then
+         return;
+      end if;
+      Put (" (");
+      Start := Col;
+      Interface := Chain;
+      while Interface /= Null_Iir loop
+         Set_Col (Start);
+         Disp_Interface_Declaration (Interface);
+         if Get_Chain (Interface) /= Null_Iir then
+            Put ("; ");
+         else
+            Put (')');
+            Put (Str);
+         end if;
+         Interface := Get_Chain (Interface);
+      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: Count;
+   begin
+      Start := Col;
+      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_Concurrent_Statement_Chain (Decl) /= Null_Iir then
+         Set_Col (Start);
+         Put_Line ("begin");
+         Disp_Concurrent_Statement_Chain (Decl, Start + Indentation);
+      end if;
+      Set_Col (Start);
+      Put_Line ("end 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_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);
+      Put ("end 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_Declaration (Arch: Iir_Architecture_Declaration)
+   is
+      Start: Count;
+   begin
+      Start := Col;
+      Put ("architecture ");
+      Disp_Name_Of (Arch);
+      Put (" of ");
+      Disp_Name_Of (Get_Entity (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);
+      Put_Line ("end;");
+   end Disp_Architecture_Declaration;
+
+   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
+   begin
+      Put ("alias ");
+      Disp_Function_Name (Decl);
+      Put (" is ");
+      Disp_Name (Get_Name (Decl));
+      Put_Line (";");
+   end Disp_Non_Object_Alias_Declaration;
+
+   procedure Disp_File_Declaration (Decl: Iir_File_Declaration) is
+      Expr: Iir;
+   begin
+      Put ("file ");
+      Disp_Name_Of (Decl);
+      Put (": ");
+      Disp_Type (Get_Type (Decl));
+      if Vhdl_Std = Vhdl_87 then
+         Put (" is ");
+         Disp_Mode (Get_Mode (Decl));
+         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_Object_Declaration (Decl: Iir) is
+   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_Object_Alias_Declaration =>
+            Disp_Object_Alias_Declaration (Decl);
+            return;
+         when Iir_Kind_File_Declaration =>
+            Disp_File_Declaration (Decl);
+            return;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Disp_Name_Of (Decl);
+      Put (": ");
+      Disp_Type (Get_Type (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_Driver_List (List: Iir_Driver_List; Indent : Count)
+   is
+      El: Iir;
+   begin
+      if List = Null_Iir_List or else Get_Nbr_Elements (List) = 0 then
+         return;
+      end if;
+      Set_Col (Indent);
+      Put_Line ("-- drivers needed for signals:");
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         Set_Col (Indent);
+         Put ("--   ");
+         Disp_Expression (El);
+         New_Line;
+      end loop;
+   end Disp_Driver_List;
+
+   procedure Disp_Subprogram_Declaration (Subprg: Iir)
+   is
+      Indent: Count;
+   begin
+      Indent := Col;
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            Put ("function ");
+            Disp_Function_Name (Subprg);
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            Put ("procedure ");
+            Disp_Identifier (Subprg);
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Disp_Interface_Chain (Get_Interface_Declaration_Chain (Subprg), "");
+
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            Put (" return ");
+            Disp_Type (Get_Return_Type (Subprg));
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            null;
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then
+         Disp_Driver_List (Get_Driver_List (Subprg), Indent);
+      end if;
+   end Disp_Subprogram_Declaration;
+
+   procedure Disp_Subprogram_Body (Subprg : Iir)
+   is
+      Decl : Iir;
+      Indent : Count;
+   begin
+      Decl := Get_Subprogram_Specification (Subprg);
+      Indent := Col;
+      if Get_Chain (Decl) /= Subprg then
+         Disp_Subprogram_Declaration (Decl);
+      end if;
+      Put_Line ("is");
+      Set_Col (Indent);
+      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);
+      Put_Line ("end;");
+   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_Of (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_Subtype_Indication (Get_Type (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_Type (Get_Type (Attr));
+      Put_Line (";");
+   end Disp_Attribute_Declaration;
+
+   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
+      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;
+   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);
+      Put_Line ("end protected body;");
+   end Disp_Protected_Type_Body;
+
+   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_Kinds_Object_Declaration =>
+               Disp_Object_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 Get_Subprogram_Body (Decl) = Null_Iir
+                 or else Get_Subprogram_Body (Decl) /= Get_Chain (Decl)
+               then
+                  Put_Line (";");
+               end if;
+            when Iir_Kind_Function_Body
+              | Iir_Kind_Procedure_Body =>
+               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 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 (Label: Name_Id) is
+   begin
+      if Label /= Null_Identifier then
+         Disp_Ident (Label);
+         Put (": ");
+      end if;
+   end Disp_Label;
+
+   procedure Disp_Concurrent_Selected_Signal_Assignment (Stmt: Iir)
+   is
+      Indent: Count;
+      Assoc: Iir;
+      Assoc_Chain : Iir;
+   begin
+      Indent := Col;
+      Set_Col (Indent);
+      Disp_Label (Get_Label (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 (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 (Get_Label (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: Count;
+      Expr: Iir;
+   begin
+      Start := Col;
+      if Get_Kind (Stmt) = Iir_Kind_Concurrent_Assertion_Statement then
+         Disp_Label (Get_Label (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
+      Put ("(");
+      Disp_Expression (Get_Left (Expr));
+      Put (' ' & Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr)) & ' ');
+      Disp_Expression (Get_Right (Expr));
+      Put (")");
+   end Disp_Dyadic_Operator;
+
+   procedure Disp_Monadic_Operator (Expr: Iir) is
+   begin
+      Put (Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr)) & " (");
+      Disp_Expression (Get_Operand (Expr));
+      Put (")");
+   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 (Assoc);
+         Disp_Choice (Assoc);
+         Put_Line (" =>");
+         Set_Col (Indent + 2 * Indentation);
+         Disp_Sequential_Statements (Sel_Stmt);
+      end loop;
+      Set_Col (Indent);
+      Put_Line ("end 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);
+      Put_Line ("end if;");
+   end Disp_If_Statement;
+
+   procedure Disp_Iterator (Iterator: Iir) is
+   begin
+      Disp_Subtype_Indication (Iterator);
+   end Disp_Iterator;
+
+   procedure Disp_Parameter_Specification
+     (Iterator : Iir_Iterator_Declaration) is
+   begin
+      Disp_Identifier (Iterator);
+      Put (" in ");
+      Disp_Iterator (Get_Type (Iterator));
+   end Disp_Parameter_Specification;
+
+   procedure Disp_Procedure_Call (Call : Iir)
+   is
+      Obj : Iir;
+   begin
+      Obj := Get_Method_Object (Call);
+      if Obj /= Null_Iir then
+         Disp_Name (Obj);
+         Put ('.');
+      end if;
+      Disp_Identifier (Get_Implementation (Call));
+      Put (' ');
+      Disp_Association_Chain (Get_Parameter_Association_Chain (Call));
+      Put_Line (";");
+   end Disp_Procedure_Call;
+
+   procedure Disp_Sequential_Statements (First : Iir)
+   is
+      Stmt: Iir;
+      Start: Count;
+   begin
+      Start := Col;
+      Stmt := First;
+      while Stmt /= Null_Iir loop
+         Set_Col (Start);
+         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_Iterator_Scheme (Stmt));
+               Put_Line (" loop");
+               Set_Col (Start + Indentation);
+               Disp_Sequential_Statements
+                 (Get_Sequential_Statement_Chain (Stmt));
+               Set_Col (Start);
+               Put_Line ("end 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);
+               Put_Line ("end 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 =>
+               if Get_Kind (Stmt) = Iir_Kind_Exit_Statement then
+                  Put ("exit");
+               else
+                  Put ("next");
+               end if;
+               -- FIXME: label.
+               if Get_Condition (Stmt) /= Null_Iir then
+                  Put (" when ");
+                  Disp_Expression (Get_Condition (Stmt));
+               end if;
+               Put_Line (";");
+
+            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: Count;
+   begin
+      Start := Col;
+      Disp_Label (Get_Label (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 Vhdl_Std >= Vhdl_93 then
+         Put_Line (" is");
+      else
+         New_Line;
+      end if;
+      Disp_Driver_List (Get_Driver_List (Process), Start + Indentation);
+      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_Line ("end process;");
+   end Disp_Process_Statement;
+
+   procedure Disp_Association_Chain (Chain : Iir)
+   is
+      El: Iir;
+      Formal: Iir;
+      Indent: Count;
+      Need_Comma : Boolean;
+      Conv : Iir;
+   begin
+      if Chain = Null_Iir then
+         return;
+      end if;
+      Put ("(");
+      Indent := Col;
+      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;
+            if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then
+               Conv := Get_Out_Conversion (El);
+               if Conv /= Null_Iir then
+                  Disp_Function_Name (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;
+            if Get_Kind (El) = Iir_Kind_Association_Element_Open then
+               Put ("open");
+            else
+               Conv := Get_In_Conversion (El);
+               if Conv /= Null_Iir then
+                  Disp_Function_Name (Conv);
+                  Put (" (");
+               end if;
+               Disp_Expression (Get_Actual (El));
+               if Conv /= Null_Iir then
+                  Put (")");
+               end if;
+            end if;
+            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_Of (Get_Entity (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_Of (Get_Configuration (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: Iir;
+      Alist: Iir;
+   begin
+      Disp_Label (Get_Label (Stmt));
+      Component := Get_Instantiated_Unit (Stmt);
+      if Get_Kind (Component) = Iir_Kind_Component_Declaration then
+         Disp_Name_Of (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
+      Disp_Function_Name (Get_Implementation (Expr));
+      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_Expression (Choice));
+            when Iir_Kind_Choice_By_Range =>
+               Disp_Range (Get_Expression (Choice));
+            when Iir_Kind_Choice_By_Name =>
+               Disp_Name_Of (Get_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
+      Put ("(");
+      Indent := Col;
+      Assoc := Get_Association_Choices_Chain (Aggr);
+      loop
+         Expr := Get_Associated (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 then
+         Put (" (");
+         Disp_Expression (Param);
+         Put (")");
+      end if;
+   end Disp_Parametered_Attribute;
+
+   procedure Disp_String_Literal (Str : Iir)
+   is
+      Ptr : String_Fat_Acc;
+      Len : Natural;
+   begin
+      Ptr := Get_String_Fat_Acc (Str);
+      Len := Get_String_Length (Str);
+      Put (Ptr (1 .. Len));
+   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 =>
+            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;
+         when Iir_Kind_Bit_String_Literal =>
+            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 ("""");
+         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_Enumeration_Literal =>
+            Disp_Name_Of (Expr);
+         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 =>
+            Disp_Simple_Aggregate (Expr);
+
+         when Iir_Kind_Element_Declaration =>
+            Disp_Name_Of (Expr);
+
+         when Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Constant_Interface_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_File_Interface_Declaration
+           | Iir_Kind_Iterator_Declaration =>
+            Disp_Name_Of (Expr);
+            return;
+
+         when Iir_Kind_Simple_Name =>
+            Disp_Name (Expr);
+
+         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_Type_Conversion =>
+            Disp_Type (Get_Type (Expr));
+            Put (" (");
+            Disp_Expression (Get_Expression (Expr));
+            Put (")");
+         when Iir_Kind_Qualified_Expression =>
+            Disp_Type (Get_Type_Mark (Expr));
+            Put ("'(");
+            Disp_Expression (Get_Expression (Expr));
+            Put (")");
+         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_Expression (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_Expression (Get_Prefix (Expr));
+            Put ("'left");
+         when Iir_Kind_Right_Type_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'right");
+         when Iir_Kind_High_Type_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'high");
+         when Iir_Kind_Low_Type_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'low");
+
+         when Iir_Kind_Stable_Attribute =>
+            Disp_Parametered_Attribute ("stable", 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_Last_Value_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'last_value");
+         when Iir_Kind_Last_Event_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'last_event");
+
+         when Iir_Kind_Pos_Attribute =>
+            Disp_Parametered_Attribute ("pos", Expr);
+         when Iir_Kind_Val_Attribute =>
+            Disp_Parametered_Attribute ("val", Expr);
+         when Iir_Kind_Succ_Attribute =>
+            Disp_Parametered_Attribute ("succ", Expr);
+         when Iir_Kind_Pred_Attribute =>
+            Disp_Parametered_Attribute ("pred", 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_Simple_Name_Attribute =>
+            Disp_Name_Of (Get_Prefix (Expr));
+            Put ("'simple_name");
+         when Iir_Kind_Instance_Name_Attribute =>
+            Disp_Name_Of (Get_Prefix (Expr));
+            Put ("'instance_name");
+         when Iir_Kind_Path_Name_Attribute =>
+            Disp_Name_Of (Get_Prefix (Expr));
+            Put ("'path_name");
+
+         when Iir_Kind_Selected_By_All_Name =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("");
+            return;
+         when Iir_Kind_Selected_Name =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ('.');
+            Disp_Expression (Get_Suffix (Expr));
+            return;
+
+         when Iir_Kinds_Type_And_Subtype_Definition =>
+            Disp_Type (Expr);
+
+         when Iir_Kind_Proxy =>
+            Disp_Expression (Get_Proxy (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_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 (Get_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);
+      Put_Line ("end;");
+   end Disp_Block_Statement;
+
+   procedure Disp_Generate_Statement (Stmt : Iir_Generate_Statement)
+   is
+      Indent : Count;
+      Scheme : Iir;
+   begin
+      Indent := Col;
+      Disp_Label (Get_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);
+      Set_Col (Indent);
+      Put_Line ("begin");
+      Disp_Concurrent_Statement_Chain (Stmt, Indent + Indentation);
+      Set_Col (Indent);
+      Put_Line ("end generate;");
+   end Disp_Generate_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_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 others =>
+            Error_Kind ("disp_concurrent_statement", Stmt);
+      end case;
+   end Disp_Concurrent_Statement;
+
+   procedure Disp_Package_Declaration (Decl: Iir_Package_Declaration) is
+   begin
+      Put ("package ");
+      Disp_Identifier (Decl);
+      Put_Line (" is");
+      Disp_Declaration_Chain (Decl, Col + Indentation);
+      Put_Line ("end;");
+   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);
+      Put_Line ("end;");
+   end Disp_Package_Body;
+
+   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);
+      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_Declaration =>
+            Disp_Name_Of (Spec);
+         when Iir_Kind_Indexed_Name =>
+            Disp_Name_Of (Get_Prefix (Spec));
+            Put (" (");
+            Disp_Expression (Get_First_Element (Get_Index_List (Spec)));
+            Put (")");
+         when Iir_Kind_Selected_Name =>
+            Disp_Name_Of (Get_Prefix (Spec));
+            Put (" (");
+            Put (Iirs_Utils.Image_Identifier (Spec));
+            Put (")");
+         when Iir_Kind_Slice_Name =>
+            Disp_Name_Of (Get_Prefix (Spec));
+            Put (" (");
+            Disp_Range (Get_Suffix (Spec));
+            Put (")");
+         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_Of (Get_Entity (Decl));
+      Put_Line (" is");
+      Disp_Declaration_Chain (Decl, Col);
+      Disp_Block_Configuration (Get_Block_Configuration (Decl),
+                                Col + Indentation);
+      Put_Line ("end;");
+   end Disp_Configuration_Declaration;
+
+   procedure Disp_Design_Unit (Unit: Iir_Design_Unit)
+   is
+      Decl: Iir;
+      Indent: Count;
+   begin
+      Indent := Col;
+      Decl := Get_Context_Items (Unit);
+      while Decl /= Null_Iir loop
+         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);
+               Put_Line (";");
+            when others =>
+               Error_Kind ("disp_design_unit1", Decl);
+         end case;
+         Decl := Get_Chain (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_Declaration =>
+            Disp_Architecture_Declaration (Decl);
+         when Iir_Kind_Package_Declaration =>
+            Disp_Package_Declaration (Decl);
+         when Iir_Kind_Package_Body =>
+            Disp_Package_Body (Decl);
+         when Iir_Kind_Configuration_Declaration =>
+            Disp_Configuration_Declaration (Decl);
+         when others =>
+            Error_Kind ("disp_design_unit2", Decl);
+      end case;
+      New_Line (2);
+   end Disp_Design_Unit;
+
+   procedure Disp_Vhdl (An_Iir: Iir) is
+   begin
+      Set_Line_Length (80);
+      -- 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_Signal_Interface_Declaration =>
+            Disp_Name_Of (An_Iir);
+         when Iir_Kind_Signal_Declaration =>
+            Disp_Identifier (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 =>
+            Disp_Name (An_Iir);
+         when others =>
+            Error_Kind ("disp", An_Iir);
+      end case;
+   end Disp_Vhdl;
+
+   procedure Disp_Int64 (Val: Iir_Int64)
+   is
+      Str: 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: 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: 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/disp_vhdl.ads b/disp_vhdl.ads
new file mode 100644
index 000000000..592c786a9
--- /dev/null
+++ b/disp_vhdl.ads
@@ -0,0 +1,36 @@
+--  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 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 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);
+
+   -- 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/doc/ghdl.texi b/doc/ghdl.texi
new file mode 100644
index 000000000..4824cdf84
--- /dev/null
+++ b/doc/ghdl.texi
@@ -0,0 +1,2371 @@
+\input texinfo   @c -*-texinfo-*-
+@c %**start of header
+@setfilename ghdl.info
+@settitle GHDL guide
+@c %**end of header
+
+@titlepage
+@title GHDL guide
+@subtitle GHDL, a VHDL compiler
+@subtitle For GHDL version 0.19 (Sokcho edition)
+@author Tristan Gingold
+@c The following two commands start the copyright page.
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 2002, 2003, 2004, 2005 Tristan Gingold.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.1 or
+any later version published by the Free Software Foundation.
+@end titlepage
+
+@ignore
+Part I: User guide
+1) Intro: what is vhdl, what is ghdl
+2) starting with ghdl: a few examples
+2.1) hello world
+2.2) a nand gate
+2.3) testsuite for a nand gate
+2.4) a nand3 gate (using components)
+2.5) testsuite for the nand3
+
+Part II: Reference guide
+1) command line options
+1.1) filename extension.
+2) Current standards
+2.w) what is 93c
+3) Linking with Ada or C code. FOREIGN use.
+3) library organization
+4) built-in libraries and pathes.
+5) debugging your program.
+6) report messages (run time errors, boundary errors, assertion)
+7) Error message, improve it.
+8) current bugs, how to report a bug.
+9) Copyright
+
+done: ?) source representation
+done: ?) copyright
+done: ?) debugging
+done: ?) executable options
+done: ?) top entity characteristics
+done: ?) work library
+done: ?) ieee library
+done: ?) file format (textio/not textio)
+
+TODO:
+XX: indexes
+XXX: signals cannot be forced, only viewed in depth.
+x: implementation dependant: files (see 4.3.1.4)
+
+To check:
+model vs modeling vs modelize
+behaviour vs behavior
+analyze vs analyse
+
+Internal overview
+ ortho
+ grt subprograms
+@end ignore
+
+@contents
+
+@ifnottex
+@node Top
+@top GHDL guide
+GHDL, a VHDL compiler.
+
+Copyright @copyright{} 2002, 2003, 2004 Tristan Gingold.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.1
+or any later version published by the Free Software Foundation.
+
+@menu
+* Introduction::                What is GHDL, what is VHDL
+* Starting with GHDL::          Build a VHDL program with GHDL
+* Invoking GHDL::               
+* Simulation and run time::     
+* GHDL implementation of VHDL::  
+* GHDL implementation of VITAL::  
+* Flaws and bugs report::       
+* Copyrights::                  
+* Index::                       
+
+@end menu
+
+@end ifnottex
+
+@node Introduction, Starting with GHDL, Top, Top
+@comment  node-name,  next,  previous,  up
+@chapter Introduction
+
+@menu
+* What is VHDL::                
+* What is GHDL::                
+@end menu
+
+@section Content of this manual
+This manual is the user and reference manual for GHDL.  It does not
+contain an introduction to VHDL.  Thus, the reader should have at least
+a basic knowledge of VHDL.  A good knowledge of VHDL language reference
+manual (usually called LRM) is a plus.
+
+@c FIXME: references: URL, LRM reference.
+
+@node What is VHDL, What is GHDL, Introduction, Introduction
+@comment  node-name,  next,  previous,  up
+@section What is @code{VHDL}?
+@dfn{VHDL} is an acronym for Very High Speed Integrated Circuit Hardware
+Description Language which is a programming language used to describe a
+logic circuit by function, data flow behaviour, or structure.
+
+@code{VHDL} @emph{is} a programming language: although @code{VHDL} was
+not designed for writing general purpose programs, you can write any
+algorithm with the @code{VHDL} language.  If you are able to write
+programs, you will find in @code{VHDL} features similar to those found
+in procedural languages such as @code{C}, @code{Pascal} or @code{Ada}.
+@code{VHDL} derives most of its syntax and semantics from @code{Ada}.
+Knowing @code{Ada} is an advantage for learning @code{VHDL} (it is an
+advantage in general as well).
+
+However, @code{VHDL} was not designed as a general purpose language but as an
+@code{HDL} (hardware description language).  As the name implies, @code{VHDL}
+aims at modeling or documenting electronics systems.  Due to the nature
+of hardware components which are always running, @code{VHDL} is a highly
+concurrent language, built upon an event-based timing model.
+
+Like a program written in any other language, a @code{VHDL} program
+can be executed. Since @code{VHDL} is used to model designs, the term
+@dfn{simulation} is often used instead of @dfn{execution}, with the
+same meaning.
+
+Like a program written in another hardware description language, a
+@code{VHDL} program can be transformed with a @code{synthesis tool}
+into a netlist, that is, a detailed gate-level implementation.
+
+@node What is GHDL,  , What is VHDL, Introduction
+@comment  node-name,  next,  previous,  up
+@section What is @code{GHDL}?
+@dfn{GHDL} is a shorthand for G Hardware Design Language.  Currently,
+@code{G} has no meaning.
+
+@dfn{GHDL} is a @code{VHDL} compiler that can execute (nearly) any
+@code{VHDL} program. @code{GHDL} is @emph{not} a synthesis tool: you cannot
+create a netlist with @code{GHDL}.
+
+Unlike some other simulators, @code{GHDL} is a compiler: it directly
+translates a @code{VHDL} file to machine code, using the @code{GCC}
+back-end and without using an intermediary language such as @code{C}
+or @code{C++}.  Therefore, the compiled code should be faster and
+the analysis time should be shorter than with a compiler using an
+intermediary language.
+
+The current version of @code{GHDL} does not contain any graphical
+viewer: you cannot see signal waves.  You can still check with a test
+bench.  The current version can produce a @code{VCD} file which can be
+viewed with a wave viewer.
+
+@code{GHDL} aims at implementing @code{VHDL} as defined by IEEE 1076.
+It supports most of the 1987 standard and most features added by the
+1993 standard.
+
+
+@node Starting with GHDL, Invoking GHDL, Introduction, Top
+@comment  node-name,  next,  previous,  up
+@chapter Starting with GHDL
+In this chapter, you will learn how to use the GHDL compiler by
+working on two examples.
+
+@menu
+* The hello word program::      
+* A full adder::                
+* Starting with a design::      
+@end menu
+
+@node The hello word program, A full adder, Starting with GHDL, Starting with GHDL
+@comment  node-name,  next,  previous,  up
+@section The hello world program
+To illustrate the large purpose of VHDL, here is a commented VHDL
+"Hello world" program.
+
+@example
+--  @r{Hello world program.}
+use std.textio.all; --  @r{Imports the standard textio package.}
+
+--  @r{Defines a design entity, without any ports.}
+entity hello_world is
+end hello_world;
+
+architecture behaviour of hello_world is
+begin
+   process
+      variable l : line;
+   begin
+      write (l, String'("Hello world!"));
+      writeline (output, l);
+      wait;
+   end process;
+end behaviour;
+@end example
+
+Suppose this program is contained in the file @file{hello.vhdl}.
+First, you have to compile the file; this is called @dfn{analysis} of a design
+file in VHDL terms.
+@smallexample
+$ ghdl -a hello.vhdl
+@end smallexample
+This command generates a file @file{hello.o}, which is the object file
+corresponding to your VHDL program.  This command also creates or updates
+a file @file{work-obj93.cf}, which describes the library @samp{work}.
+
+Then, you have to build an executable file.
+@smallexample
+$ ghdl -e hello_world
+@end smallexample
+The @samp{-e} option means @dfn{elaborate}.  With this option, @code{GHDL}
+creates code in order to elaborate a design, with the @samp{hello}
+entity at the top of the hierarchy.
+
+The result is an executable program called @file{hello} which can be run:
+@smallexample
+$ ghdl -r hello_world
+@end smallexample
+or directly:
+@smallexample
+$ ./hello_world
+@end smallexample
+
+and which should display:
+@smallexample
+Hello world!
+@end smallexample
+
+@node A full adder, Starting with a design, The hello word program, Starting with GHDL
+@comment  node-name,  next,  previous,  up
+@section A full adder
+VHDL is generally used for hardware design.  This example starts with
+a full adder described in the @file{adder.vhdl} file:
+
+@example
+entity adder is
+  -- @r{@var{i0}, @var{i1} and the carry-in @var{ci} are inputs of the adder.}
+  -- @r{@var{s} is the sum output, @var{co} is the carry-out.}
+  port (i0, i1 : in bit; ci : in bit; s : out bit; co : out bit);
+end adder;
+
+architecture rtl of adder is
+begin
+   --  @r{This full-adder architecture contains two concurrent assignment.}
+   --  @r{Compute the sum.}
+   s <= i0 xor i1 xor ci;
+   --  @r{Compute the carry.}
+   co <= (i0 and i1) or (i0 and ci) or (i1 and ci);
+end rtl;
+@end example
+
+You can analyze this design file:
+@smallexample
+$ ghdl -a adder.vhdl
+@end smallexample
+
+You can try to execute the @samp{adder} design, but this is useless,
+since nothing externally visible will happen.  In order to
+check this full adder, a testbench has to be run.  This testbench is
+very simple, since the adder is also simple: it checks exhaustively all
+inputs.  Note that only the behaviour is tested, timing constraints are
+not checked.  The file @file{adder_tb.vhdl} contains the testbench for
+the adder:
+@example
+--  @r{A testbench has no ports.}
+entity adder_tb is
+end adder_tb;
+
+architecture behav of adder_tb is
+   --  @r{Declaration of the component that will be instantiated.}
+   component adder
+     port (i0, i1 : in bit; ci : in bit; s : out bit; co : out bit);
+   end component;
+   --  @r{Specifies which entity is bound with the component.}
+   for adder_0: adder use entity work.adder;
+   signal i0, i1, ci, s, co : bit;
+begin
+   --  @r{Component instantiation.}
+   adder_0: adder port map (i0 => i0, i1 => i1, ci => ci,
+                            s => s, co => co);
+
+   --  @r{This process does the real job.}
+   process
+      type pattern_type is record
+         --  @r{The inputs of the adder.}
+         i0, i1, ci : bit;
+         --  @r{The expected outputs of the adder.}
+         s, co : bit;
+      end record;
+      --  @r{The patterns to apply.}
+      type pattern_array is array (natural range <>) of pattern_type;
+      constant patterns : pattern_array :=
+        (('0', '0', '0', '0', '0'),
+         ('0', '0', '1', '1', '0'),
+         ('0', '1', '0', '1', '0'),
+         ('0', '1', '1', '0', '1'),
+         ('1', '0', '0', '1', '0'),
+         ('1', '0', '1', '0', '1'),
+         ('1', '1', '0', '0', '1'),
+         ('1', '1', '1', '1', '1'));
+   begin
+      --  @r{Check each pattern.}
+      for i in patterns'range loop
+         --  @r{Set the inputs.}
+         i0 <= patterns(i).i0;
+         i1 <= patterns(i).i1;
+         ci <= patterns(i).ci;
+         --  @r{Wait for the results.}
+         wait for 1 ns;
+         --  @r{Check the outputs.}
+         assert s = patterns(i).s
+            report "bad sum value" severity error;
+         assert co = patterns(i).co
+            report "bad carray out value" severity error;
+      end loop;
+      assert false report "end of test" severity note;
+      --  @r{Wait forever; this will finish the simulation.}
+      wait;
+   end process;
+end behav;
+@end example
+
+As usual, you should analyze the design:
+@smallexample
+$ ghdl -a adder_tb.vhdl
+@end smallexample
+And build an executable for the testbench:
+@smallexample
+$ ghdl -e adder_tb
+@end smallexample
+You do not need to specify which object files are required: GHDL knows them
+and automatically adds them in the executable.  Now, it is time to run the
+testbench:
+@smallexample
+$ ghdl -r adder_tb
+adder_tb.vhdl:52:7:(assertion note): end of test
+@end smallexample
+
+If your design is rather complex, you'd like to inspect signals.  Signals
+value can be dumped using the VCD file format.  The resulting file can be
+read with a wave viewer such as GTKWave.  First, you should simulate your
+design and dump a waveform file:
+@smallexample
+$ ghdl -r adder_tb --vcd=adder.vcd
+@end smallexample
+Then, you may now view the waves:
+@smallexample
+$ gtkwave adder.vcd
+@end smallexample
+
+@xref{Simulation options}, for more details on the @option{--vcd} option and
+other run time options.
+
+@node Starting with a design,  , A full adder, Starting with GHDL
+@comment  node-name,  next,  previous,  up
+@section Starting with a design
+Unless you are only studying VHDL, you will work with bigger designs than
+the ones of the previous examples.
+
+Let's see how to analyze and run a bigger design, such as the DLX model
+suite written by Peter Ashenden which is distributed under the terms of the
+GNU General Public License.
+
+First, untar the sources:
+@smallexample
+$ tar zxvf dlx.tar.Z
+@end smallexample
+
+In order not to pollute the sources with the library, it is a good idea
+to create a @file{work/} subdirectory for the @samp{WORK} library.  To
+any GHDL commands, we will add the @option{--workdir=work} option, so
+that all files generated by the compiler (except the executable) will be
+placed in this directory.
+@smallexample
+$ cd dlx
+$ mkdir work
+@end smallexample
+
+We will run the @samp{dlx_test_behaviour} design.  We need to analyze
+all the design units for the design hierarchy, in the correct order.
+GHDL provides an easy way to do this, by importing the sources:
+@smallexample
+$ ghdl -i --workdir=work *.vhdl
+@end smallexample
+
+and making a design:
+@smallexample
+$ ghdl -m --workdir=work dlx_test_behaviour
+@end smallexample
+
+Before this second stage, GHDL knows all the design units of the DLX,
+but no one have been analyzed.  The make command of GHDL analyzes and
+elaborates a design.  This creates many files in the @file{work/}
+directory, and the @file{dlx_test_behaviour} executable in the current
+directory.
+
+The simulation needs to have a DLX program contained in the file
+@file{dlx.out}.  This memory image will be be loaded in the DLX memory.
+Just take one sample:
+@smallexample
+$ cp test_loop.out dlx.out
+@end smallexample
+
+And you can run the test suite:
+@smallexample
+$ ghdl -r dlx_test_behaviour
+@end smallexample
+
+The test bench monitors the bus and displays each instruction executed.
+It finishes with an assertion of severity level note:
+@smallexample
+dlx-behaviour.vhdl:395:11:(assertion note): TRAP instruction
+ encountered, execution halted
+@end smallexample
+
+Since the clock is still running, you have to manually stop the program
+with the @kbd{C-c} key sequence.  This behavior prevents you from running the
+test bench in batch mode.  However, you may force the simulator to
+stop when an assertion above or equal a certain severity level occurs:
+@smallexample
+$ ghdl -r dlx_test_behaviour --assert-level=note
+@end smallexample
+
+With this option, the program stops just after the previous message:
+@smallexample
+dlx-behaviour.vhdl:395:11:(assertion note): TRAP instruction
+ encountered, execution halted
+error: assertion failed
+@end smallexample
+
+If you want to make room on your hard drive, you can either:
+@itemize @bullet{}
+@item
+clean the design library with the GHDL command:
+@smallexample
+$ ghdl --clean --workdir=work
+@end smallexample
+This removes the executable and all the object files.  If you want to
+rebuild the design at this point, just do the make command as shown above.
+@item
+remove the design library with the GHDL command:
+@smallexample
+$ ghdl --remove --workdir=work
+@end smallexample
+This removes the executable, all the object files and the library file.
+If you want to rebuild the design, you have to import the sources again,
+and to make the design.
+@item
+remove the @file{work/} directory:
+@smallexample
+$ rm -rf work
+@end smallexample
+Only the executable is kept.  If you want to rebuild the design, create
+the @file{work/} directory, import the sources, and make the design.
+@end itemize
+
+Sometimes, a design does not fully follow the VHDL standards.  For example it
+uses the badly engineered @samp{std_logic_unsigned} package.  GHDL supports
+this VHDL dialect through some options:
+@smallexample
+--ieee=synopsys -fexplicit
+@end smallexample
+@xref{IEEE library pitfalls}, for more details.
+
+@node Invoking GHDL, Simulation and run time, Starting with GHDL, Top
+@comment  node-name,  next,  previous,  up
+@chapter Invoking GHDL
+The form of the @code{ghdl} command is
+
+@smallexample
+$ ghdl @var{command} [@var{options@dots{}}]
+@end smallexample
+
+The GHDL program has several commands.  The first argument selects
+the commands.  The options are used to slighly modify the action.
+
+No options are allowed before the command.  Except for the run commands,
+no options are allowed after a filename or a unit name.
+
+@menu
+* Building commands::           
+* GHDL options::                
+* Passing options to other programs::  
+* GHDL warnings::               
+* Rebuilding commands::         
+* Library commands::            
+* Cross-reference command::     
+* File commands::               
+* Misc commands::               
+* IEEE library pitfalls::       
+@end menu
+
+@node Building commands, GHDL options, Invoking GHDL, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section Building commands
+The mostly used commands of GHDL are those to analyze and elaborate a design.
+
+@menu
+* Analysis command::            
+* Elaboration command::         
+* Run command::                 
+* Elaborate and run command::   
+* Bind command::                
+* Link command::                
+* List link command::           
+* Check syntax command::        
+* Analyze and elaborate command::  
+@end menu
+
+@node Analysis command, Elaboration command, Building commands, Building commands
+@comment  node-name,  next,  previous,  up
+@subsection Analysis command
+@cindex analysis
+@cindex @option{-a} command
+@smallexample
+$ ghdl -a [@var{options}] @var{files}
+@end smallexample
+
+The @dfn{analysis} command compiles one or more files, and creates an
+object file for each source file.  The analysis command is selected with
+@var{-a} switch.  Any argument starting with a dash is a option, the
+others are filenames.  No options are allowed after a filename
+argument. GHDL analyzes each filename in the given order, and stops the
+analysis in case of error (the following files are not analyzed).
+@c FIXME: check this.
+
+@xref{GHDL options}, for details on the GHDL options.  For example,
+to produce debugging information such as line numbers, use:
+
+@smallexample
+$ ghdl -a -g my_design.vhdl
+@end smallexample
+
+@node Elaboration command, Run command, Analysis command, Building commands
+@comment  node-name,  next,  previous,  up
+@subsection Elaboration command
+@cindex elaboration
+@cindex @option{-e} command
+@smallexample
+$ ghdl -e [@var{options}] @var{primary_unit} [@var{secondary_unit}]
+@end smallexample
+
+The @dfn{elaboration} command creates an executable containing the
+code of the @code{VHDL} sources, the elaboration code and simulation
+code to execute a design hiearachy.  The elaboration command is selected
+with @var{-e} switch, and must be followed by either:
+
+@itemize @bullet
+@item a name of a configuration unit
+@item a name of an entity unit
+@item a name of an entity unit followed by a name of an architecture unit
+@end itemize
+
+Name of the units must be a simple name, without any dot.  You can
+select the name of the @samp{WORK} library with the @option{--work=NAME}
+option, as described in @ref{GHDL options}.
+
+@xref{Top entity}, for the restrictions on the root design of a
+hierarchy.
+
+The file name of the executable is the name of the primary unit, or for
+the later case, the concatenation of the name of the primary unit, a
+dash, and the name of the secondary unit (or architecture).
+
+The @option{-o} followed by a file name can override the default
+executable file name.
+
+For the elaboration command, @code{GHDL} re-analyzes all the
+configurations, entities, architectures and package declarations, and
+creates the default configurations and the default binding indications
+according to the LRM rules.  It also generates the list of objects files
+required for the executable.  Then, it links all these files with the
+run time library.
+
+The actual elaboration is performed at run-time.
+
+@node Run command, Elaborate and run command, Elaboration command, Building commands
+@comment  node-name,  next,  previous,  up
+@subsection Run command
+@cindex run
+@cindex @option{-r} command
+Run (or simulate) an elaborated design hierarchy.
+
+@smallexample
+$ ghdl -r @var{primary_unit} [@var{secondary_unit}] [@var{simulation_options}]
+@end smallexample
+
+The arguments are the same as the @xref{Elaboration command}.  This command
+simply build the filename of the executable and execute it.  You may also
+directly execute the program.
+
+This command exists for three reasons:
+@itemize @bullet{}
+@item
+You don't have to create the executable program name.
+@item
+It is coherent with the @samp{-a} and @samp{-e} commands.
+@item
+It will work with future implementations, where the code is generated in
+memory.
+@end itemize
+
+@xref{Simulation and run time}, for details on options.
+
+@node Elaborate and run command, Bind command, Run command, Building commands
+@comment  node-name,  next,  previous,  up
+@subsection Elaborate and run command
+@cindex elaborate and run
+@cindex @option{--elab-run} command
+Elaborate and then simulate a design unit.
+
+@smallexample
+$ ghdl --elab-run [@var{elab_options}] @var{primary_unit} [@var{secondary_unit}] [@var{run_options}]
+@end smallexample
+
+This command acts like the elaboration command (@pxref{Elaboration command})
+followed by the run command (@pxref{Run command}).
+
+@node Bind command, Link command, Elaborate and run command, Building commands
+@subsection Bind command
+@cindex binding
+@cindex @option{--bind} command
+Bind a design unit and prepare the link step.
+
+@smallexample
+$ ghdl --bind [@var{options}] @var{primary_unit} [@var{secondary_unit}]
+@end smallexample
+
+This performs only the first stage of the elaboration command; the list
+of objects files is created but the executable is not built.  This
+command should be used only when the main entry point is not ghdl.
+
+@node Link command, List link command, Bind command, Building commands
+@subsection Link command
+@cindex linking
+@cindex @option{--link} command
+Link an already bound design unit.
+
+@smallexample
+$ ghdl --link [@var{options}] @var{primary_unit} [@var{secondary_unit}]
+@end smallexample
+
+This performs only the second stage of the elaboration command: the
+executable is created by linking the files of the object files list.
+This command is available only for completness.  The elaboration command is
+equivalent to the bind command followed by the link command.
+
+@node List link command, Check syntax command, Link command, Building commands
+@subsection List link command
+@cindex @option{--list-link} command
+Disp files which will be linked.
+
+@smallexample
+$ ghdl --list-link @var{primary_unit} [@var{secondary_unit}]
+@end smallexample
+
+This command may be used only after a bind command.  GHDL displays all
+the files which will be linked to create an executable.  This command is
+intended to add object files in a link of an foreign program.
+
+@node Check syntax command, Analyze and elaborate command, List link command, Building commands
+@subsection Check syntax command
+@cindex checking syntax
+@cindex @option{-s} command
+Analyze files but do not generate code.
+
+@smallexample
+$ ghdl -a [@var{options}] @var{files}
+@end smallexample
+
+This command may be used to check the syntax of files.  It does not update
+the library.
+
+@node Analyze and elaborate command,  , Check syntax command, Building commands
+@subsection Analyze and elaborate command
+@cindex Analyze and elaborate command
+@cindex @option{-c} command
+Analyze files and elaborate in the same time.
+
+@smallexample
+$ ghdl -c [@var{options}] @var{file}@dots{} -e @var{primary_unit} [@var{secondary_unit}]
+@end smallexample
+
+This command combines analyze and elaboration: @var{file}s are analyzed and
+the unit is then elaborated.  However, code is only generated during the
+elaboration.
+
+To be more precise, the files are first parsed, and then the elaboration
+drives the analysis.  Therefore, there is no analysis order, and you don't
+need to care about it.
+
+All the units of the files are put into the @samp{work} library.  But, the
+work library is neither read from disk nor saved.  Therefore, you must give
+all the files of the @samp{work} library your design needs.
+
+The advantages over the traditionnal approach (analyze and then elaborate) are:
+@itemize
+@item
+The compilation cycle is achieved in one command.
+@item
+Since the files are only parsed once, the compilation cycle may be faster.
+@item
+You don't need to know an analysis order
+@item
+This command produces smaller executable, since unused units and subprograms
+do not generate code.
+@end itemize
+However, you should know that currently most of the time is spent in code
+generation and the analyze and elaborate command generate code for all units
+needed, even units of @samp{std} and @samp{ieee} libraries.  Therefore,
+according to the design, the time for this command may be higher than the time
+for the analyze command followed by the elaborate command.
+
+This command is still experimental.  In case of problems, you should go back
+to the traditionnal way.
+
+@comment  node-name,  next,  previous,  up
+@node GHDL options, Passing options to other programs, Building commands, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section GHDL options
+@cindex IEEE 1164
+@cindex 1164
+@cindex IEEE 1076.3
+@cindex 1076.3
+@c document gcc options
+Besides the options described below, @code{GHDL} passes any debugging options
+(those that begin with @option{-g}) and optimizations options (those that
+begin with @option{-O} or @option{-f}) to @code{GCC}.  Refer to the @code{GCC}
+manual for details.
+
+@table @code
+@item --work=@var{NAME}
+@cindex @option{--work} switch
+@cindex WORK library
+Specify the name of the @samp{WORK} library.  Analyzed units are always
+placed in the library logically named @samp{WORK}.  With this option,
+you can set its name.  By default, the name is @var{work}.
+
+@code{GHDL} checks @samp{WORK} is a valid identifier.  Although being
+more or less supported, the @samp{WORK} identifier should not be an
+extended identifier, since the filesystem may prevent it from correctly
+working (due to case sensitivity or forbidden characters in filenames).
+
+@code{VHDL} rules forbides you to add units in the @samp{std} library.
+Furthermode, you should not put units in the @samp{ieee} library.
+
+@item --workdir=@var{PATH}
+@cindex @option{--workdir} switch
+Specify the directory where the @samp{WORK} library is.  When this
+option is not present, the @samp{WORK} library is in the current
+directory.  The object files created by the compiler are always placed
+in the same directory as the @samp{WORK} library.
+
+@item --std=@var{STD}
+@cindex @option{--std} switch
+Specify the standard to use.  By default, the standard is @samp{93c}, which
+means VHDL-93 accepting VHDL-87 syntax.  For details on @var{STD} values see
+@ref{VHDL standards}.
+
+@item --ieee=@var{VER}
+@cindex @option{--ieee} switch
+@cindex ieee library
+@cindex synopsys library
+@cindex mentor library
+Select the @code{IEEE} library to use. @var{VER} must be one of:
+
+@table @samp
+@item none
+Do not supply an @code{IEEE} library.  Any library clause with the @samp{IEEE}
+identifier will fail, unless you have created by your own a library with
+the @code{IEEE} name.
+
+@item standard
+Supply an @code{IEEE} library containing only packages defined by
+@sc{ieee} standards.  Currently, there are the multivalue logic system
+packages @samp{std_logic_1164} defined by IEEE 1164, the synthesis
+packages , @samp{numeric_bit} and @samp{numeric_std} defined by IEEE
+1076.3, and the @sc{vital} packages @samp{vital_timing} and
+@samp{vital_primitives}, defined by IEEE 1076.4.  The version of these
+packages is defined by the VHDL standard used.  @xref{VITAL packages}, 
+for more details.
+
+@item synopsys
+Supply the former packages and the following additionnal packages:
+@samp{std_logic_arith}, @samp{std_logic_signed},
+@samp{std_logic_unsigned}, @samp{std_logic_textio}.
+@c @samp{std_logic_misc}.
+These packages were created by some companies, and are popular.  However
+they are not standard packages, and have been placed in the @code{IEEE}
+library without the @sc{ieee} permission.
+
+@item mentor
+Supply the standardr packages and the following additionnal package:
+@samp{std_logic_arith}.  The package is a slight variation on a definitly
+not standard but widely mis-used package.
+@end table
+
+To avoid errors, you must use the same @code{IEEE} library for all units of
+your design, and during elaboration.
+
+@item -P@var{PATH}
+@cindex @option{-P} switch
+Add @var{PATH} to the end of the list of directories to be searched for
+library files.
+
+The @code{WORK} library is always searched in the path specified by the
+@option{--workdir=} option, or in the current directory if the later
+option is not specified.
+
+@item -fexplicit
+@cindex @option{-fexplicit} switch
+When two operators are overloaded, give preference to the explicit declaration.
+This may be used to avoid the most common pitfall of the @samp{std_logic_arith}
+package.  @xref{IEEE library pitfalls}, for an example.
+
+This option is not set by default.  I don't think this option is a
+good feature, because it breaks the encapsulation rule.  When set, an
+operator can be silently overriden in another package.  You'd better to fix
+your design and use the @samp{numeric_std} package.
+
+@item --no-vital-checks
+@item --vital-checks
+@cindex @option{--no-vital-checks} switch
+@cindex @option{--vital-checks} switch
+Disable or enable checks of restriction on VITAL units.  Checks are enabled
+by default.
+
+Checks are performed only when a design unit is decorated by a VITAL attribute.
+The VITAL attributes are @samp{VITAL_Level0} and @samp{VITAL_Level1}, both
+declared in the @samp{ieee.VITAL_Timing} package.
+
+Currently, VITAL checks are only partially implemented.  @xref{VHDL
+restrictions for VITAL}, for more details.
+
+@item --GHDL1=@var{COMMAND}
+@cindex @option{--GHLD1} switch
+Use @var{COMMAND} as the command name for the compiler.  If @var{COMMAND} is
+not a path, then it is search in the list of program directories.
+
+@item -v
+Be verbose.  For example, for analysis, elaboration and make commands, GHDL
+displays the commands executed.
+@end table
+
+@node Passing options to other programs, GHDL warnings, GHDL options, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section Passing options to other programs
+For many commands, @code{GHDL} acts as a driver: it invokes programs to perform
+the command.  You can pass arbritrary options to these programs.
+
+Both the compiler and the linker are in fact GCC programs.  @xref{Invoking GCC,
+GCC options, GCC Command Options, gcc, GCC manual}, for details on GCC
+options.  
+
+@table @code
+@item -Wc,@var{OPTION}
+@cindex @option{-W} switch
+Pass @var{OPTION} as an option to the compiler.
+
+@item -Wa,@var{OPTION}
+@cindex @option{-Wa} switch
+Pass @var{OPTION} as an option to the assembler.
+
+@item -Wl,@var{OPTION}
+@cindex @option{-Wl} switch
+Pass @var{OPTION} as an option to the linker.
+@end table
+
+@node GHDL warnings, Rebuilding commands, Passing options to other programs, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section GHDL warnings
+Some contructions are not erroneous but dubious.  Warnings are diagnostic
+messages that report such constructions.  Some warnings are reported only
+during analysis, others during elaboration.
+
+@table @code
+@item --warn-reserved
+@cindex @option{--warn-reserved} switch
+Emit a warning if an identifier is a reserved word in a latter VHDL standard.
+
+@item --warn-default-binding
+@cindex @option{--warn-default-binding} switch
+During analyze, warns if a component instantiation has neither
+configuration specification nor default binding.  This may be usefull if you
+want to detect during analyze possibly unbound component if you don't use
+configuration.  @xref{VHDL standards}, for more details about default binding
+rules.
+
+@item --warn-binding
+@cindex @option{--warn-binding} switch
+During elaboration, warns if a component instantiation is not bound
+(and not explicitly left unbound).  Also warns if a port of an entity
+is not bound in a configuration specification or in a component
+configuration.  This warning is enabled by default, since default
+binding rules are somewhat complex and an unbound component is most
+often unexpected.
+
+However, warnings are even emitted if a component instantiation is
+inside a generate statement.  As a consequence, if you use conditionnal
+generate statement to select a component according to the implementation,
+you will certainly get warnings.
+
+@item --warn-library
+@cindex @option{--warn-library} switch
+Warns if a design unit replaces another design unit with the same name.
+
+@item --warn-vital-generic
+@cindex @option{--warn-vital-generic} switch
+Warns if a generic name of a vital entity is not a vital generic name.  This
+is set by default.
+
+@item --warn-delayed-checks
+@cindex @option{--warn-delayed-checks} switch
+Warns for checks that cannot be done during analysis time and are postponed to
+elaboration time.  These checks are checks for no wait statement in a procedure
+called in a sensitized process.  If the body of the procedure is not known
+at analysis time, the check will be performed during elaboration.
+
+@item --warn-body
+@cindex @option{--warn-body} switch
+Emit a warning if a package body which is not required is analyzed.  If a
+package does not declare a subprogram or a deferred constant, the package
+does not require a body.
+
+@item --warn-specs
+@cindex @option{--warn-specs} switch
+Emit a warning if an all or others specification does not apply.
+
+@item --warn-unused
+@cindex @option{--warn-unused} switch
+Emit a warning when a subprogram is never used.
+
+@item --warn-error
+@cindex @option{--warn-error} switch
+When this option is set, warnings are considered as errors.
+
+@end table
+
+@node Rebuilding commands, Library commands, GHDL warnings, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section Rebuilding commands
+Analyzing and elaborating a design consisting in severals files can be tricky,
+due to dependences.  GHDL has a few commands to rebuild a design.
+
+@menu
+* Import command::              
+* Make command::                
+* Generate Makefile command::   
+@end menu
+
+@node Import command, Make command, Rebuilding commands, Rebuilding commands
+@comment  node-name,  next,  previous,  up
+@subsection Import command
+@cindex importing files
+@cindex @option{-i} coomand
+Add files in the work design library.
+
+@smallexample
+$ ghdl -i [@var{options}] @var{file}@dots{}
+@end smallexample
+
+All the files specified in the command line are scanned, parsed and added in
+the libraries but as not yet analyzed.  No object files are created.
+
+The purpose of this command is to localize design units in the design files.
+The make command will then be able to recursively build a hierarchy from
+an entity name or a configuration name.
+
+Since the files are parsed, there must be correct files.  However, since they
+are not analyzed, many errors are tolerated by this command.
+
+Note that all the files are added in the work library.  If you have many
+libraries, you must use the command for each library.
+
+@c Due to the LRM rules, there may be many analysis orders, producing
+@c different results.  For example, if an entity has several architectures,
+@c the last architecture analyzed is the default one in default binding
+@c indications.
+
+@xref{Make command}, to actually build the design.
+
+@node Make command, Generate Makefile command, Import command, Rebuilding commands
+@comment  node-name,  next,  previous,  up
+@subsection Make command
+@cindex make
+@cindex @option{-m} command
+@smallexample
+$ ghdl -m [@var{options}] @var{primary} [@var{secondary}]
+@end smallexample
+
+Analyze automatically outdated files and elaborate a design.
+
+The primary unit denoted by the @var{primary} argument must already be
+known by the system, either because you have already analyzed it (even
+if you have modified it) or because you have imported it.  GHDL analyzes
+all outdated files.  A file may be outdated because it has been modified
+(e.g. you just have edited it), or because a design unit contained in
+the file depends on a unit which is outdated.  This rule is of course
+recursive.
+
+With the @option{-f} (force) option, GHDL analyzes all the units of the
+work library needed to create the design hierarchy.  Not outdated units
+are recompiled.  This is useful if you want to compile a design hierarch
+with new compilation flags (for example, to add the @option{-g}
+debugging option).
+
+The make command will only re-analyze design units in the work library.
+GHDL fails if it has to analyze an outdated unit from another library.
+
+The purpose of this command is to be able to compile a design without prior
+knowledge of file order.  In the VHDL model, some units must be analyzed
+before others (e.g. an entity before its architecture).  It might be a
+nightmare to analyze a full design of several files, if you don't have
+the ordered list of file.  This command computes an analysis order.
+
+The make command fails when a unit was not previously parsed.  For
+example, if you split a file containing several design units into
+several files, you must either import these new files or analyze them so
+that GHDL knows in which file these units are.
+
+The make command imports files which have been modified.  Then, a design
+hierarchy is internally built as if no units are outdated.  Then, all outdated
+design units, using the dependences of the design hierarchy, are analyzed.
+If necessary, the design hierarchy is elaborated.
+
+This is not perfect, since defaults architecture (the most recently
+analyzed one) may change while outdated design files are analyzed. In
+such a case, re-run the make command of GHDL.
+
+@c does not exists: @section GHDL robust make command
+
+@node Generate Makefile command,  , Make command, Rebuilding commands
+@comment  node-name,  next,  previous,  up
+@subsection Generate Makefile command
+@cindex @option{--gen-makefile} command
+Generate a Makefile to build a design unit.
+
+@smallexample
+$ ghdl --gen-makefile [@var{options}] @var{primary} [@var{secondary}]
+@end smallexample
+
+This command works like the make command (@pxref{Make command}), but only a
+makefile is generated on the standard output.
+
+@node Library commands, Cross-reference command, Rebuilding commands, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section Library commands
+GHDL has a few commands which act on a library.
+
+@comment  node-name,  next,  previous,  up
+@menu
+* Directory command::           
+* Clean command::               
+* Remove command::              
+@end menu
+
+@node Directory command, Clean command, Library commands, Library commands
+@comment  node-name,  next,  previous,  up
+@subsection Directory command
+@cindex displaying library
+@cindex @option{-d} command
+Display the name of the units contained in a design library.
+@smallexample
+$ ghdl -d [@var{options}]
+@end smallexample
+
+The directory command, selected with the @var{-d} command line argument
+displays the content of the work design library.  All options are
+allowed, but only a few are meaningful: @option{--work=NAME},
+@option{--workdir=PATH} and @option{--std=VER}.
+
+@node Clean command, Remove command, Directory command, Library commands
+@comment  node-name,  next,  previous,  up
+@subsection Clean command
+@cindex cleaning
+@cindex @option{--clean} command
+Remove object and executable files but keep the library.
+
+@smallexample
+$ ghdl --clean [@var{options}]
+@end smallexample
+
+GHDL tries to remove any object, executable or temporary file it could
+have created.  Source files are not removed.
+
+There is no short command line form for this option to prevent accidental
+clean up.
+
+@node Remove command,  , Clean command, Library commands
+@subsection Remove command
+@cindex cleaning all
+@cindex @option{--remove} command
+Do like the clean command but remove the library too.
+
+@smallexample
+$ ghdl --remove [@var{options}]
+@end smallexample
+
+There is no short command line form for this option to prevent accidental
+clean up.  Note that after removing a design library, the files are not
+known anymore by GHDL.
+
+@node Cross-reference command, File commands, Library commands, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section Cross-reference command
+To easily navigate through your sources, you may generate cross-references.
+
+@smallexample
+$ ghdl --xref-html [@var{options}] @var{file}@dots{}
+@end smallexample
+
+This command generates an html file for each @var{file} given in the command
+line, with syntax highlighting and full cross-reference: every identifier is
+a link to its declaration.  Besides, an index of the files is created too.
+
+The set of @var{file} are analyzed, and then, if the analyze is
+successful, html files are generated in the directory specified by the
+@option{-o @var{dir}} option, or @file{html/} directory by default.
+
+If the @option{--format=html2} is specified, then the generated html
+files follow the HTML 2.0 standard, and colours are specified with
+@samp{<FONT>} tags.  However, colours are hard-coded.
+
+If the @option{--format=css} is specified, then the generated html files
+follow the HTML 4.0 standard, and use the CSS-1 file @file{ghdl.css} to
+specify colours.  This file is generated only if it does not already exist (it
+is never overwritten) and can be customized by the user to change colours or
+appearance.  Refer to a generated file and its comments for more informations.
+
+@node File commands, Misc commands, Cross-reference command, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section File commands
+The following commands act on one or severals files.  They do not analysis
+files, therefore, they work even if a file has semantic errors.
+
+@menu
+* Pretty print command::        
+* Find command::                
+* Chop command::                
+* Lines command::               
+@end menu
+
+@node Pretty print command, Find command, File commands, File commands
+@comment  node-name,  next,  previous,  up
+@subsection Pretty print command
+@cindex @option{--pp-html} command
+@cindex pretty printing
+@cindex vhdl to html
+
+Generate HTML on standard output from VHDL.
+
+@smallexample
+$ ghdl --pp-html [@var{options}] @var{file}@dots{}
+@end smallexample
+
+The files are just scanned and an html file, with syntax highlighting is
+generated on standard output.
+
+Since the files are not even parsed, erroneous files or uncomplete designs
+can be pretty printed.
+
+The style of the html file can be modified with the @option{--format=} option.
+By default or when the @option{--format=html2} option is specified, the output
+is an HTML 2.0 file, with colours set throught @samp{<FONT>} tags.  When the
+@option{--format=css} option is specified, the output is an HTML 4.0 file,
+with colours set through a CSS file, whose name is @samp{ghdl.css}.
+@xref{Cross-reference command}, for more details about this CSS file.
+
+@node Find command, Chop command, Pretty print command, File commands
+@comment  node-name,  next,  previous,  up
+@subsection Find command
+@cindex @option{-f} command
+Display the name of the design units in files.
+
+@smallexample
+$ ghdl -f @var{file}@dots{}
+@end smallexample
+
+The files are scanned, parsed and the names of design units are displayed.
+Design units marked with two stars are candidate to be at the apex of a
+design hierarchy.
+
+
+@node Chop command, Lines command, Find command, File commands
+@comment  node-name,  next,  previous,  up
+@subsection Chop command
+@cindex @option{--chop} command
+Chop (or split) files at design unit.
+
+@smallexample
+$ ghdl --chop @var{files}
+@end smallexample
+
+@code{GHDL} reads files, and writes a file in the current directory for
+every design unit.
+
+The file name of a design unit is build according to the unit.  For an
+entity declaration, a package declaration or a configuration the file
+name is @file{NAME.vhdl}, where @var{NAME} is the name of the design
+unit.  For a package body, the file name is @file{NAME-body.vhdl}.
+Finally, for an architecture @var{ARCH} of an entity @var{ENTITY}, the
+file name is @file{ENTITY-ARCH.vhdl}.
+
+Since the input files are parsed, this command aborts in case of syntax
+error.  The command aborts too if a file to be written already exists.
+
+Comments between design units are stored into the most adequate files.
+
+This command may be useful to split big files, if your computer has not
+enough memory to compile such files.  The size of the executable is
+reduced too.
+
+@node Lines command,  , Chop command, File commands
+@comment  node-name,  next,  previous,  up
+@subsection Lines command
+@cindex @option{--lines} command
+Display on the standard output lines of files preceded by line number.
+
+@smallexample
+$ ghdl --lines @var{files}
+@end smallexample
+
+@node Misc commands, IEEE library pitfalls, File commands, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section Misc commands
+There are a few GHDL commands which are seldom useful.
+
+@menu
+* Help command::                
+* Dispconfig command::          
+* Disp standard command::       
+* Version command::             
+@end menu
+
+@node Help command, Dispconfig command, Misc commands, Misc commands
+@subsection Help command
+@cindex @option{-h} command
+@cindex @option{--help} command
+Display (on the standard output) a short description of the all the commands
+available.  If the help switch is followed by an command switch, then options
+for this later command are displayed.
+
+@smallexample
+$ ghdl --help
+$ ghdl -h
+$ ghdl -h @var{command}
+@end smallexample
+
+@node Dispconfig command, Disp standard command, Help command, Misc commands
+@comment  node-name,  next,  previous,  up
+@subsection Dispconfig command
+@cindex @option{--dispconfig} command
+@cindex display configuration
+Display the program pathes and options used by GHDL.
+
+@smallexample
+$ ghdl --dispconfig [@var{options}]
+@end smallexample
+
+This may be useful to track installation errors.
+
+@node Disp standard command, Version command, Dispconfig command, Misc commands
+@comment  node-name,  next,  previous,  up
+@subsection Disp standard command
+@cindex @option{--disp-standard} command
+@cindex display @samp{std.standard}
+Display the @samp{std.standard} package:
+
+@smallexample
+$ ghdl --disp-standard [@var{options}]
+@end smallexample
+
+@node Version command,  , Disp standard command, Misc commands
+@comment  node-name,  next,  previous,  up
+@subsection Version command
+@cindex @option{--version} command
+@cindex version
+Display the @code{GHDL} version and exit.
+
+@smallexample
+$ ghdl --version
+@end smallexample
+
+@node IEEE library pitfalls,  , Misc commands, Invoking GHDL
+@comment  node-name,  next,  previous,  up
+@section IEEE library pitfalls
+When you use options @option{--ieee=synopsys} or @option{--ieee=mentor},
+the @code{IEEE} library contains non standard packages such as
+@samp{std_logic_arith}. @c FIXME: ref
+
+These packages are not standard because there are not described by an IEEE
+standard, even if they have been put in the @code{IEEE} library.  Furthermore,
+they are not really de-facto standard, because there a slight differences
+between the packages of Mentor and those of Synopsys.
+
+Furthermore, since they are not well-thought, their use have pitfalls.  For
+example, this description has error during compilation:
+@example
+library ieee;
+use ieee.std_logic_1164.all;
+
+--  @r{A counter from 0 to 10}.
+entity counter is
+   port (val : out std_logic_vector (3 downto 0);
+         ck : std_logic;
+         rst : std_logic);
+end counter;
+
+library ieee;
+use ieee.std_logic_unsigned.all;
+
+architecture bad of counter
+is
+   signal v : std_logic_vector (3 downto 0);
+begin
+   process (ck, rst)
+   begin
+     if rst = '1' then
+        v <= x"0";
+     elsif rising_edge (ck) then
+        if v = "1010" then -- @r{Error}
+           v <= x"0";
+        else
+           v <= v + 1;
+        end if;
+     end if;
+   end process;
+
+   val <= v;
+end bad;
+@end example
+
+When you analyze this design, GHDL does not accept it (too long lines
+have been split for readability):
+@smallexample
+$ ghdl -a --ieee=synopsys bad_counter.vhdl
+bad_counter.vhdl:13:14: operator "=" is overloaded
+bad_counter.vhdl:13:14: possible interpretations are:
+../../libraries/ieee/std_logic_1164.v93:69:5: implicit function "="
+    [std_logic_vector, std_logic_vector return boolean]
+../../libraries/synopsys/std_logic_unsigned.vhdl:64:5: function "="
+    [std_logic_vector, std_logic_vector return boolean]
+../translate/ghdldrv/ghdl: compilation error
+@end smallexample
+Indeed, the @code{"="} operator is defined in both packages, and both
+are visible at the place it is used.  The first declaration is an
+implicit one, which occurs when the @code{std_logic_vector} type is
+declared and is a element to element comparaison, the second one is an
+explicit declared function, with the semantic of an unsigned comparaison.
+
+With some analyser, the explicit declaration has priority on the implicit
+declaration, and this design can be analyzed without error.  However, this
+is not the rule given by the VHDL LRM, and since GHDL follows these rules,
+it emits an error.
+
+You can force GHDL to use this rule with the @option{-fexplicit} option.
+@xref{GHDL options}, for more details.
+
+However it is easy to fix this error, by using a selected name:
+@example
+library ieee;
+use ieee.std_logic_unsigned.all;
+
+architecture fixed_bad of counter
+is
+   signal v : std_logic_vector (3 downto 0);
+begin
+   process (ck, rst)
+   begin
+     if rst = '1' then
+        v <= x"0";
+     elsif rising_edge (ck) then
+        if ieee.std_logic_unsigned."=" (v, "1010") then
+           v <= x"0";
+        else
+           v <= v + 1;
+        end if;
+     end if;
+   end process;
+
+   val <= v;
+end fixed_bad;
+@end example
+
+It is better to only use the standard packages defined by IEEE, which
+provides the same functionnalities:
+@example
+library ieee;
+use ieee.numeric_std.all;
+
+architecture good of counter
+is
+   signal v : unsigned (3 downto 0);
+begin
+   process (ck, rst)
+   begin
+     if rst = '1' then
+        v <= x"0";
+     elsif rising_edge (ck) then
+        if v = "1010" then
+           v <= x"0";
+        else
+           v <= v + 1;
+        end if;
+     end if;
+   end process;
+
+   val <= std_logic_vector (v);
+end good;
+@end example
+
+@node Simulation and run time, GHDL implementation of VHDL, Invoking GHDL, Top
+@comment  node-name,  next,  previous,  up
+@chapter Simulation and run time
+
+@menu
+* Simulation options::          
+* Debugging VHDL programs::     
+@end menu
+
+@node Simulation options, Debugging VHDL programs, Simulation and run time, Simulation and run time
+@comment  node-name,  next,  previous,  up
+@section Simulation options
+In most system environments, it is possible to pass options while
+invoking a program.  Contrary to most programming language, there is no
+standard method in VHDL to obtain the arguments or to set the exit
+status.
+
+In GHDL, it is impossible to pass parameters to your design.  A later version
+could do it through the generics interfaces of the top entity.
+
+However, the GHDL run time behaviour can be modified with some options; for
+example, it is possible to stop simulation after a certain time.
+
+The exit status of the simulation is @samp{EXIT_SUCCESS} (0) if the
+simulation completes, or @samp{EXIT_FAILURE} (1) in case of error
+(assertion failure, overflow or any constraint error).
+
+Here is the list of the most useful options.  Some debugging options are
+also available, but not described here.  The @samp{--help} options lists
+all options available, including the debugging one.
+
+@table @code
+@item --assert-level=@var{LEVEL}
+@cindex @option{--assert-level} option
+Select the assertion level at which an assertion violation stops the
+simulation.  @var{LEVEL} is the name from the @code{severity_level}
+enumerated type defined in the @code{standard} package or the
+@samp{none} name.
+
+By default, only assertion violation of severity level @samp{failure}
+stops the simulation.
+
+For example, if @var{LEVEL} was @samp{warning}, any assertion violation
+with severity level @samp{warning}, @samp{error} or @samp{failure} would
+stop simulation, but the assertion violation at the @samp{note} severity
+level would only display a message.
+
+@samp{--assert-level=none} prevents any assertion violation to stop
+simulation.
+
+@item --stop-time=@var{TIME}
+@cindex @option{--stop-time} option
+Stop the simulation after @var{TIME}.  @var{TIME} is expressed as a time
+value, @emph{without} any space.  The time is the simulation time, not
+the real clock time.
+
+For examples:
+
+@smallexample
+$ ./my_design --stop-time=10ns
+$ ./my_design --stop-time=ps
+@end smallexample
+
+@item --stop-delta=@var{N}
+@cindex @option{--stop-delta} option
+Stop the simulation after @var{N} delta cycles in the same current time.
+@c Delta cycles is a simulation technic used by VHDL to
+
+@item --disp-time
+@cindex @option{--disp-time} option
+@cindex display time
+Display the time and delta cycle number as simulation advances.
+
+@item --disp-tree[@var{=KIND}]
+@cindex @option{--disp-tree} option
+@cindex display design hierarchy
+Display the design hierarchy as a tree of instantiated design entities.
+This may be useful to understand the structure of a complex
+design. @var{KIND} is optional, but if set must be one of:
+@table @samp
+@item none
+Do not display hierarchy.  Same as if the option was not present.
+@item inst
+Display entities, architectures, instances, blocks and generates statements.
+@item proc
+Like @samp{inst} but also display processes.
+@item port
+Like @samp{proc} but display ports and signals too.
+@end table
+If @var{KIND} is not specified, the hierarchy is displayed with the
+@samp{port} mode.
+
+@item --no-run
+@cindex @option{--no-run} option
+Do not simulate, only elaborate.  This may be used with
+@option{--disp-tree} to display the tree without simulating the whole
+design.
+
+@item --vcd=@var{FILENAME}
+@cindex @option{--vcd} option
+@cindex vcd
+@cindex value change dump
+@cindex dump of signals
+Dump into the VCD file @var{FILENAME} the signal values before each
+non-delta cycle.  If @var{FILENAME} is @samp{-}, then the standard output is
+used, otherwise a file is created or overwritten.
+
+@dfn{VCD} (value change dump) is a file format defined
+by the @code{verilog} standard and used by virtually any wave viewer.
+
+Since it comes from @code{verilog}, only a few VHDL types can be dumped.  GHDL
+dumps only signals whose base type is of the following:
+@itemize @bullet
+@item
+types defined in the @samp{std.standard} package:
+@itemize @bullet
+@item
+@samp{bit}
+@item
+@samp{bit_vector}
+@end itemize
+@item
+types defined in the @samp{ieee.std_logic_1164} package:
+@itemize @bullet
+@item
+@samp{std_ulogic}
+@item
+@samp{std_logic} (because it is a subtype of @samp{std_ulogic})
+@item
+@samp{std_ulogic_vector}
+@item
+@samp{std_logic_vector}
+@end itemize
+@item
+any integer type
+@end itemize
+
+I have successfully used @code{gtkwave} to view VCD files.
+
+Currently, there is no way to select signals to be dumped: all signals are
+dumped, which can generate big files.
+
+It is very unfortunate there is no standard or well-known wave file
+format supporting VHDL types.  If you are aware of such a free format,
+please mail me (@pxref{Reporting bugs}).
+
+@item --wave=@var{FILENAME}
+@cindex @option{--wave} option
+Write the waveforms into a @code{ghw} (GHdl Waveform) file.  Currently, all
+the signals are dumped into the waveform file, you cannot select a hierarchy
+of signals to be dumped.
+
+The format of this file was defined by myself and is not yet completly fixed.
+It may change slightly.
+
+There is a patch against @code{gtkwave 1.3.56} on the ghdl website at
+@uref{ghdl.free.fr}, so that it can read such files.
+
+Contrary to VCD files, any VHDL type can be dumped into a GHW file.
+
+@item --sdf=@var{PATH}=@var{FILENAME}
+@item --sdf=min=@var{PATH}=@var{FILENAME}
+@item --sdf=typ=@var{PATH}=@var{FILENAME}
+@item --sdf=max=@var{PATH}=@var{FILENAME}
+@cindex @option{--sdf} option
+Do VITAL annotation on @var{PATH} with SDF file @var{FILENAME}.
+
+@var{PATH} is a path of instances, separated with @samp{.} or @samp{/}.
+Any separator can be used.  Instances are component instantiation labels,
+generate labels or block labels.  Currently, you cannot use an indexed name.
+
+If the option contains a type of delay, that is @option{min=},
+@option{typ=} or @option{max=}, the annotator use respectively minimum,
+typical or maximum values.  If the option does not contain a type of delay,
+the annotator use the typical delay.
+
+@xref{Backannotation}, for more details.
+
+@item --stack-max-size=@var{SIZE}
+@cindex @option{--stack-max-size} option
+Set the maximum size in bytes of the non-sensitized processes stacks.
+
+If the value @var{SIZE} is followed (without any space) by the @samp{k},
+@samp{K}, @samp{kb}, @samp{Kb}, @samp{ko} or @samp{Ko} multiplier, then
+the size is the numeric value multiplied by 1024.
+
+If the value @var{SIZE} is followed (without any space) by the @samp{m},
+@samp{M}, @samp{mb}, @samp{Mb}, @samp{mo} or @samp{Mo} multiplier, then
+the size is the numeric value multiplied by 1024 * 1024 = 1048576.
+
+Each non-sensitized process has its own stack, while the sensitized processes
+share the same and main stack.  This stack is the stack created by the
+operating system.
+
+Using too small stacks may result in simulation failure due to lack of memory.
+Using too big stacks may reduce the maximum number of processes.
+
+@item --stack-size=@var{SIZE}
+@cindex @option{--stack-size} option
+Set the initial size in bytes of the non-sensitized processes stack.
+The @var{SIZE} value has the same format as the previous option.
+
+The stack of the non-sensitized processes grows until reaching the
+maximum size limit.
+
+@item --help
+Display a short description of the options accepted by the run time library.
+@end table
+
+@node Debugging VHDL programs,  , Simulation options, Simulation and run time
+@comment  node-name,  next,  previous,  up
+@section Debugging VHDL programs
+@cindex debugging
+@cindex @code{__ghdl_fatal}
+@code{GDB} is a general purpose debugger for programs compiled by @code{GCC}.
+Currently, there is no VHDL support for @code{GDB}.  It may be difficult
+to inspect variables or signals in @code{GDB}, however, @code{GDB} is
+still able to display the stack frame in case of error or to set a breakpoint
+at a specified line.
+
+@code{GDB} can be useful to precisely catch a run-time error, such as indexing
+an array beyond its bounds.  All error check subprograms call the
+@code{__ghdl_fatal} procedure.  Therefore, to catch run-time error, set
+a breakpoint like this:
+@smallexample
+(gdb) break __ghdl_fatal
+@end smallexample
+When the breakpoint is hit, use the @code{where} or @code{bt} command to
+display the stack frames.
+
+@node GHDL implementation of VHDL, GHDL implementation of VITAL, Simulation and run time, Top
+@comment  node-name,  next,  previous,  up
+@chapter GHDL implementation of VHDL
+
+This chapter describes several implementation defined aspect of VHDL in GHDL.
+
+@menu
+* VHDL standards::              
+* Source representation::       
+* Library database::            
+* VHDL files format::           
+* Top entity::                  
+* Interfacing to other languages::  
+@end menu
+
+@node VHDL standards, Source representation, GHDL implementation of VHDL, GHDL implementation of VHDL
+@comment  node-name,  next,  previous,  up
+@section VHDL standards
+@cindex VHDL standards
+@cindex IEEE 1076
+@cindex IEEE 1076a
+@cindex 1076
+@cindex 1076a
+@cindex v87
+@cindex v93
+@cindex v93c
+@cindex v00
+@cindex v02
+This is very unfortunate, but there are many versions of the VHDL language.
+
+The VHDL language was first standardized in 1987 by IEEE as IEEE 1076-1987, and
+is commonly referred as VHDL-87. This is certainly the most important version,
+since most of the VHDL tools are still based on this standard.
+
+Various problems of this first standard have been analyzed by experts groups
+to give reasonable ways of interpreting the unclear portions of the standard.
+
+VHDL was revised in 1993 by IEEE as IEEE 1076-1993.  This revision is still
+well-known.
+
+Unfortunatly, VHDL-93 is not fully compatible with VHDL-87, ie some perfectly
+valid VHDL-87 programs are invalid VHDL-93 programs.  Here are some of the
+reasons:
+
+@itemize @bullet
+@item
+the syntax of file declaration has changed (this is the most visible source
+of incompatibility),
+@item
+new keywords were introduced (group, impure, inertial, literal,
+postponed, pure, reject, rol, ror, shared, sla, sll, sra, srl,
+unaffected, xnor),
+@item
+some dynamic behaviours have changed (the concatenation is one of them),
+@item
+rules have been added.
+@end itemize
+
+Shared variables were replaced by protected types in the 2000 revision of
+the VHDL standard.  This modification is also known as 1076a.  Note that this
+standard is not fully backward compatible with VHDL-93, since the type of a
+shared variable must now be a protected type (there was no such restriction
+before).
+
+Minors corrections were added by the 2002 revision of the VHDL standard.  This
+revision is not fully backward compatible with VHDL-00 since, for example,
+the value of the @code{'instance_name} attribute has slighly changed.
+
+You can select the VHDL standard expected by GHDL with the
+@samp{--std=VER} option, where @var{VER} is one of the left column of the
+table below:
+
+@table @samp
+@item 87
+Select VHDL-87 standard as defined by IEEE 1076-1987.  LRM bugs corrected by
+later revisions are taken into account.
+@item 93
+Select VHDL-93; VHDL-87 file declarations are not accepted.
+@item 93c
+Select VHDL-93 standard with relaxed rules:
+@itemize @bullet
+@item
+VHDL-87 file declarations are accepted;
+@item
+default binding indication rules of VHDL-02 are used.  Default binding rules
+are often used, but they are particulary obscure before VHDL-02.
+@end itemize
+@item 00
+Select VHDL-2000 standard, which adds protected types.
+@item 02
+Select VHDL-2002 standard (partially implemented).
+@end table
+
+You cannot mix VHDL-87 and VHDL-93 units.  A design hierarchy must have been
+completly analyzed using either the 87 or the 93 version of the VHDL standard.
+
+@node Source representation, Library database, VHDL standards, GHDL implementation of VHDL
+@comment  node-name,  next,  previous,  up
+@section Source representation
+According to the VHDL standard, design units (i.e. entities,
+architectures, packages, package bodies and configurations) may be
+independently analyzed.
+
+Several design units may be grouped into a design file.
+
+In GHDL, a system file represents a design file.  That is, a file compiled by
+GHDL may contain one or more design units.
+
+It is common to have several design units in a design file.
+
+GHDL does not impose any restriction on the name of a design file
+(except that the file name may not contain any control character or
+spaces).
+
+GHDL do not keep a binary representation of the design units analyzed like
+other VHDL analyzers.  The sources of the design units are re-read when
+needed (for example, an entity is re-read when one of its architecture is
+analyzed).  Therefore, if you delete or modify a source file of a unit
+analyzed, GHDL will refuse to use it.
+
+@node Library database, VHDL files format, Source representation, GHDL implementation of VHDL
+@section Library database
+Each design unit analyzed is placed into a design library.  By default,
+the name of this design library is @samp{work}; however, this can be
+changed with the @option{--work=NAME} option of GHDL.
+
+To keep the list of design units in a design library, GHDL creates
+library files.  The name of these files is @samp{NAME-objVER.cf}, where
+@var{NAME} is the name of the library, and @var{VER} the VHDL version (87
+or 93) used to analyze the design units.
+
+You don't have to know how to read a library file.  You can display it
+using the @option{-d} of @code{ghdl}.  The file contains the name of the
+design units, as well as the location and the dependences.
+
+The format may change with the next version of GHDL.
+
+@node VHDL files format, Top entity, Library database, GHDL implementation of VHDL
+@comment  node-name,  next,  previous,  up
+@section VHDL files format
+@cindex file format
+@cindex logical name
+VHDL has features to handle files.
+
+GHDL associates a file logical name (the VHDL file name) to an operating
+system file name.  The logical name @samp{STD_INPUT} is associated to
+the standard input as defined by @samp{stdin} stream of the C library,
+while the logical name @samp{STD_OUTPUT} is associated to the standard
+output, as defined by the @samp{stdout} stream of the C library.  Other
+logical name are directly mapped to a file name as defined by the first
+(@samp{path}) argument of the @samp{fopen} function of the C library.
+For a binary file, the @samp{b} character is appended to the mode argument
+(binary mode).
+
+If multiple file objects are associated with the same external file, a stream
+is created for each object, except for the standard input or output.
+
+GHDL has no internal restrictions on the number of file objects that are
+associated at one time with a given external file, but the operating system
+may restrict the maximum number of file open at the same time.
+
+For more details about these point, please refer to your operation system
+documentation.
+
+@c tell more about possible errors.
+
+There are two kinds of files: binary or text files.
+
+Text files are files of type @samp{std.textio.text}.  The format is the
+same as the format of any ascii file.  In VHDL-87, only the first 128
+characters (7 bits) are allowed, since the character type has only 128
+literals.  The end of line is system dependent.  Note that the stdio
+functions with the text mode are used to handle text files: the fgets
+function is used to read lines.  Please, refer to the manual of your C
+library for more information.
+
+There are two kind of binary files, according to the type mark of the
+file.  According to the VHDL standard, binary files must be read using
+the same type they are written.
+
+If the type mark is a non-composite type (integer, floating type
+enumeration, physical), the file is a raw stream:
+elements are read or written using the same format as is used to represent
+the data in memory.  This is highly non-portable, but you should be able
+to read file written by a non-@code{GHDL} program.
+
+If the type mark is a composite type (record or array), the file is composed
+of a 2 lines signature, followed by a raw stream.
+
+@node Top entity, Interfacing to other languages, VHDL files format, GHDL implementation of VHDL
+@comment  node-name,  next,  previous,  up
+@section Top entity
+There are some restrictions on the entity being at the apex of a design
+hierarchy:
+
+@itemize @bullet
+@item
+The generic must have a default value, and the value of a generic is its
+default value;
+@item
+The ports type must be constrained.
+@end itemize
+
+@node Interfacing to other languages,  , Top entity, GHDL implementation of VHDL
+@comment  node-name,  next,  previous,  up@section Interfacing with other languages
+@section Interfacing to other languages
+@cindex interfacing
+@cindex other languages
+@cindex foreign
+@cindex VHPI
+@cindex VHPIDIRECT
+You can define a subprogram in a foreign language (such as @code{C} or
+@code{Ada}) and import it in a VHDL design.
+
+@subsection Foreign declarations
+Only subprograms (functions or procedures) can be imported, using the foreign
+attribute.  In this example, the @code{sin} function is imported:
+
+@example
+package math is
+  function sin (v : real) return real;
+  attribute foreign of sin : function is "VHPIDIRECT sin";
+end math;
+
+package body math is
+  function sin (v : real) return real is
+  begin
+    assert false severity failure;
+  end sin;
+end math;
+@end example
+
+A subprogram is made foreign if the @var{foreign} attribute decorates
+it.  This attribute is declared in the 1993 revision of the
+@samp{std.standard} package.  Therefore, you cannot use this feature in
+VHDL 1987.
+
+The decoration is achived through an attribute specification.  The
+attribute specification must be in the same declarative part as the
+subprogram and must be after it.  This is a general rule for specifications.
+The value of the specification must be a locally static string.
+
+Even when a subprogram is foreign, its body must be present.  However, since
+it won't be called, you can made it empty or simply but an assertion.
+
+The value of the attribute must start with @samp{VHPIDIRECT } (an
+upper-case keyword followed by one or more blanks).  The linkage name of the
+subprogram follows.
+
+
+@menu
+* Restrictions on foreign declarations::  
+* Linking with foreign object files::  
+* Starting a simulation from a foreign program::  
+* Linking with Ada::            
+* Using GRT from Ada::
+@end menu
+
+@node Restrictions on foreign declarations, Linking with foreign object files, Interfacing to other languages, Interfacing to other languages
+@subsection Restrictions on foreign declarations
+
+Any subprogram can be imported.  GHDL puts no restrictions on foreign
+subprograms.  However, the representation of a type or of an interface in a
+foreign language may be obscur.  Most of non-composite types are easily imported:
+@table @samp
+@item integer types
+They are represented on a 32 bits word.  This generally corresponds to
+@code{int} for @code{C} or @code{Integer} for @code{Ada}.
+@item physical types
+They are represented on a 64 bits word.  This generally corresponds to the
+@code{long long} for @code{C} or @code{Long_Long_Integer} for @code{Ada}.
+@item floating point types
+They are represented on a 64 bits floating point word.  This generally
+corresponds to @code{double} for @code{C} or @code{Long_Float} for @code{Ada}.
+@item enumeration types
+They are represented on 8 bits or 32 bits word, if the number of literals is
+greater than 256.  There is no corresponding C types, since arguments are
+not promoted.
+@end table
+
+Non-composite types are passed by value.  For the @code{in} mode, this
+corresponds to the @code{C} or @code{Ada} mechanism.  The @code{out} and
+@code{inout} interfaces of non-composite types are gathered in a record
+and this record is passed by reference as the first argument to the
+subprogram.  As a consequence, you shouldn't use @code{in} and
+@code{inout} modes in foreign subprograms, since they are not portable.
+
+Records are represented like a @code{C} structure and are passed by reference
+to subprograms.
+
+Arrays with static bounds are represented like a @code{C} array, whose
+length is the number of elements, and are passed by reference to subprograms.
+
+Unconstrained array are represented by a fat pointer.  Do not use unconstrained
+arrays in foreign subprograms.
+
+Accesses to an unconstrained array is a fat pointer.  Other accesses corresponds a an address and are passed to a subprogram like other non-composite types.
+
+Files are represented by a 32 bits word, which corresponds to an index
+in a table.
+
+@node Linking with foreign object files, Starting a simulation from a foreign program, Restrictions on foreign declarations, Interfacing to other languages
+@subsection Linking with foreign object files
+You may add additionnal files or options during the link using the
+@option{-Wl,} of @code{GHDL}, as described in @ref{Elaboration command}.
+For example:
+
+@example
+$ ghdl -e -Wl,-lm math_tb
+@end example
+will create the @file{math_tb} executable with the @file{lm} (mathematical)
+library.
+
+Note the @file{c} library is always linked with an executable.
+
+@node Starting a simulation from a foreign program, Linking with Ada, Linking with foreign object files, Interfacing to other languages
+@subsection Starting a simulation from a foreign program
+You main run your design from an external program.  You just have to call
+the @samp{ghdl_main} function which can be defined:
+
+in C:
+@smallexample
+extern int ghdl_main (int argc, char **argv);
+@end smallexample
+
+in Ada:
+@smallexample
+with System;
+@dots{}
+function Ghdl_Main (Argc : Integer; Argv : System.Address)
+   return Integer;
+pragma import (C, Ghdl_Main, "ghdl_main");
+@end smallexample
+
+This function must be called once, and returns 0 at the end of the simulation.
+In case of failure, this function does not return.  This has to be fixed.
+
+@node Linking with Ada, Using GRT from Ada, Starting a simulation from a foreign program, Interfacing to other languages
+@subsection Linking with Ada
+As explained previously in @ref{Starting a simulation from a foreign program},
+you can start a simulation from an @code{Ada} program.  However the build
+process is not trivial: you have to elaborate your @code{Ada} program and your
+@code{VHDL} design.
+
+First, you have to analyze all your design files.  In this example, we
+suppose there is only one design file, @file{design.vhdl}.
+@smallexample
+$ ghdl -a design.vhdl
+@end smallexample
+Then, bind your design.  In this example, we suppose the entity at the
+design apex is @samp{design}.
+@smallexample
+$ ghdl --bind design
+@end smallexample
+Finally, compile, bind your @code{Ada} program at link it with your @code{VHDL}
+design:
+@smallexample
+$ gnatmake my_prog -largs `ghdl --list-link design`
+@end smallexample
+
+@node Using GRT from Ada, , Linking with Ada, Interfacing to other languages
+@comment  node-name,  next,  previous,  up
+@subsection Using GRT from Ada
+@quotation Warning
+This topic is only for advanced users knowing how to use @code{Ada}
+and @code{GNAT}.  This is provided only for reference, I have tested
+this once before releasing @code{GHDL} 0.19 but this is not checked at
+each release.
+@end quotation
+
+The simulator kernel of @code{GHDL} named @dfn{GRT} is written in
+@code{Ada95} and contains a very light and slighly adapted version
+of @code{VHPI}.  Since it is an @code{Ada} implementation it is
+called @dfn{AVHPI}. Although being tough, you may interface to @code{AVHPI}.
+
+For using @code{AVHPI}, you need the sources of @code{GHDL} and to recompile
+them (at least the @code{GRT} library).  This library is usually compiled with
+a @code{No_Run_Time} pragma, so that the user does not need to install the
+@code{GNAT} run time library.  However, you certainly want to use the usual
+run time library and want to avoid this pragma.  For this, reset the
+@var{GRT_PRAGMA_FLAG} variable.
+@smallexample
+$ make GRT_PRAGMA_FLAG= grt-all
+@end smallexample
+
+Since @code{GRT} is a self-contained library, you don't want
+@code{gnatlink} to fetch individual object files (furthermore this
+doesn't always work due to tricks used in @code{GRT}).  For this,
+remove all the object files and make the @file{.ali} files read-only.
+@smallexample
+$ rm *.o
+$ chmod -w *.ali
+@end smallexample
+
+You may then install the sources files and the @file{.ali} files.  I have never
+tested this step.
+
+You are now ready to use it.
+
+For example, here is an example, @file{test_grt.adb} which displays the top
+level design name.
+@example
+with System; use System;
+with Grt.Avhpi; use Grt.Avhpi;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ghdl_Main;
+
+procedure Test_Grt is
+   --  VHPI handle.
+   H : VhpiHandleT;
+   Status : Integer;
+   
+   --  Name.
+   Name : String (1 .. 64);
+   Name_Len : Integer;
+begin
+   --  Elaborate and run the design.
+   Status := Ghdl_Main (0, Null_Address);
+   
+   --  Display the status of the simulation.
+   Put_Line ("Status is " & Integer'Image (Status));
+   
+   --  Get the root instance.
+   Get_Root_Inst(H);
+   
+   --  Disp its name using vhpi API.
+   Vhpi_Get_Str (VhpiNameP, H, Name, Name_Len);
+   Put_Line ("Root instance name: " & Name (1 .. Name_Len));
+end Test_Grt;
+@end example
+
+First, analyze and bind your design:
+@smallexample
+$ ghdl -a counter.vhdl
+$ ghdl --bind counter
+@end smallexample
+
+Then build the whole:
+@smallexample
+$ gnatmake test_grt -aL@var{grt_ali_path} -aI@var{grt_src_path} -largs
+ `ghdl --list-link counter`
+@end smallexample
+
+Finally, run your design:
+@smallexample
+$ ./test_grt
+Status is  0
+Root instance name: counter
+@end smallexample
+
+@node  GHDL implementation of VITAL, Flaws and bugs report, GHDL implementation of VHDL, Top
+@comment  node-name,  next,  previous,  up
+@chapter GHDL implementation of VITAL
+@cindex VITAL
+@cindex IEEE 1076.4
+@cindex 1076.4
+This chapter describes how VITAL is implemented in GHDL.  Support of VITAL is
+really in a preliminary stage.  Do not expect too much of it as now.
+
+@menu
+* VITAL packages::              
+* VHDL restrictions for VITAL::  
+* Backannotation::              
+* Negative constraint calculation::  
+@end menu
+
+@node VITAL packages, VHDL restrictions for VITAL, GHDL implementation of VITAL, GHDL implementation of VITAL
+@comment  node-name,  next,  previous,  up
+@section VITAL packages
+The VITAL standard or IEEE 1076.4 was first published in 1995, and revised in
+2000.
+
+The version of the VITAL packages depends on the VHDL standard.  VITAL
+1995 packages are used with the VHDL 1987 standard, while VITAL 2000
+packages are used with other standards.  This choice is based on the
+requirements of VITAL: VITAL 1995 requires the models follow the VHDL
+1987 standard, while VITAL 2000 requires the models follow VHDL 1993.
+
+The VITAL 2000 packages were slighly modified so that they conform to
+the VHDL 1993 standard (a few functions are made pure and a few one
+impure).
+
+@node  VHDL restrictions for VITAL, Backannotation, VITAL packages, GHDL implementation of VITAL
+@comment  node-name,  next,  previous,  up
+@section VHDL restrictions for VITAL
+The VITAL standard (partially) implemented is the IEEE 1076.4 standard
+published in 1995.
+
+This standard defines restriction of the VHDL language usage on VITAL
+model.  A @dfn{VITAL model} is a design unit (entity or architecture)
+decorated by the @code{VITAL_Level0} or @code{VITAL_Level1} attribute.
+These attributes are defined in the @code{ieee.VITAL_Timing} package.
+
+Currently, only VITAL level 0 checks are implemented.  VITAL level 1 models
+can be analyzed, but GHDL doesn't check they comply with the VITAL standard.
+
+Moreover, GHDL doesn't check (yet) that timing generics are not read inside
+a VITAL level 0 model prior the VITAL annotation.
+
+The analysis of a non-conformant VITAL model fails.  You can disable the
+checks of VITAL restrictions with the @option{--no-vital-checks}.  Even when
+restrictions are not checked, SDF annotation can be performed.
+
+@node  Backannotation, Negative constraint calculation, VHDL restrictions for VITAL, GHDL implementation of VITAL
+@comment  node-name,  next,  previous,  up
+@section Backannotation
+@cindex SDF
+@dfn{Backannotation} is the process of setting VITAL generics with timing
+information provided by an external files.
+
+The external files must be SDF (Standard Delay Format) files.  GHDL
+supports a tiny subset of SDF version 2.1, other version number can be
+used, provided no features added by the next version are used.
+
+Hierarchical instance names are not supported. However you can use a list of
+instances.  If there is no instance, the top entity will be annotated and
+the celltype must be the name of the top entity.  If there is at least one
+instance, the last instance name must be a component instantiation labe, and
+the celltype must be the name of the component declaration instantiated.
+
+Instances being annotated are not required to be VITAL compliant.  However
+generics being annotated must follow rules of VITAL (eg, type must be a
+suitable vital delay type).
+
+Currently, only timing constraints applying on a timing generic of type
+@code{VitalDelayType01} has been implemented.  This SDF annotator is
+just a proof of concept.  Features will be added with the following GHDL
+release.
+
+@node  Negative constraint calculation,  , Backannotation, GHDL implementation of VITAL
+@comment  node-name,  next,  previous,  up
+@section Negative constraint calculation
+Negative constraint delay adjustement are necessary to handle negative
+constraint such as a negative setup time.  This step is defined in the VITAL
+standard and should occurs after backannotation.
+
+GHDL does not do negative constraint calculation.  It fails to handle models
+with negative constraint.  I hope to be able to add this phase soon.
+
+@node Flaws and bugs report, Copyrights, GHDL implementation of VITAL, Top
+@comment  node-name,  next,  previous,  up
+@chapter Flaws and bugs report
+
+The current version of GHDL is really a beta version.  Some features of
+VHDL have not been implemented or are only partially implemented.  Besides,
+GHDL has not been extensively tested yet.
+
+@menu
+* Deficiencies::                
+* Reporting bugs::              
+* Future improvements::         
+@end menu
+
+@node Deficiencies, Reporting bugs, Flaws and bugs report, Flaws and bugs report
+@comment  node-name,  next,  previous,  up
+@section Deficiencies
+Here is the non-exhaustive list of flaws:
+
+@itemize @bullet
+@item
+So far, @code{GHDL} has been compiled and tested only on @samp{i386-linux} systems.
+@item
+Overflow detection is not yet implemented.
+@item
+Some contraint checks are missing.
+@item
+VHDL-93 is not completly implemented.
+@item
+There are no checks for elaboration order.
+@item
+This list is not exhaustive.
+@item
+@dots{}
+@end itemize
+
+@node Reporting bugs, Future improvements, Deficiencies, Flaws and bugs report
+@comment  node-name,  next,  previous,  up
+@section Reporting bugs
+In order to improve GHDL, we welcome bugs report and suggestions for any
+aspect of GHDL.  Please email them to @email{ghdl@@free.fr}.
+
+If the compiler crashes, this is a bug.  Reliable tools never crash.
+  
+If your compiled VHDL executable crashes, this may be a bug at
+run time or the code produced may be wrong.  However, since VHDL
+has a notion of pointers, an erroneous VHDL program (using invalid
+pointers for example) may crash.
+
+If the compiler emits an error message for a perfectly valid input or
+does not emit an error message for an invalid input, this may be a bug.
+Please send the input file and what you expected.  If you know the LRM
+well enough, please specify the paragraph which has not been well
+implemented.  If you don't know the LRM, maybe your bug report will be
+rejected simply because there is no bug.  In the latter case, it may be
+difficult to discuss the issue; and comparisons with other VHDL tools
+is not a very strong argument.
+
+If a compiler message is not clear enough for you, please tell me.  The
+error messages can be improved, but I have not enough experience with
+them.
+
+If you have found a mistake in the manual, please send a comment.  If
+you have not understood some parts of this manual, please tell me.
+English is not my mother tongue, so this manual may not be well-written.
+Again, rewriting part of it is a good way to improve it.
+
+If you send a @code{VHDL} file producing a bug, it is a good idea to try
+to make it as short as possible.  It is also a good idea to make it
+looking like a test: write a comment which explains wether the file
+should compile, and if yes, whether or not it should run successfully.
+In the latter case, an assert statement should finish the test; the
+severity level note indicates success, while a severity level failure
+indicates failure.
+
+For bug reports, please include enough information for the maintainers to
+reproduce the problem. This includes:
+
+@itemize @bullet
+@item
+the version of @code{GHDL} (you can get it with @samp{ghdl --version}).
+@item
+the operating system
+@item
+whether you have built @code{GHDL} from sources or used the binary
+distribution.
+@item
+the content of the input files
+@item
+a description of the problem and samples of any erroneous input
+@item
+anything else that you think would be helpful.
+@end itemize
+
+@node Future improvements,  , Reporting bugs, Flaws and bugs report
+@comment  node-name,  next,  previous,  up
+@section Future improvements
+I have several axes for @code{GHDL} improvements:
+@itemize @bullet
+@item
+Documentation.
+@item
+Better diagnostics messages (warning and error).
+@item
+Full support of VHDL-87 and VHDL-93.
+@item
+Support of VHDL-02.
+@item
+Optimization (simulation speed).
+@item
+Graphical tools (to see waves and to debug)
+@item
+Style checks
+@item
+VITAL acceleration
+@end itemize
+
+@c And without any order:
+@c VHPI
+@c FOREIGN
+@c AMS
+@c verilog
+
+@node Copyrights, Index, Flaws and bugs report, Top
+@comment  node-name,  next,  previous,  up
+@chapter Copyrights
+
+The GHDL front-end, the @samp{std.textio} package and the run-time
+library (grt) are copyrighted Tristan Gingold, come with @emph{absolutely
+no warranty}, and are distributed under the conditions of the General
+Public License.
+
+The @samp{ieee.numeric_bit} and @samp{ieee.numeric_std} packages are
+copyrighted by the IEEE.  The source files may be distributed without
+change, except as permitted by the standard.
+@comment FIXME: this sounds strange
+This source file may not be
+sold or distributed for profit.  See the source file and the IEEE 1076.3
+standard for more information.
+
+The @samp{ieee.std_logic_1164} package is copyrighted by the IEEE.  See
+source file and the IEEE 1164 standard for more information.
+
+The @samp{ieee.VITAL_Primitives}, @samp{ieee.VITAL_Timing} and
+@samp{ieee.VITAL_Memory} packages are copyrighted by IEEE.  See source
+file and the IEEE 1076.4 standards for more information.
+
+The @samp{ieee.Math_Real} and @samp{ieee.Math_Complex} packages are
+copyrighted by IEEE.  These are draft versions which may used and distributed
+without restriction.  These packages cannot be sold or distributed for profit.
+See source files for more information.
+
+The packages @samp{std_logic_arith}, @c @samp{std_logic_misc},
+@samp{std_logic_signed}, @samp{std_logic_unsigned} and
+@samp{std_logic_textio} contained in the @samp{synopsys} directory are
+copyrighted by Synopsys, Inc.  The source files may be used and
+distributed without restriction provided that the copyright statements
+are not removed from the files and that any derivative work contains the
+copyright notice.  See the source files for more information.
+
+The package @samp{std_logic_arith} contained in the @samp{mentor}
+directory is copyrighted by Mentor Graphics.  The source files may be
+distributed in whole without restriction provided that the copyright
+statement is not removed from the file and that any derivative work
+contains this copyright notice.  See the source files for more information.
+
+As a consequence of the run-time copyright, you may not be allowed to
+distribute an executable produced by @code{GHDL} without the VHDL
+sources.  To my mind, this is not a real restriction, since there is no
+points in distributing VHDL executable.  Please, send a comment
+(@pxref{Reporting bugs}) if you don't like this policy.
+
+@node Index,  , Copyrights, Top
+@unnumbered Index
+@printindex cp
+
+@bye
diff --git a/errorout.adb b/errorout.adb
new file mode 100644
index 000000000..e5ba40d54
--- /dev/null
+++ b/errorout.adb
@@ -0,0 +1,1055 @@
+--  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 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 Types; use Types;
+with Iirs; use Iirs;
+with Scan;
+with Tokens; use Tokens;
+with Name_Table;
+with Iirs_Utils;
+with Files_Map; use Files_Map;
+with Ada.Strings.Unbounded;
+with Std_Names;
+with Flags;
+
+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: 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 & ": can't 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 & ": can't handle "
+                & Iir_Predefined_Functions'Image (Def));
+      raise Internal_Error;
+   end Error_Kind;
+
+   -- Disp an error, prepended with program name.
+   -- This is used for errors before initialisation, such as bad option or
+   -- bad filename.
+   procedure Error_Msg_Option (Msg: String) is
+   begin
+      Put (Ada.Command_Line.Command_Name);
+      Put (":*command-line*: ");
+      Put_Line (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 (Scan.Get_Current_File,
+                     Scan.Get_Current_Line,
+                     Scan.Get_Current_Column);
+   end Disp_Current_Location;
+
+   procedure Disp_Token_Location is
+   begin
+      Disp_Location (Scan.Get_Current_File,
+                     Scan.Get_Current_Line,
+                     Scan.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 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 Scan.Current_Token is
+         when Tok_Identifier =>
+            Put ("identifier """
+                 & Name_Table.Image (Scan.Current_Identifier) & """");
+         when others =>
+            Put (Token_Type'Image (Scan.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;
+
+   -- 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 : 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 message during execution.
+   procedure Error_Msg_Exec (Msg: String; Loc: in Iir) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Disp_Iir_Location (Loc);
+      Put (' ');
+      Put_Line (Msg);
+      raise Simulation_Error;
+   end Error_Msg_Exec;
+
+   procedure Warning_Msg_Exec (Msg: String; Loc: Iir) is
+   begin
+      Disp_Iir_Location (Loc);
+      Put ("warning: ");
+      Put_Line (Msg);
+   end Warning_Msg_Exec;
+
+   -- Disp a message for a constraint error.
+   procedure Error_Msg_Constraint (Expr: in Iir) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      if Expr /= Null_Iir then
+         Disp_Iir_Location (Expr);
+      end if;
+      Put ("constraint violation");
+      if Expr /= Null_Iir then
+         case Get_Kind (Expr) is
+            when Iir_Kind_Addition_Operator =>
+               Put_Line (" in the ""+"" operation");
+            when Iir_Kind_Substraction_Operator =>
+               Put_Line (" in the ""-"" operation");
+            when Iir_Kind_Integer_Literal =>
+               Put_Line (", literal out of range");
+            when Iir_Kind_Signal_Interface_Declaration
+              | Iir_Kind_Signal_Declaration =>
+               Put_Line (" for " & Disp_Node (Expr));
+            when others =>
+               Put_Line ("");
+         end case;
+      end if;
+      raise Execution_Constraint_Error;
+   end Error_Msg_Constraint;
+
+   -- 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 """
+              & Iirs_Utils.Image_String_Lit (Node) & """";
+         when Iir_Kind_Bit_String_Literal =>
+            return "bit string literal """
+              & Iirs_Utils.Image_String_Lit (Node) & """";
+         when Iir_Kind_Character_Literal =>
+            return "character literal " & Iirs_Utils.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 " & Iirs_Utils.Image_Identifier (Node);
+         when Iir_Kind_Element_Declaration =>
+            return Disp_Identifier (Node, "element");
+         when Iir_Kind_Null_Literal =>
+            return "null literal";
+         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";
+
+         --  Should never be displayed, but for completness...
+         when Iir_Kind_Proxy =>
+            return "proxy";
+         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 =>
+            return "association element";
+         when Iir_Kind_Overload_List =>
+            return "overloaded name or expression";
+
+         when Iir_Kind_Array_Type_Definition =>
+            return Disp_Type (Node, "array type");
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Unconstrained_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_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_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition =>
+            return Iirs_Utils.Image_Identifier (Get_Type_Declarator (Node));
+         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_Suffix_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 Disp_Node (Get_Entity (Node))
+              & '(' & Iirs_Utils.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 (Iirs_Utils.Get_Operator_Name (Node))
+              & """";
+         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_Constant_Interface_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, "generic");
+               when others =>
+                  return Disp_Identifier (Node, "constant interface");
+            end case;
+         when Iir_Kind_Signal_Interface_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_Variable_Interface_Declaration =>
+            return Disp_Identifier (Node, "variable interface");
+         when Iir_Kind_File_Interface_Declaration =>
+            return Disp_Identifier (Node, "file 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_Declaration =>
+            return Disp_Identifier (Node, "architecture") &
+              " of" & Disp_Identifier (Get_Entity (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_Library_Unit (Get_Entity (Node));
+                  Arch := Get_Block_Specification
+                    (Get_Block_Configuration (Node));
+                  return "default configuration of "
+                    & Iirs_Utils.Image_Identifier (Ent)
+                    & '(' & Iirs_Utils.Image_Identifier (Arch) & ')';
+               end if;
+            end;
+         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_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 "
+--               & Iirs_Utils.Get_Predefined_Function_Name
+--               (Get_Implicit_Definition (Node));
+         when Iir_Kind_Implicit_Procedure_Declaration =>
+            return "implicit procedure "
+              & Iirs_Utils.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_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_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 others =>
+--              Error_Kind ("disp_node", Node);
+--              return "???";
+      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 : String := Natural'Image (Line);
+      Col_Str : 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 : 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;
+      begin
+         Image (Get_Identifier (Get_Type_Declarator (Def)));
+         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 : 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
+      use Iirs_Utils;
+      Decl : Iir;
+   begin
+      Decl := Get_Type_Declarator (Def);
+      if Decl /= Null_Iir then
+         return Image_Identifier (Decl);
+      else
+         Decl := Get_Type_Declarator (Get_Base_Type (Def));
+         return "a subtype of " & Image_Identifier (Decl);
+      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;
+
+end Errorout;
diff --git a/errorout.ads b/errorout.ads
new file mode 100644
index 000000000..8707d2d7f
--- /dev/null
+++ b/errorout.ads
@@ -0,0 +1,137 @@
+--  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 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 Iirs; use Iirs;
+
+package Errorout is
+   Option_Error: exception;
+   Parse_Error: exception;
+   Compilation_Error: exception;
+   Simulation_Error: exception;
+   Elaboration_Error : exception;
+
+   -- This exception is raised when a constraint error is detected during
+   -- an evaluation of an expression.
+   Execution_Constraint_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);
+   pragma No_Return (Error_Kind);
+
+   -- Raise when an assertion of failure severity error fails.
+   Assertion_Failure: exception;
+
+   -- 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);
+
+   -- 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_Elab (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 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: Location_Type);
+
+   -- Disp a message during elaboration.
+   procedure Error_Msg_Elab (Msg: String);
+   procedure Error_Msg_Elab (Msg: String; Loc: Iir);
+
+   -- 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 message for a constraint error.
+   -- And raise the exception execution_constraint_error.
+   procedure Error_Msg_Constraint (Expr: 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);
+
+
+end Errorout;
diff --git a/evaluation.adb b/evaluation.adb
new file mode 100644
index 000000000..c64eea451
--- /dev/null
+++ b/evaluation.adb
@@ -0,0 +1,2030 @@
+--  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 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 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;
+with Std_Names;
+
+package body Evaluation is
+   function Get_Physical_Value (Expr : Iir) return Iir_Int64 is
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Physical_Int_Literal =>
+            return Get_Value (Expr)
+              * Get_Value (Get_Physical_Unit_Value (Get_Unit_Name (Expr)));
+         when Iir_Kind_Unit_Declaration =>
+            return Get_Value (Get_Physical_Unit_Value (Expr));
+         when others =>
+            Error_Kind ("get_physical_value", Expr);
+      end case;
+   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 (Val : Iir_Index32; Origin : Iir)
+     return Iir_Enumeration_Literal
+   is
+      Res : Iir_Enumeration_Literal;
+      Enum_Type : Iir;
+      Enum_List : Iir_List;
+      Lit : Iir_Enumeration_Literal;
+   begin
+      Enum_Type := Get_Base_Type (Get_Type (Origin));
+      Enum_List := Get_Enumeration_Literal_List (Enum_Type);
+      Lit := Get_Nth_Element (Enum_List, Integer (Val));
+
+      Res := Create_Iir (Iir_Kind_Enumeration_Literal);
+      Set_Identifier (Res, Get_Identifier (Lit));
+      Location_Copy (Res, Origin);
+      Set_Enum_Pos (Res, Iir_Int32 (Val));
+      Set_Type (Res, Get_Type (Origin));
+      Set_Literal_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      Set_Enumeration_Decl (Res, Lit);
+      return Res;
+   end Build_Enumeration;
+
+   function Build_Boolean (Cond : Boolean; Origin : Iir) return Iir is
+   begin
+      return Build_Enumeration (Boolean'Pos (Cond), Origin);
+   end Build_Boolean;
+
+   function Build_Physical (Val : Iir_Int64; Origin : Iir)
+     return Iir_Physical_Int_Literal
+   is
+      Res : Iir_Physical_Int_Literal;
+   begin
+      Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+      Location_Copy (Res, Origin);
+      Set_Unit_Name (Res, Get_Primary_Unit (Get_Type (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_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 (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);
+      return Res;
+   end Build_Simple_Aggregate;
+
+   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 Get_Nth_Element
+              (Get_Enumeration_Literal_List
+               (Get_Base_Type (Get_Type (Origin))),
+               Integer (Get_Enum_Pos (Val)));
+         when Iir_Kind_Physical_Int_Literal =>
+            declare
+               Prim : Iir;
+            begin
+               Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+               Prim := Get_Primary_Unit (Get_Base_Type (Get_Type (Origin)));
+               Set_Unit_Name (Res, Prim);
+               if Get_Unit_Name (Val) = Prim then
+                  Set_Value (Res, Get_Value (Val));
+               else
+                  raise Internal_Error;
+                  --Set_Abstract_Literal (Res, Get_Abstract_Literal (Val)
+                  --                      * Get_Value (Get_Name (Val)));
+               end if;
+            end;
+         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 (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));
+
+         when Iir_Kind_Error =>
+            return Val;
+
+         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;
+
+   --  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
+      if Get_Type_Staticness (A_Type) /= Locally then
+         raise Internal_Error;
+      end if;
+
+      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
+      if Get_Type_Staticness (A_Type) /= Locally then
+         raise Internal_Error;
+      end if;
+
+      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)));
+      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 : Iir;
+      N_Index_Type : Iir;
+   begin
+      Index_Type := Get_First_Element (Get_Index_Subtype_List (Base_Type));
+      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;
+
+   function Eval_String_Literal (Str : Iir) return Iir
+   is
+      use Name_Table;
+      Ptr : String_Fat_Acc;
+      Len : Natural;
+   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 : Iir;
+               List : Iir_List;
+               Lit_0 : Iir;
+               Lit_1 : Iir;
+            begin
+               Str_Type := Get_Type (Str);
+               List := Create_Iir_List;
+               Lit_0 := Get_Bit_String_0 (Str);
+               Lit_1 := Get_Bit_String_1 (Str);
+
+               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
+      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
+              (Boolean'Pos (Get_Enum_Pos (Operand) = 0), Orig);
+
+         when Iir_Predefined_Bit_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 =>
+         Error_Msg_Sem ("arithmetic overflow in static expression", Orig);
+         return Orig;
+   end Eval_Monadic_Operator;
+
+   function Eval_Dyadic_Bit_Array_Operator
+     (Expr : Iir;
+      Left, Right : Iir;
+      Func : Iir_Predefined_Dyadic_Bit_Array_Functions)
+     return Iir
+   is
+      use Str_Table;
+      L_Str : String_Fat_Acc := Get_String_Fat_Acc (Left);
+      R_Str : String_Fat_Acc := Get_String_Fat_Acc (Right);
+      Len : Natural;
+      Id : String_Id;
+   begin
+      Len := Get_String_Length (Left);
+      if Len /= Get_String_Length (Right) then
+         Error_Msg_Sem ("length of left and right operands mismatch", Expr);
+         return Left;
+      else
+         Id := Start;
+         case Func is
+            when Iir_Predefined_Bit_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_Bit_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_Bit_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_Bit_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_Bit_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;
+         return Build_String (Id, Nat32 (Len), Left);
+      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
+         Error_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;
+            end if;
+         when others =>
+            raise Internal_Error;
+      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_List, Right_List : Iir_List;
+   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);
+         when Iir_Predefined_Array_Element_Concat
+           | Iir_Predefined_Array_Array_Concat =>
+            Left_List :=
+              Get_Simple_Aggregate_List (Eval_String_Literal (Left));
+            L := Get_Nbr_Elements (Left_List);
+            for I in 0 .. L - 1 loop
+               Append_Element (Res_List, Get_Nth_Element (Left_List, I));
+            end loop;
+      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_List :=
+              Get_Simple_Aggregate_List (Eval_String_Literal (Right));
+            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;
+      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 Get_Nbr_Elements (Left_List) = 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
+               A_Range : Iir;
+               Left_Index : Iir;
+               Left_Range : Iir;
+               Index_Type : Iir;
+               Ret_Type : Iir;
+            begin
+               Left_Index := Get_Nth_Element
+                 (Get_Index_Subtype_List (Get_Type (Left)), 0);
+               Left_Range := Get_Range_Constraint (Left_Index);
+
+               A_Range := Create_Iir (Iir_Kind_Range_Expression);
+               Ret_Type := Get_Return_Type (Get_Implementation (Orig));
+               Set_Type
+                 (A_Range,
+                  Get_First_Element (Get_Index_Subtype_List (Ret_Type)));
+               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;
+
+   --  ORIG is either a dyadic operator or a function call.
+   function Eval_Dyadic_Operator (Orig : Iir; Left, Right : Iir)
+     return Iir
+   is
+      pragma Unsuppress (Overflow_Check);
+      Func : Iir_Predefined_Functions;
+   begin
+      if Get_Kind (Left) = Iir_Kind_Error
+        or else Get_Kind (Right) = Iir_Kind_Error
+      then
+         return Null_Iir;
+      end if;
+
+      Func := Get_Implicit_Definition (Get_Implementation (Orig));
+      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 Null_Iir;
+            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 Null_Iir;
+            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 Null_Iir;
+            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), Orig);
+         when Iir_Predefined_Integer_Inequality =>
+            return Build_Boolean (Get_Value (Left) /= Get_Value (Right), Orig);
+         when Iir_Predefined_Integer_Greater_Equal =>
+            return Build_Boolean (Get_Value (Left) >= Get_Value (Right), Orig);
+         when Iir_Predefined_Integer_Greater =>
+            return Build_Boolean (Get_Value (Left) > Get_Value (Right), Orig);
+         when Iir_Predefined_Integer_Less_Equal =>
+            return Build_Boolean (Get_Value (Left) <= Get_Value (Right), Orig);
+         when Iir_Predefined_Integer_Less =>
+            return Build_Boolean (Get_Value (Left) < Get_Value (Right), Orig);
+
+         when Iir_Predefined_Floating_Equality =>
+            return Build_Boolean
+              (Get_Fp_Value (Left) = Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Floating_Inequality =>
+            return Build_Boolean
+              (Get_Fp_Value (Left) /= Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Floating_Greater =>
+            return Build_Boolean
+              (Get_Fp_Value (Left) > Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Floating_Greater_Equal =>
+            return Build_Boolean
+              (Get_Fp_Value (Left) >= Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Floating_Less =>
+            return Build_Boolean
+              (Get_Fp_Value (Left) < Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Floating_Less_Equal =>
+            return Build_Boolean
+              (Get_Fp_Value (Left) <= Get_Fp_Value (Right), Orig);
+
+         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
+               Error_Msg_Sem ("right operand of division is 0", Orig);
+               return Build_Floating (0.0, 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_Physical_Equality =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) = Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Physical_Inequality =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) /= Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Physical_Greater_Equal =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) >= Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Physical_Greater =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) > Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Physical_Less_Equal =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) <= Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Physical_Less =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) < Get_Physical_Value (Right), Orig);
+
+         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_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 =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) = Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Inequality =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) /= Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Greater_Equal =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) >= Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Greater =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) > Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Less_Equal =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) <= Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Less =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) < Get_Enum_Pos (Right), Orig);
+
+         when Iir_Predefined_Boolean_And
+           | Iir_Predefined_Bit_And =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) = 1 and Get_Enum_Pos (Right) = 1, Orig);
+         when Iir_Predefined_Boolean_Nand
+           | Iir_Predefined_Bit_Nand =>
+            return Build_Boolean
+              (not (Get_Enum_Pos (Left) = 1 and Get_Enum_Pos (Right) = 1),
+               Orig);
+         when Iir_Predefined_Boolean_Or
+           | Iir_Predefined_Bit_Or =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) = 1 or Get_Enum_Pos (Right) = 1, Orig);
+         when Iir_Predefined_Boolean_Nor
+           | Iir_Predefined_Bit_Nor =>
+            return Build_Boolean
+              (not (Get_Enum_Pos (Left) = 1 or Get_Enum_Pos (Right) = 1),
+               Orig);
+         when Iir_Predefined_Boolean_Xor
+           | Iir_Predefined_Bit_Xor =>
+            return Build_Boolean
+              (Get_Enum_Pos (Left) = 1 xor Get_Enum_Pos (Right) = 1, Orig);
+         when Iir_Predefined_Boolean_Xnor
+           | Iir_Predefined_Bit_Xnor =>
+            return Build_Boolean
+              (not (Get_Enum_Pos (Left) = 1 xor Get_Enum_Pos (Right) = 1),
+               Orig);
+
+         when Iir_Predefined_Dyadic_Bit_Array_Functions =>
+            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_Array_Equality =>
+            declare
+               L_List : Iir_List;
+               R_List : Iir_List;
+               R : Boolean;
+               N : Natural;
+            begin
+               --  FIXME: the simple aggregates are lost.
+               L_List :=
+                 Get_Simple_Aggregate_List (Eval_String_Literal (Left));
+               R_List :=
+                 Get_Simple_Aggregate_List (Eval_String_Literal (Right));
+               N := Get_Nbr_Elements (L_List);
+               if N /= Get_Nbr_Elements (R_List) then
+                  R := False;
+               else
+                  R := 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
+                        R := False;
+                        exit;
+                     end if;
+                  end loop;
+               end if;
+               return Build_Boolean (R, Orig);
+            end;
+
+         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 =>
+            return Eval_Shift_Operator
+              (Eval_String_Literal (Left), Right, Orig, Func);
+
+         when Iir_Predefined_Boolean_Not
+           | Iir_Predefined_Bit_Not
+           | 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 =>
+            --  Not binary or never locally static.
+            Error_Internal (Orig, "eval_dyadic_operator: " &
+                            Iir_Predefined_Functions'Image (Func));
+         when others =>
+            Error_Internal (Orig, "eval_dyadic_operator: " &
+                            Iir_Predefined_Functions'Image (Func));
+      end case;
+   exception
+      when Constraint_Error =>
+         Error_Msg_Sem ("arithmetic overflow in static expression", Orig);
+         return Null_Iir;
+   end Eval_Dyadic_Operator;
+
+   --  Evaluate any array attribute
+   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
+           | 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 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_Incdec (Expr : Iir; N : Iir_Int64) return Iir
+   is
+      P : Iir_Int64;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Integer_Literal =>
+            return Build_Integer (Get_Value (Expr) + N, Expr);
+         when Iir_Kind_Enumeration_Literal =>
+            P := Iir_Int64 (Get_Enum_Pos (Expr)) + N;
+            if P < 0 then
+               Error_Msg_Sem ("static constant violates bounds", Expr);
+               return Expr;
+            else
+               return Build_Enumeration (Iir_Index32 (P), Expr);
+            end if;
+         when Iir_Kind_Physical_Int_Literal =>
+            return Build_Physical (Get_Value (Expr) + N, Expr);
+         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 : Iir;
+      Res : Iir;
+      Val_Type : Iir;
+      Conv_Index_Type : Iir;
+      Val_Index_Type : Iir;
+      Index_Type : Iir;
+      Rng : Iir;
+   begin
+      Conv_Type := Get_Type (Conv);
+      Conv_Index_Type := Get_Nth_Element
+        (Get_Index_Subtype_List (Conv_Type), 0);
+      Val_Type := Get_Type (Val);
+      Val_Index_Type := Get_Nth_Element
+        (Get_Index_Subtype_List (Val_Type), 0);
+
+      --  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
+               Error_Msg_Sem ("non matching length in type convertion", Conv);
+            end if;
+            return Res;
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_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;
+            Set_Type (Res,
+                      Create_Unidim_Array_From_Index
+                      (Get_Base_Type (Conv_Type), Index_Type, Conv));
+            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_Expr (Get_Expression (Expr));
+      Set_Expression (Expr, Val);
+      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_Static_Expr (Expr: Iir) return Iir
+   is
+      Res : Iir;
+      Val : Iir;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Integer_Literal =>
+            return Expr;
+         when Iir_Kind_Enumeration_Literal =>
+            return Expr;
+         when Iir_Kind_Floating_Point_Literal =>
+            return Expr;
+         when Iir_Kind_String_Literal =>
+            return Expr;
+         when Iir_Kind_Bit_String_Literal =>
+            return Expr;
+         when Iir_Kind_Physical_Int_Literal =>
+            if Get_Unit_Name (Expr)
+              = Get_Primary_Unit (Get_Base_Type (Get_Type (Expr)))
+            then
+               return Expr;
+            else
+               return Build_Physical (Get_Physical_Value (Expr), Expr);
+            end if;
+         when Iir_Kind_Physical_Fp_Literal =>
+            return Build_Physical
+              (Iir_Int64 (Get_Fp_Value (Expr)
+                          * Iir_Fp64 (Get_Value (Get_Physical_Unit_Value
+                                                 (Get_Unit_Name (Expr))))),
+               Expr);
+         when Iir_Kind_Constant_Declaration =>
+            Val := Get_Default_Value (Expr);
+            Res := Build_Constant (Val, Expr);
+            Set_Type (Res, Get_Type (Val));
+            return Res;
+         when Iir_Kind_Object_Alias_Declaration =>
+            return Build_Constant (Eval_Static_Expr (Get_Name (Expr)), Expr);
+         when Iir_Kind_Unit_Declaration =>
+            return Expr;
+         when Iir_Kind_Simple_Aggregate =>
+            return Expr;
+
+         when Iir_Kind_Qualified_Expression =>
+            return Build_Constant (Eval_Expr (Get_Expression (Expr)), Expr);
+         when Iir_Kind_Type_Conversion =>
+            return Eval_Type_Conversion (Expr);
+         when Iir_Kind_Range_Expression =>
+            Set_Left_Limit (Expr, Eval_Expr (Get_Left_Limit (Expr)));
+            Set_Right_Limit (Expr, Eval_Expr (Get_Right_Limit (Expr)));
+            return Expr;
+
+         when Iir_Kinds_Monadic_Operator =>
+            declare
+               Operand : Iir;
+            begin
+               Operand := Eval_Expr (Get_Operand (Expr));
+               Set_Operand (Expr, Operand);
+               return Eval_Monadic_Operator (Expr, Operand);
+            end;
+         when Iir_Kinds_Dyadic_Operator =>
+            declare
+               Left, Right : Iir;
+            begin
+               Left := Eval_Expr (Get_Left (Expr));
+               Right := Eval_Expr (Get_Right (Expr));
+
+               Set_Left (Expr, Left);
+               Set_Right (Expr, Right);
+               return Eval_Dyadic_Operator (Expr, Left, Right);
+            end;
+
+         when Iir_Kind_Attribute_Value =>
+            --  FIXME.
+            --  Currently, this avoids weird nodes, such as a string literal
+            --  whose type is an unconstrained array type.
+            Val := Get_Expression (Get_Attribute_Specification (Expr));
+            Res := Build_Constant (Val, Expr);
+            Set_Type (Res, Get_Type (Val));
+            return Res;
+
+         when Iir_Kind_Pos_Attribute =>
+            declare
+               Val : Iir;
+            begin
+               Val := Eval_Expr (Get_Parameter (Expr));
+               Set_Parameter (Expr, Val);
+               return Build_Integer (Eval_Pos (Val), Expr);
+            end;
+         when Iir_Kind_Val_Attribute =>
+            declare
+               Val_Expr : Iir;
+               Val : Iir_Int64;
+               Expr_Type : Iir;
+            begin
+               Val_Expr := Eval_Expr (Get_Parameter (Expr));
+               Set_Parameter (Expr, Val_Expr);
+               Val := Eval_Pos (Val_Expr);
+               --  Note: the type of 'val is a base type.
+               Expr_Type := Get_Type (Expr);
+               --  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
+                  Error_Msg_Sem
+                    ("static argument out of the type range", Expr);
+                  Val := 0;
+               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_Left_Type_Attribute =>
+            return Build_Constant
+              (Get_Left_Limit (Eval_Range (Get_Type (Expr))), Expr);
+         when Iir_Kind_Right_Type_Attribute =>
+            return Build_Constant
+              (Get_Right_Limit (Eval_Range (Get_Type (Expr))), Expr);
+         when Iir_Kind_High_Type_Attribute =>
+            return Build_Constant
+              (Get_High_Limit (Eval_Range (Get_Type (Expr))), Expr);
+         when Iir_Kind_Low_Type_Attribute =>
+            return Build_Constant
+              (Get_Low_Limit (Eval_Range (Get_Type (Expr))), Expr);
+         when Iir_Kind_Ascending_Type_Attribute =>
+            return Build_Boolean
+              (Get_Direction (Eval_Range (Get_Type (Expr))) = Iir_To, Expr);
+
+         when Iir_Kind_Range_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Get_Range_Constraint (Index);
+            end;
+         when Iir_Kind_Reverse_Range_Array_Attribute =>
+            declare
+               Res : Iir;
+               Rng : Iir;
+            begin
+               Rng := Get_Range_Constraint (Eval_Array_Attribute (Expr));
+               Res := Create_Iir (Iir_Kind_Range_Expression);
+               Location_Copy (Res, Rng);
+               Set_Type (Res, Get_Type (Rng));
+               case Get_Direction (Rng) 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 (Rng));
+               Set_Right_Limit (Res, Get_Left_Limit (Rng));
+               -- FIXME: todo.
+               --Set_Literal_Origin (Res, Rng);
+               Set_Expr_Staticness (Res, Get_Expr_Staticness (Rng));
+               return Res;
+            end;
+         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 Build_Constant
+                 (Get_Left_Limit (Get_Range_Constraint (Index)), Expr);
+            end;
+         when Iir_Kind_Right_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Build_Constant
+                 (Get_Right_Limit (Get_Range_Constraint (Index)), Expr);
+            end;
+         when Iir_Kind_Low_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Build_Constant
+                 (Get_Low_Limit (Get_Range_Constraint (Index)), Expr);
+            end;
+         when Iir_Kind_High_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Build_Constant
+                 (Get_High_Limit (Get_Range_Constraint (Index)), Expr);
+            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, Expr);
+            end;
+
+         when Iir_Kind_Pred_Attribute =>
+            Res := Eval_Incdec (Eval_Static_Expr (Get_Parameter (Expr)), -1);
+            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);
+            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_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);
+               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
+               Left, Right : Iir;
+            begin
+               --  Note: there can't be association by name.
+               Left := Get_Parameter_Association_Chain (Expr);
+               Right := Get_Chain (Left);
+               if Right = Null_Iir then
+                  return Eval_Monadic_Operator (Expr, Get_Actual (Left));
+               else
+                  return Eval_Dyadic_Operator
+                    (Expr, Get_Actual (Left), Get_Actual (Right));
+               end if;
+            end;
+
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            declare
+               Res : Iir;
+               Orig : Iir;
+            begin
+               Orig := Get_Named_Entity (Expr);
+               Res := Eval_Static_Expr (Orig);
+               if Res /= Orig then
+                  Location_Copy (Res, Expr);
+               end if;
+               Free_Name (Expr);
+               return Res;
+            end;
+         when Iir_Kind_Error =>
+            return Expr;
+         when others =>
+            Error_Kind ("eval_static_expr", Expr);
+      end case;
+   end Eval_Static_Expr;
+
+   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_Static_Expr (Expr);
+      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_Static_Expr (Expr);
+      else
+         return Expr;
+      end if;
+   end Eval_Expr_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;
+   begin
+      if Get_Kind (Expr) = Iir_Kind_Error then
+         return True;
+      end if;
+
+      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 (Expr), Type_Range);
+         when Iir_Kind_Floating_Subtype_Definition =>
+            Type_Range := Get_Range_Constraint (Sub_Type);
+            return Eval_Fp_In_Range (Get_Fp_Value (Expr), 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 (Expr)), Type_Range);
+         when Iir_Kind_Physical_Subtype_Definition =>
+            Type_Range := Get_Range_Constraint (Sub_Type);
+            return Eval_Phys_In_Range (Get_Physical_Value (Expr), Type_Range);
+
+         when Iir_Kind_Base_Attribute =>
+            return Eval_Is_In_Bound (Expr, 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 Iir_Kind_Integer_Type_Definition =>
+            --  This case should not happen but it may be called to check a
+            --  simple choice value belongs to the *type* of the case
+            --  expression.
+            --  Of course, this is always true.
+         --   return True;
+
+         when others =>
+            Error_Kind ("eval_is_in_bound", Sub_Type);
+            return False;
+      end case;
+   end Eval_Is_In_Bound;
+
+   procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir)
+   is
+   begin
+      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)
+     return Boolean
+   is
+      Type_Range : Iir;
+   begin
+      Type_Range := Get_Range_Constraint (Sub_Type);
+      if Get_Direction (Type_Range) /= Get_Direction (A_Range) 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 (A_Range));
+               R := Eval_Pos (Get_Right_Limit (A_Range));
+               case Get_Direction (A_Range) 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 (A_Range));
+               R := Get_Fp_Value (Get_Right_Limit (A_Range));
+               case Get_Direction (A_Range) 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)
+   is
+   begin
+      if not Eval_Is_Range_In_Bound (A_Range, Sub_Type) then
+         Error_Msg_Sem ("static range violates bounds", A_Range);
+      end if;
+   end Eval_Check_Range;
+
+   function Eval_Expr_Check (Expr : Iir; Sub_Type : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Eval_Expr (Expr);
+      Eval_Check_Bound (Res, Sub_Type);
+      return Res;
+   end Eval_Expr_Check;
+
+   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 =>
+            return Get_Physical_Value (Expr);
+         when Iir_Kind_Unit_Declaration =>
+            return Get_Value (Get_Physical_Unit_Value (Expr));
+         when others =>
+            Error_Kind ("eval_pos", Expr);
+      end case;
+   end Eval_Pos;
+
+   function Eval_Range (Rng : Iir) return Iir
+   is
+      Expr : Iir;
+   begin
+      Expr := Rng;
+      loop
+         case Get_Kind (Expr) is
+            when Iir_Kind_Range_Expression =>
+               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 =>
+               declare
+                  Prefix : 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);
+               end;
+            when others =>
+               Error_Kind ("eval_range", Expr);
+         end case;
+      end loop;
+   end Eval_Range;
+
+   --  Return the range constraint of a discrete range.
+   function Eval_Discrete_Range_Expression (Constraint : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Eval_Range (Constraint);
+      if Res = Null_Iir then
+         Error_Kind ("eval_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;
+end Evaluation;
diff --git a/evaluation.ads b/evaluation.ads
new file mode 100644
index 000000000..a36286372
--- /dev/null
+++ b/evaluation.ads
@@ -0,0 +1,98 @@
+--  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 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 Iirs; use Iirs;
+
+package Evaluation is
+
+   --  Get the value of a physical integer literal or unit.
+   function Get_Physical_Value (Expr : Iir) return Iir_Int64;
+
+   --  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.
+   function Eval_Expr (Expr: Iir) return Iir;
+
+   --  Same as Eval_Expr, but do not check that EXPR is locally static.
+   --  May be used instead of Eval_Expr if you know than EXPR is locally
+   --  static, or for literals of type std.time.
+   function Eval_Static_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;
+
+   --  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);
+
+   --  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)
+     return Boolean;
+
+   --  Emit an error if A_RANGE is not included in SUB_TYPE.
+   procedure Eval_Check_Range (A_Range : 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;
+
+   --  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 range_expression of RNG, which is a range or a subtype.
+   --  Return NULL_IIR if the range constraint is not a range_expression.
+   function Eval_Range (Rng : 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;
+
+   --  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);
+end Evaluation;
diff --git a/files_map.adb b/files_map.adb
new file mode 100644
index 000000000..629911aef
--- /dev/null
+++ b/files_map.adb
@@ -0,0 +1,943 @@
+--  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 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 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 System;
+with Name_Table; use Name_Table;
+with Str_Table;
+with Ada.Calendar;
+
+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;
+
+   function Is_Absolute_Pathname (Path : String) return Boolean is
+   begin
+      --  This is the POSIX rule.
+      if Path'Length = 0 then
+         return False;
+      end if;
+      return Path (Path'First) = GNAT.OS_Lib.Directory_Separator;
+   end Is_Absolute_Pathname;
+
+   --  Note: BUF must be 1 based.
+--    procedure Get_Directory_Path (Dir : Directory_Index;
+--                                  Buf : out String;
+--                                  Len : out Natural)
+--    is
+--    begin
+--       if Dir < Pathes.First or else Dir > Pathes.Last then
+--          raise Constraint_Error;
+--       end if;
+--       Len := Pathes.Table (Dir).all'Length;
+--       if  Len > Buf'Length then
+--          raise Constraint_Error;
+--       end if;
+--       Buf (1 .. Len) := Pathes.Table (Dir).all;
+--    end Get_Directory_Path;
+
+--    --  Revert path of directory DIR into BUF of length LEN.
+--    --  If DIR is a relative path, compute the relative path from DIR to the
+--    --  current directory.
+--    --  If DIR is an absolute path, then return DIR.
+--    procedure Revert_Pathname (Dir : Directory_Index;
+--                               Buf : out String;
+--                               Len : out Natural)
+--    is
+--       Dir_Path : String (1 .. Max_Path_Len);
+--       Dir_Len : Natural;
+--       Cur_Path : String (1 .. Max_Path_Len);
+--       Cur_Len : Natural;
+--       Cur_S, Cur_L : Natural;
+--       S, L : Natural;
+
+--    begin
+--       Get_Directory_Path (Dir, Buf, Len);
+--      --  Easy case: DIR is empty (ie, is the local directory) or an absolute
+--       --  path.
+--       if Len = 0 or else Is_Absolute_Pathname (Buf (1 .. Len)) then
+--          return;
+--       end if;
+
+--       --  Copy the path to revert into Dir_Path.
+--       Dir_Len := Len;
+--       Dir_Path (1 .. Dir_Len) := Buf (1 .. Len);
+--       S := 1;
+--       L := 1;
+
+--       --  Get the local path.
+--       Get_Current_Dir (Cur_Path, Cur_Len);
+--       Cur_S := Cur_Len;
+--       Cur_L := Cur_Len;
+
+--       --  Start to revert.
+--       --  Step 1:
+--       --  ../ -> Y/ where Y is taken from CUR_PATH
+--       --  ./ -> (none)
+--       loop
+--          while S <= Dir_Len and then Dir_Path (S) = Directory_Separator loop
+--             S := S + 1;
+--          end loop;
+--          --  Exit when no more components.
+--          exit when S > Dir_Len;
+--          L := S;
+
+--          --  Look for a path component.
+--          --  At the end of the loop, Dir_Path (S .. L) is a path component,
+--          --  without any directory_separator.
+--          loop
+--             if Dir_Path (L) = Directory_Separator then
+--                L := L - 1;
+--                exit;
+--             end if;
+--             exit when L = Dir_Len;
+--             L := L + 1;
+--          end loop;
+
+--          if S = L and Dir_Path (S) = '.' then
+--             null;
+--          elsif L = S + 1
+--            and then Dir_Path (S) = '.'
+--            and then Dir_Path (S + 1) = '.'
+--          then
+--             Xxxx;
+--          else
+--             Yyy;
+--          end if;
+--    end Revert_Pathname;
+
+--    function Get_Directory_Path (Dir : Directory_Index) return String
+--    is
+--    begin
+--       if Dir < Pathes.First or else Dir > Pathes.Last then
+--          raise Constraint_Error;
+--       end if;
+--       return Pathes.Table (Dir).all;
+--    end Get_Directory_Path;
+
+
+   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 Str_Table;
+
+      Year : Year_Number;
+      Month : Month_Number;
+      Day : Day_Number;
+      Sec : Day_Duration;
+      S : Integer;
+      S1 : Integer;
+      M : Integer;
+      Res: Time_Stamp_Id;
+   begin
+      --  FIXME: Clock is local time, while get_file_time_stamp returns
+      --  GMT time.
+      Split (Clock, 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 Is_Absolute_Pathname (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_Virtual_Source_File (Name: Name_Id)
+                                       return Source_File_Entry
+   is
+      Res : Source_File_Entry;
+      Buffer: File_Buffer_Acc;
+   begin
+      Res := Create_Source_File_Entry (Null_Identifier, Name);
+
+      Buffer := new File_Buffer (Source_Ptr_Org .. Source_Ptr_Org + 1);
+
+      Buffer (Source_Ptr_Org) := EOT;
+      Buffer (Source_Ptr_Org + 1) := EOT;
+
+      Source_Files.Table (Res).Last_Location := Next_Location + 1;
+      Next_Location := Next_Location + 2;
+      Source_Files.Table (Res).Source := Buffer;
+      Source_Files.Table (Res).File_Length := 0;
+      return Res;
+   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;
+
+      declare
+         Filename : String := Get_Pathname (Directory, Name, True);
+      begin
+         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 : String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
+      R_Str : 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 : String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
+      R_Str : 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 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/files_map.ads b/files_map.ads
new file mode 100644
index 000000000..4bcf8772d
--- /dev/null
+++ b/files_map.ads
@@ -0,0 +1,150 @@
+--  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 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 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;
+
+   -- 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;
+
+   --  Return TRUE is PATH is an absolute pathname.
+   function Is_Absolute_Pathname (Path : String) return Boolean;
+
+   -- 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/flags.adb b/flags.adb
new file mode 100644
index 000000000..73a1454ce
--- /dev/null
+++ b/flags.adb
@@ -0,0 +1,241 @@
+--  Command line flags.
+--  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; use Ada.Text_IO;
+with Name_Table;
+with Libraries;
+with Scan;
+
+package body Flags is
+   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: 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;
+            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 > 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 > 7 and then Opt (Beg .. Beg + 6) = "--warn-" then
+         return Option_Warning (Opt (Beg + 7 .. Opt'Last), True);
+      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) = "--work=" then
+         declare
+            use Name_Table;
+         begin
+            Name_Length := Opt'Last - (Beg + 7) + 1;
+            Name_Buffer (1 .. Name_Length) := Opt (Beg + 7 .. Opt'Last);
+            Scan.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 = "--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 = "-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;
+      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           select vhdl 87 standard");
+      P ("  --std=93           select vhdl 93 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 ("Illegal extensions:");
+      P ("  -fexplicit         give priority to explicitly declared operator");
+      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 ("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");
+      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");
+   end Disp_Options_Help;
+
+   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";
+      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/flags.ads b/flags.ads
new file mode 100644
index 000000000..d047ba2d5
--- /dev/null
+++ b/flags.ads
@@ -0,0 +1,183 @@
+--  Command line flags.
+--  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.
+
+--  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.
+
+with Types; use Types;
+
+package Flags is
+   -- Standard accepted.
+   Vhdl_Std: Vhdl_Std_Type := Vhdl_93c;
+
+   -- 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;
+
+   --  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;
+
+   -- --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 := True;
+
+   --  --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/ieee-std_logic_1164.adb b/ieee-std_logic_1164.adb
new file mode 100644
index 000000000..625888a09
--- /dev/null
+++ b/ieee-std_logic_1164.adb
@@ -0,0 +1,161 @@
+--  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 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 Std_Names; use Std_Names;
+with Errorout; use Errorout;
+
+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);
+
+      --  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 (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 (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
+        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/ieee-std_logic_1164.ads b/ieee-std_logic_1164.ads
new file mode 100644
index 000000000..e1325c378
--- /dev/null
+++ b/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 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 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/ieee-vital_timing.adb b/ieee-vital_timing.adb
new file mode 100644
index 000000000..88f39bcf4
--- /dev/null
+++ b/ieee-vital_timing.adb
@@ -0,0 +1,1369 @@
+--  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 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 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 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 (Decl);
+               elsif Id = VitalDelayArrayType01_Id then
+                  VitalDelayArrayType01 := Get_Type (Decl);
+               elsif Id = VitalDelayArrayType01Z_Id then
+                  VitalDelayArrayType01Z := Get_Type (Decl);
+               elsif Id = VitalDelayArrayType01ZX_Id then
+                  VitalDelayArrayType01ZX := Get_Type (Decl);
+               end if;
+            when Iir_Kind_Anonymous_Type_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = VitalDelayType01_Id then
+                  VitalDelayType01 := Get_Type (Decl);
+               elsif Id = VitalDelayType01Z_Id then
+                  VitalDelayType01Z := Get_Type (Decl);
+               elsif Id = VitalDelayType01ZX_Id then
+                  VitalDelayType01ZX := Get_Type (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_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 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_Signal_Interface_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_Function (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 : 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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_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_Constant_Interface_Declaration)
+   is
+      Oport : Iir;
+      Pos : Natural;
+      Kind : Timing_Generic_Type_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_Constant_Interface_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_Constant_Interface_Declaration)
+   is
+      Iport : Iir;
+      Oport : Iir;
+      Cport : Iir;
+      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 exit, 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_Constant_Interface_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_Constant_Interface_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 ("generic 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_Design_Unit) 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_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_Declaration)
+   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 (Get_Design_Unit (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_Declaration =>
+            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_Declaration 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/ieee-vital_timing.ads b/ieee-vital_timing.ads
new file mode 100644
index 000000000..b67271c19
--- /dev/null
+++ b/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 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 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/ieee.ads b/ieee.ads
new file mode 100644
index 000000000..48ab37630
--- /dev/null
+++ b/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/iir_chain_handling.adb b/iir_chain_handling.adb
new file mode 100644
index 000000000..b660d5d2d
--- /dev/null
+++ b/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 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 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/iir_chain_handling.ads b/iir_chain_handling.ads
new file mode 100644
index 000000000..0ba70ae66
--- /dev/null
+++ b/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 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;
+
+--  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/iir_chains.adb b/iir_chains.adb
new file mode 100644
index 000000000..984ab9909
--- /dev/null
+++ b/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 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 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/iir_chains.ads b/iir_chains.ads
new file mode 100644
index 000000000..f853df4b4
--- /dev/null
+++ b/iir_chains.ads
@@ -0,0 +1,117 @@
+--  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 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 Iir_Chain_Handling;
+pragma Elaborate (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 Element_Declaration_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Element_Declaration_Chain,
+      Set_Chain_Start => Set_Element_Declaration_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/iirs.adb b/iirs.adb
new file mode 100644
index 000000000..a529828c5
--- /dev/null
+++ b/iirs.adb
@@ -0,0 +1,6572 @@
+--  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 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 Ada.Unchecked_Conversion;
+with Ada.Text_IO;
+with Errorout; use Errorout;
+with Nodes; use Nodes;
+with Lists; use Lists;
+
+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 --
+   ---------------------------------------------------
+
+   -- This is the procedure to call when an internal consistancy test has
+   -- failed.
+   -- The main idea is the consistancy test *MUST* have no side effect,
+   -- except calling this procedure.  To speed up, this procedure could
+   -- be a no-op.
+   procedure Failed (Func: String := ""; Node : Iir := Null_Iir)
+   is
+   begin
+      if Func /= "" then
+         Error_Kind (Func, Node);
+      end if;
+      raise Internal_Error;
+   end Failed;
+
+   function Get_Format (Kind : Iir_Kind) return Format_Type;
+
+   --  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_Proxy (Proxy: Iir) return Iir_Proxy is
+      Res : Iir_Proxy;
+   begin
+      Res := Create_Iir (Iir_Kind_Proxy);
+      Set_Proxy (Res, Proxy);
+      return Res;
+   end Create_Proxy;
+
+   --
+
+   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 Clone_Iir (Src : Iir; New_Kind : Iir_Kind) return Iir
+--    is
+--       Res : Iir;
+--    begin
+--       Res := new Iir_Node (New_Kind);
+--       Res.Flag1 := Src.Flag1;
+--       Res.Flag2 := Src.Flag2;
+--       Res.Flag3 := Src.Flag3;
+--       Res.Flag4 := Src.Flag4;
+--       Res.Flag5 := Src.Flag5;
+--       Res.Flag6 := Src.Flag6;
+--       Res.Flag7 := Src.Flag7;
+--       Res.Flag8 := Src.Flag8;
+--       Res.State1 := Src.State1;
+--       Res.State2 := Src.State2;
+--       Res.State3 := Src.State3;
+--       Res.Staticness1 := Src.Staticness1;
+--       Res.Staticness2 := Src.Staticness2;
+--       Res.Odigit1 := Src.Odigit1;
+--       Res.Odigit2 := Src.Odigit2;
+--       Res.Location := Src.Location;
+--       Res.Back_End_Info := Src.Back_End_Info;
+--       Res.Identifier := Src.Identifier;
+--       Res.Field1 := Src.Field1;
+--       Res.Field2 := Src.Field2;
+--       Res.Field3 := Src.Field3;
+--       Res.Field4 := Src.Field4;
+--       Res.Field5 := Src.Field5;
+--       Res.Nbr2 := Src.Nbr2;
+--       Res.Nbr3 := Src.Nbr3;
+
+--       Src.Identifier := Null_Identifier;
+--       Src.Field1 := null;
+--       Src.Field2 := null;
+--       Src.Field3 := null;
+--       Src.Field4 := null;
+--       Src.Field5 := null;
+--       return Res;
+--    end Clone_Iir;
+
+
+   -----------------
+   -- design file --
+   -----------------
+
+   -- Iir_Design_File
+
+--   type Int_Access_Type is new Integer;
+--   for Int_Access_Type'Size use System.Word_Size; --Iir_Identifier_Acc'Size;
+
+   --  Safe conversions.
+--    function Iir_To_Int_Access_Type is
+--       new Ada.Unchecked_Conversion (Source => Iir,
+--                                     Target => Int_Access_Type);
+--    function Int_Access_Type_To_Iir is
+--       new Ada.Unchecked_Conversion (Source => Int_Access_Type,
+--                                     Target => Iir);
+
+--    function To_Iir (V : Integer) return Iir is
+--    begin
+--       return Int_Access_Type_To_Iir (Int_Access_Type (V));
+--    end To_Iir;
+
+--    function To_Integer (N : Iir) return Integer is
+--    begin
+--       return Integer (Iir_To_Int_Access_Type (N));
+--    end To_Integer;
+
+   procedure Set_Pos_Line_Off (Design_Unit: Iir_Design_Unit;
+                               Pos : Source_Ptr; Line, Off: Natural) is
+   begin
+      Set_Field1 (Design_Unit, Node_Type (Pos));
+      Set_Field11 (Design_Unit, Node_Type (Off));
+      Set_Field12 (Design_Unit, Node_Type (Line));
+   end Set_Pos_Line_Off;
+
+   procedure Get_Pos_Line_Off (Design_Unit: Iir_Design_Unit;
+                               Pos : out Source_Ptr; Line, Off: out Natural) is
+   begin
+      Pos := Source_Ptr (Get_Field1 (Design_Unit));
+      Off := Natural (Get_Field11 (Design_Unit));
+      Line := Natural (Get_Field12 (Design_Unit));
+   end Get_Pos_Line_Off;
+
+   -----------
+   -- Lists --
+   -----------
+   --  Layout of lists:
+   --  A list is stored into an IIR.
+   --  There are two bounds for a list:
+   --    the current number of elements
+   --    the maximum number of elements.
+   --  Using a maximum number of element bound (which can be increased) avoid
+   --  to reallocating memory at each insertion.
+
+   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_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);
+
+   --  Subprograms
+   function Get_Format (Kind : Iir_Kind) return Format_Type is
+   begin
+      case Kind is
+         when Iir_Kind_Error
+           | Iir_Kind_Library_Clause
+           | Iir_Kind_Use_Clause
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Null_Literal
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Simple_Aggregate
+           | Iir_Kind_Proxy
+           | 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_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_Signature
+           | Iir_Kind_Aggregate_Info
+           | Iir_Kind_Procedure_Call
+           | Iir_Kind_Operator_Symbol
+           | 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_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_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Range_Expression
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Subtype_Definition
+           | Iir_Kind_Overload_List
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Configuration_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_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_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_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_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_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_Simple_Name
+           | 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_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_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_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_Attribute_Specification
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Declaration
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_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 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;
+
+   procedure Check_Kind_For_First_Design_Unit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File =>
+            null;
+         when others =>
+            Failed ("First_Design_Unit", Target);
+      end case;
+   end Check_Kind_For_First_Design_Unit;
+
+   function Get_First_Design_Unit (Design : Iir) return Iir is
+   begin
+      Check_Kind_For_First_Design_Unit (Design);
+      return Get_Field5 (Design);
+   end Get_First_Design_Unit;
+
+   procedure Set_First_Design_Unit (Design : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_First_Design_Unit (Design);
+      Set_Field5 (Design, Chain);
+   end Set_First_Design_Unit;
+
+   procedure Check_Kind_For_Last_Design_Unit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File =>
+            null;
+         when others =>
+            Failed ("Last_Design_Unit", Target);
+      end case;
+   end Check_Kind_For_Last_Design_Unit;
+
+   function Get_Last_Design_Unit (Design : Iir) return Iir is
+   begin
+      Check_Kind_For_Last_Design_Unit (Design);
+      return Get_Field6 (Design);
+   end Get_Last_Design_Unit;
+
+   procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Last_Design_Unit (Design);
+      Set_Field6 (Design, Chain);
+   end Set_Last_Design_Unit;
+
+   procedure Check_Kind_For_Library_Declaration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Library_Clause =>
+            null;
+         when others =>
+            Failed ("Library_Declaration", Target);
+      end case;
+   end Check_Kind_For_Library_Declaration;
+
+   function Get_Library_Declaration (Design : Iir) return Iir is
+   begin
+      Check_Kind_For_Library_Declaration (Design);
+      return Get_Field1 (Design);
+   end Get_Library_Declaration;
+
+   procedure Set_Library_Declaration (Design : Iir; Library : Iir) is
+   begin
+      Check_Kind_For_Library_Declaration (Design);
+      Set_Field1 (Design, Library);
+   end Set_Library_Declaration;
+
+   procedure Check_Kind_For_File_Time_Stamp (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File =>
+            null;
+         when others =>
+            Failed ("File_Time_Stamp", Target);
+      end case;
+   end Check_Kind_For_File_Time_Stamp;
+
+   function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id is
+   begin
+      Check_Kind_For_File_Time_Stamp (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
+      Check_Kind_For_File_Time_Stamp (Design);
+      Set_Field4 (Design, Time_Stamp_Id_To_Iir (Stamp));
+   end Set_File_Time_Stamp;
+
+   procedure Check_Kind_For_Analysis_Time_Stamp (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File =>
+            null;
+         when others =>
+            Failed ("Analysis_Time_Stamp", Target);
+      end case;
+   end Check_Kind_For_Analysis_Time_Stamp;
+
+   function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id is
+   begin
+      Check_Kind_For_Analysis_Time_Stamp (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
+      Check_Kind_For_Analysis_Time_Stamp (Design);
+      Set_Field3 (Design, Time_Stamp_Id_To_Iir (Stamp));
+   end Set_Analysis_Time_Stamp;
+
+   procedure Check_Kind_For_Library (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File =>
+            null;
+         when others =>
+            Failed ("Library", Target);
+      end case;
+   end Check_Kind_For_Library;
+
+   function Get_Library (File : Iir_Design_File) return Iir is
+   begin
+      Check_Kind_For_Library (File);
+      return Get_Field0 (File);
+   end Get_Library;
+
+   procedure Set_Library (File : Iir_Design_File; Lib : Iir) is
+   begin
+      Check_Kind_For_Library (File);
+      Set_Field0 (File, Lib);
+   end Set_Library;
+
+   procedure Check_Kind_For_File_Dependence_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File =>
+            null;
+         when others =>
+            Failed ("File_Dependence_List", Target);
+      end case;
+   end Check_Kind_For_File_Dependence_List;
+
+   function Get_File_Dependence_List (File : Iir_Design_File) return Iir_List
+      is
+   begin
+      Check_Kind_For_File_Dependence_List (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
+      Check_Kind_For_File_Dependence_List (File);
+      Set_Field1 (File, Iir_List_To_Iir (Lst));
+   end Set_File_Dependence_List;
+
+   procedure Check_Kind_For_Design_File_Filename (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File =>
+            null;
+         when others =>
+            Failed ("Design_File_Filename", Target);
+      end case;
+   end Check_Kind_For_Design_File_Filename;
+
+   function Get_Design_File_Filename (File : Iir_Design_File) return Name_Id
+      is
+   begin
+      Check_Kind_For_Design_File_Filename (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
+      Check_Kind_For_Design_File_Filename (File);
+      Set_Field12 (File, Name_Id'Pos (Name));
+   end Set_Design_File_Filename;
+
+   procedure Check_Kind_For_Design_File_Directory (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File =>
+            null;
+         when others =>
+            Failed ("Design_File_Directory", Target);
+      end case;
+   end Check_Kind_For_Design_File_Directory;
+
+   function Get_Design_File_Directory (File : Iir_Design_File) return Name_Id
+      is
+   begin
+      Check_Kind_For_Design_File_Directory (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
+      Check_Kind_For_Design_File_Directory (File);
+      Set_Field11 (File, Name_Id'Pos (Dir));
+   end Set_Design_File_Directory;
+
+   procedure Check_Kind_For_Design_File (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("Design_File", Target);
+      end case;
+   end Check_Kind_For_Design_File;
+
+   function Get_Design_File (Unit : Iir_Design_Unit) return Iir_Design_File is
+   begin
+      Check_Kind_For_Design_File (Unit);
+      return Get_Field0 (Unit);
+   end Get_Design_File;
+
+   procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir_Design_File)
+      is
+   begin
+      Check_Kind_For_Design_File (Unit);
+      Set_Field0 (Unit, File);
+   end Set_Design_File;
+
+   procedure Check_Kind_For_Design_File_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Library_Declaration =>
+            null;
+         when others =>
+            Failed ("Design_File_Chain", Target);
+      end case;
+   end Check_Kind_For_Design_File_Chain;
+
+   function Get_Design_File_Chain (Library : Iir) return Iir_Design_File is
+   begin
+      Check_Kind_For_Design_File_Chain (Library);
+      return Get_Field1 (Library);
+   end Get_Design_File_Chain;
+
+   procedure Set_Design_File_Chain (Library : Iir; Chain : Iir_Design_File) is
+   begin
+      Check_Kind_For_Design_File_Chain (Library);
+      Set_Field1 (Library, Chain);
+   end Set_Design_File_Chain;
+
+   procedure Check_Kind_For_Library_Directory (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Library_Declaration =>
+            null;
+         when others =>
+            Failed ("Library_Directory", Target);
+      end case;
+   end Check_Kind_For_Library_Directory;
+
+   function Get_Library_Directory (Library : Iir) return Name_Id is
+   begin
+      Check_Kind_For_Library_Directory (Library);
+      return Name_Id'Val (Get_Field11 (Library));
+   end Get_Library_Directory;
+
+   procedure Set_Library_Directory (Library : Iir; Dir : Name_Id) is
+   begin
+      Check_Kind_For_Library_Directory (Library);
+      Set_Field11 (Library, Name_Id'Pos (Dir));
+   end Set_Library_Directory;
+
+   procedure Check_Kind_For_Date (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit
+           | Iir_Kind_Library_Declaration =>
+            null;
+         when others =>
+            Failed ("Date", Target);
+      end case;
+   end Check_Kind_For_Date;
+
+   function Get_Date (Target : Iir) return Date_Type is
+   begin
+      Check_Kind_For_Date (Target);
+      return Date_Type'Val (Get_Field10 (Target));
+   end Get_Date;
+
+   procedure Set_Date (Target : Iir; Date : Date_Type) is
+   begin
+      Check_Kind_For_Date (Target);
+      Set_Field10 (Target, Date_Type'Pos (Date));
+   end Set_Date;
+
+   procedure Check_Kind_For_Context_Items (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("Context_Items", Target);
+      end case;
+   end Check_Kind_For_Context_Items;
+
+   function Get_Context_Items (Design_Unit : Iir) return Iir is
+   begin
+      Check_Kind_For_Context_Items (Design_Unit);
+      return Get_Field1 (Design_Unit);
+   end Get_Context_Items;
+
+   procedure Set_Context_Items (Design_Unit : Iir; Items_Chain : Iir) is
+   begin
+      Check_Kind_For_Context_Items (Design_Unit);
+      Set_Field1 (Design_Unit, Items_Chain);
+   end Set_Context_Items;
+
+   procedure Check_Kind_For_Dependence_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("Dependence_List", Target);
+      end case;
+   end Check_Kind_For_Dependence_List;
+
+   function Get_Dependence_List (Unit : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Dependence_List (Unit);
+      return Iir_To_Iir_List (Get_Field8 (Unit));
+   end Get_Dependence_List;
+
+   procedure Set_Dependence_List (Unit : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Dependence_List (Unit);
+      Set_Field8 (Unit, Iir_List_To_Iir (List));
+   end Set_Dependence_List;
+
+   procedure Check_Kind_For_Analysis_Checks_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("Analysis_Checks_List", Target);
+      end case;
+   end Check_Kind_For_Analysis_Checks_List;
+
+   function Get_Analysis_Checks_List (Unit : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Analysis_Checks_List (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
+      Check_Kind_For_Analysis_Checks_List (Unit);
+      Set_Field9 (Unit, Iir_List_To_Iir (List));
+   end Set_Analysis_Checks_List;
+
+   procedure Check_Kind_For_Date_State (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("Date_State", Target);
+      end case;
+   end Check_Kind_For_Date_State;
+
+   function Get_Date_State (Unit : Iir_Design_Unit) return Date_State_Type is
+   begin
+      Check_Kind_For_Date_State (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
+      Check_Kind_For_Date_State (Unit);
+      Set_State1 (Unit, Date_State_Type'Pos (State));
+   end Set_Date_State;
+
+   procedure Check_Kind_For_Guarded_Target_State (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Signal_Assignment_Statement =>
+            null;
+         when others =>
+            Failed ("Guarded_Target_State", Target);
+      end case;
+   end Check_Kind_For_Guarded_Target_State;
+
+   function Get_Guarded_Target_State (Stmt : Iir) return Tri_State_Type is
+   begin
+      Check_Kind_For_Guarded_Target_State (Stmt);
+      return Tri_State_Type'Val (Get_State4 (Stmt));
+   end Get_Guarded_Target_State;
+
+   procedure Set_Guarded_Target_State (Stmt : Iir; State : Tri_State_Type) is
+   begin
+      Check_Kind_For_Guarded_Target_State (Stmt);
+      Set_State4 (Stmt, Tri_State_Type'Pos (State));
+   end Set_Guarded_Target_State;
+
+   procedure Check_Kind_For_Library_Unit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("Library_Unit", Target);
+      end case;
+   end Check_Kind_For_Library_Unit;
+
+   function Get_Library_Unit (Design_Unit : Iir_Design_Unit) return Iir is
+   begin
+      Check_Kind_For_Library_Unit (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
+      Check_Kind_For_Library_Unit (Design_Unit);
+      Set_Field5 (Design_Unit, Lib_Unit);
+   end Set_Library_Unit;
+
+   procedure Check_Kind_For_Hash_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("Hash_Chain", Target);
+      end case;
+   end Check_Kind_For_Hash_Chain;
+
+   function Get_Hash_Chain (Design_Unit : Iir_Design_Unit) return Iir is
+   begin
+      Check_Kind_For_Hash_Chain (Design_Unit);
+      return Get_Field7 (Design_Unit);
+   end Get_Hash_Chain;
+
+   procedure Set_Hash_Chain (Design_Unit : Iir_Design_Unit; Chain : Iir) is
+   begin
+      Check_Kind_For_Hash_Chain (Design_Unit);
+      Set_Field7 (Design_Unit, Chain);
+   end Set_Hash_Chain;
+
+   procedure Check_Kind_For_Value (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Integer_Literal
+           | Iir_Kind_Physical_Int_Literal =>
+            null;
+         when others =>
+            Failed ("Value", Target);
+      end case;
+   end Check_Kind_For_Value;
+
+   function Get_Value (Lit : Iir) return Iir_Int64 is
+   begin
+      Check_Kind_For_Value (Lit);
+      return Get_Int64 (Lit);
+   end Get_Value;
+
+   procedure Set_Value (Lit : Iir; Val : Iir_Int64) is
+   begin
+      Check_Kind_For_Value (Lit);
+      Set_Int64 (Lit, Val);
+   end Set_Value;
+
+   procedure Check_Kind_For_Enum_Pos (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Enumeration_Literal =>
+            null;
+         when others =>
+            Failed ("Enum_Pos", Target);
+      end case;
+   end Check_Kind_For_Enum_Pos;
+
+   function Get_Enum_Pos (Lit : Iir) return Iir_Int32 is
+   begin
+      Check_Kind_For_Enum_Pos (Lit);
+      return Iir_Int32'Val (Get_Field10 (Lit));
+   end Get_Enum_Pos;
+
+   procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32) is
+   begin
+      Check_Kind_For_Enum_Pos (Lit);
+      Set_Field10 (Lit, Iir_Int32'Pos (Val));
+   end Set_Enum_Pos;
+
+   procedure Check_Kind_For_Physical_Literal (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Unit_Declaration =>
+            null;
+         when others =>
+            Failed ("Physical_Literal", Target);
+      end case;
+   end Check_Kind_For_Physical_Literal;
+
+   function Get_Physical_Literal (Unit : Iir) return Iir is
+   begin
+      Check_Kind_For_Physical_Literal (Unit);
+      return Get_Field6 (Unit);
+   end Get_Physical_Literal;
+
+   procedure Set_Physical_Literal (Unit : Iir; Lit : Iir) is
+   begin
+      Check_Kind_For_Physical_Literal (Unit);
+      Set_Field6 (Unit, Lit);
+   end Set_Physical_Literal;
+
+   procedure Check_Kind_For_Physical_Unit_Value (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Unit_Declaration =>
+            null;
+         when others =>
+            Failed ("Physical_Unit_Value", Target);
+      end case;
+   end Check_Kind_For_Physical_Unit_Value;
+
+   function Get_Physical_Unit_Value (Unit : Iir) return Iir is
+   begin
+      Check_Kind_For_Physical_Unit_Value (Unit);
+      return Get_Field7 (Unit);
+   end Get_Physical_Unit_Value;
+
+   procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir) is
+   begin
+      Check_Kind_For_Physical_Unit_Value (Unit);
+      Set_Field7 (Unit, Lit);
+   end Set_Physical_Unit_Value;
+
+   procedure Check_Kind_For_Fp_Value (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Floating_Point_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            null;
+         when others =>
+            Failed ("Fp_Value", Target);
+      end case;
+   end Check_Kind_For_Fp_Value;
+
+   function Get_Fp_Value (Lit : Iir) return Iir_Fp64 is
+   begin
+      Check_Kind_For_Fp_Value (Lit);
+      return Get_Fp64 (Lit);
+   end Get_Fp_Value;
+
+   procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64) is
+   begin
+      Check_Kind_For_Fp_Value (Lit);
+      Set_Fp64 (Lit, Val);
+   end Set_Fp_Value;
+
+   procedure Check_Kind_For_Enumeration_Decl (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Enumeration_Literal =>
+            null;
+         when others =>
+            Failed ("Enumeration_Decl", Target);
+      end case;
+   end Check_Kind_For_Enumeration_Decl;
+
+   function Get_Enumeration_Decl (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Enumeration_Decl (Target);
+      return Get_Field6 (Target);
+   end Get_Enumeration_Decl;
+
+   procedure Set_Enumeration_Decl (Target : Iir; Lit : Iir) is
+   begin
+      Check_Kind_For_Enumeration_Decl (Target);
+      Set_Field6 (Target, Lit);
+   end Set_Enumeration_Decl;
+
+   procedure Check_Kind_For_Simple_Aggregate_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Simple_Aggregate =>
+            null;
+         when others =>
+            Failed ("Simple_Aggregate_List", Target);
+      end case;
+   end Check_Kind_For_Simple_Aggregate_List;
+
+   function Get_Simple_Aggregate_List (Target : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Simple_Aggregate_List (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
+      Check_Kind_For_Simple_Aggregate_List (Target);
+      Set_Field3 (Target, Iir_List_To_Iir (List));
+   end Set_Simple_Aggregate_List;
+
+   procedure Check_Kind_For_Bit_String_Base (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Bit_String_Literal =>
+            null;
+         when others =>
+            Failed ("Bit_String_Base", Target);
+      end case;
+   end Check_Kind_For_Bit_String_Base;
+
+   function Get_Bit_String_Base (Lit : Iir) return Base_Type is
+   begin
+      Check_Kind_For_Bit_String_Base (Lit);
+      return Base_Type'Val (Get_Field11 (Lit));
+   end Get_Bit_String_Base;
+
+   procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type) is
+   begin
+      Check_Kind_For_Bit_String_Base (Lit);
+      Set_Field11 (Lit, Base_Type'Pos (Base));
+   end Set_Bit_String_Base;
+
+   procedure Check_Kind_For_Bit_String_0 (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Bit_String_Literal =>
+            null;
+         when others =>
+            Failed ("Bit_String_0", Target);
+      end case;
+   end Check_Kind_For_Bit_String_0;
+
+   function Get_Bit_String_0 (Lit : Iir) return Iir_Enumeration_Literal is
+   begin
+      Check_Kind_For_Bit_String_0 (Lit);
+      return Get_Field4 (Lit);
+   end Get_Bit_String_0;
+
+   procedure Set_Bit_String_0 (Lit : Iir; El : Iir_Enumeration_Literal) is
+   begin
+      Check_Kind_For_Bit_String_0 (Lit);
+      Set_Field4 (Lit, El);
+   end Set_Bit_String_0;
+
+   procedure Check_Kind_For_Bit_String_1 (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Bit_String_Literal =>
+            null;
+         when others =>
+            Failed ("Bit_String_1", Target);
+      end case;
+   end Check_Kind_For_Bit_String_1;
+
+   function Get_Bit_String_1 (Lit : Iir) return Iir_Enumeration_Literal is
+   begin
+      Check_Kind_For_Bit_String_1 (Lit);
+      return Get_Field5 (Lit);
+   end Get_Bit_String_1;
+
+   procedure Set_Bit_String_1 (Lit : Iir; El : Iir_Enumeration_Literal) is
+   begin
+      Check_Kind_For_Bit_String_1 (Lit);
+      Set_Field5 (Lit, El);
+   end Set_Bit_String_1;
+
+   procedure Check_Kind_For_Literal_Origin (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Enumeration_Literal =>
+            null;
+         when others =>
+            Failed ("Literal_Origin", Target);
+      end case;
+   end Check_Kind_For_Literal_Origin;
+
+   function Get_Literal_Origin (Lit : Iir) return Iir is
+   begin
+      Check_Kind_For_Literal_Origin (Lit);
+      return Get_Field2 (Lit);
+   end Get_Literal_Origin;
+
+   procedure Set_Literal_Origin (Lit : Iir; Orig : Iir) is
+   begin
+      Check_Kind_For_Literal_Origin (Lit);
+      Set_Field2 (Lit, Orig);
+   end Set_Literal_Origin;
+
+   procedure Check_Kind_For_Proxy (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Proxy =>
+            null;
+         when others =>
+            Failed ("Proxy", Target);
+      end case;
+   end Check_Kind_For_Proxy;
+
+   function Get_Proxy (Target : Iir_Proxy) return Iir is
+   begin
+      Check_Kind_For_Proxy (Target);
+      return Get_Field1 (Target);
+   end Get_Proxy;
+
+   procedure Set_Proxy (Target : Iir_Proxy; Proxy : Iir) is
+   begin
+      Check_Kind_For_Proxy (Target);
+      Set_Field1 (Target, Proxy);
+   end Set_Proxy;
+
+   procedure Check_Kind_For_Entity_Class (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Entity_Class
+           | Iir_Kind_Attribute_Specification =>
+            null;
+         when others =>
+            Failed ("Entity_Class", Target);
+      end case;
+   end Check_Kind_For_Entity_Class;
+
+   function Get_Entity_Class (Target : Iir) return Token_Type is
+   begin
+      Check_Kind_For_Entity_Class (Target);
+      return Iir_To_Token_Type (Get_Field3 (Target));
+   end Get_Entity_Class;
+
+   procedure Set_Entity_Class (Target : Iir; Kind : Token_Type) is
+   begin
+      Check_Kind_For_Entity_Class (Target);
+      Set_Field3 (Target, Token_Type_To_Iir (Kind));
+   end Set_Entity_Class;
+
+   procedure Check_Kind_For_Entity_Name_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Specification =>
+            null;
+         when others =>
+            Failed ("Entity_Name_List", Target);
+      end case;
+   end Check_Kind_For_Entity_Name_List;
+
+   function Get_Entity_Name_List (Target : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Entity_Name_List (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
+      Check_Kind_For_Entity_Name_List (Target);
+      Set_Field1 (Target, Iir_List_To_Iir (Names));
+   end Set_Entity_Name_List;
+
+   procedure Check_Kind_For_Attribute_Designator (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Specification =>
+            null;
+         when others =>
+            Failed ("Attribute_Designator", Target);
+      end case;
+   end Check_Kind_For_Attribute_Designator;
+
+   function Get_Attribute_Designator (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Attribute_Designator (Target);
+      return Get_Field6 (Target);
+   end Get_Attribute_Designator;
+
+   procedure Set_Attribute_Designator (Target : Iir; Designator : Iir) is
+   begin
+      Check_Kind_For_Attribute_Designator (Target);
+      Set_Field6 (Target, Designator);
+   end Set_Attribute_Designator;
+
+   procedure Check_Kind_For_Attribute_Specification_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Specification =>
+            null;
+         when others =>
+            Failed ("Attribute_Specification_Chain", Target);
+      end case;
+   end Check_Kind_For_Attribute_Specification_Chain;
+
+   function Get_Attribute_Specification_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Attribute_Specification_Chain (Target);
+      return Get_Field7 (Target);
+   end Get_Attribute_Specification_Chain;
+
+   procedure Set_Attribute_Specification_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Attribute_Specification_Chain (Target);
+      Set_Field7 (Target, Chain);
+   end Set_Attribute_Specification_Chain;
+
+   procedure Check_Kind_For_Attribute_Specification (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Value =>
+            null;
+         when others =>
+            Failed ("Attribute_Specification", Target);
+      end case;
+   end Check_Kind_For_Attribute_Specification;
+
+   function Get_Attribute_Specification (Val : Iir) return Iir is
+   begin
+      Check_Kind_For_Attribute_Specification (Val);
+      return Get_Field4 (Val);
+   end Get_Attribute_Specification;
+
+   procedure Set_Attribute_Specification (Val : Iir; Attr : Iir) is
+   begin
+      Check_Kind_For_Attribute_Specification (Val);
+      Set_Field4 (Val, Attr);
+   end Set_Attribute_Specification;
+
+   procedure Check_Kind_For_Signal_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Disconnection_Specification =>
+            null;
+         when others =>
+            Failed ("Signal_List", Target);
+      end case;
+   end Check_Kind_For_Signal_List;
+
+   function Get_Signal_List (Target : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Signal_List (Target);
+      return Iir_To_Iir_List (Get_Field4 (Target));
+   end Get_Signal_List;
+
+   procedure Set_Signal_List (Target : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Signal_List (Target);
+      Set_Field4 (Target, Iir_List_To_Iir (List));
+   end Set_Signal_List;
+
+   procedure Check_Kind_For_Designated_Entity (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Value =>
+            null;
+         when others =>
+            Failed ("Designated_Entity", Target);
+      end case;
+   end Check_Kind_For_Designated_Entity;
+
+   function Get_Designated_Entity (Val : Iir_Attribute_Value) return Iir is
+   begin
+      Check_Kind_For_Designated_Entity (Val);
+      return Get_Field3 (Val);
+   end Get_Designated_Entity;
+
+   procedure Set_Designated_Entity (Val : Iir_Attribute_Value; Entity : Iir)
+      is
+   begin
+      Check_Kind_For_Designated_Entity (Val);
+      Set_Field3 (Val, Entity);
+   end Set_Designated_Entity;
+
+   procedure Check_Kind_For_Formal (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open =>
+            null;
+         when others =>
+            Failed ("Formal", Target);
+      end case;
+   end Check_Kind_For_Formal;
+
+   function Get_Formal (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Formal (Target);
+      return Get_Field1 (Target);
+   end Get_Formal;
+
+   procedure Set_Formal (Target : Iir; Formal : Iir) is
+   begin
+      Check_Kind_For_Formal (Target);
+      Set_Field1 (Target, Formal);
+   end Set_Formal;
+
+   procedure Check_Kind_For_Actual (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_By_Expression =>
+            null;
+         when others =>
+            Failed ("Actual", Target);
+      end case;
+   end Check_Kind_For_Actual;
+
+   function Get_Actual (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Actual (Target);
+      return Get_Field3 (Target);
+   end Get_Actual;
+
+   procedure Set_Actual (Target : Iir; Actual : Iir) is
+   begin
+      Check_Kind_For_Actual (Target);
+      Set_Field3 (Target, Actual);
+   end Set_Actual;
+
+   procedure Check_Kind_For_In_Conversion (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_By_Expression =>
+            null;
+         when others =>
+            Failed ("In_Conversion", Target);
+      end case;
+   end Check_Kind_For_In_Conversion;
+
+   function Get_In_Conversion (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_In_Conversion (Target);
+      return Get_Field4 (Target);
+   end Get_In_Conversion;
+
+   procedure Set_In_Conversion (Target : Iir; Conv : Iir) is
+   begin
+      Check_Kind_For_In_Conversion (Target);
+      Set_Field4 (Target, Conv);
+   end Set_In_Conversion;
+
+   procedure Check_Kind_For_Out_Conversion (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_By_Expression =>
+            null;
+         when others =>
+            Failed ("Out_Conversion", Target);
+      end case;
+   end Check_Kind_For_Out_Conversion;
+
+   function Get_Out_Conversion (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Out_Conversion (Target);
+      return Get_Field5 (Target);
+   end Get_Out_Conversion;
+
+   procedure Set_Out_Conversion (Target : Iir; Conv : Iir) is
+   begin
+      Check_Kind_For_Out_Conversion (Target);
+      Set_Field5 (Target, Conv);
+   end Set_Out_Conversion;
+
+   procedure Check_Kind_For_Whole_Association_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open =>
+            null;
+         when others =>
+            Failed ("Whole_Association_Flag", Target);
+      end case;
+   end Check_Kind_For_Whole_Association_Flag;
+
+   function Get_Whole_Association_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Whole_Association_Flag (Target);
+      return Get_Flag1 (Target);
+   end Get_Whole_Association_Flag;
+
+   procedure Set_Whole_Association_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Whole_Association_Flag (Target);
+      Set_Flag1 (Target, Flag);
+   end Set_Whole_Association_Flag;
+
+   procedure Check_Kind_For_Collapse_Signal_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open =>
+            null;
+         when others =>
+            Failed ("Collapse_Signal_Flag", Target);
+      end case;
+   end Check_Kind_For_Collapse_Signal_Flag;
+
+   function Get_Collapse_Signal_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Collapse_Signal_Flag (Target);
+      return Get_Flag2 (Target);
+   end Get_Collapse_Signal_Flag;
+
+   procedure Set_Collapse_Signal_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Collapse_Signal_Flag (Target);
+      Set_Flag2 (Target, Flag);
+   end Set_Collapse_Signal_Flag;
+
+   procedure Check_Kind_For_Artificial_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_Open =>
+            null;
+         when others =>
+            Failed ("Artificial_Flag", Target);
+      end case;
+   end Check_Kind_For_Artificial_Flag;
+
+   function Get_Artificial_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Artificial_Flag (Target);
+      return Get_Flag3 (Target);
+   end Get_Artificial_Flag;
+
+   procedure Set_Artificial_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Artificial_Flag (Target);
+      Set_Flag3 (Target, Flag);
+   end Set_Artificial_Flag;
+
+   procedure Check_Kind_For_Open_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Signal_Interface_Declaration =>
+            null;
+         when others =>
+            Failed ("Open_Flag", Target);
+      end case;
+   end Check_Kind_For_Open_Flag;
+
+   function Get_Open_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Open_Flag (Target);
+      return Get_Flag3 (Target);
+   end Get_Open_Flag;
+
+   procedure Set_Open_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Open_Flag (Target);
+      Set_Flag3 (Target, Flag);
+   end Set_Open_Flag;
+
+   procedure Check_Kind_For_We_Value (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Waveform_Element =>
+            null;
+         when others =>
+            Failed ("We_Value", Target);
+      end case;
+   end Check_Kind_For_We_Value;
+
+   function Get_We_Value (We : Iir_Waveform_Element) return Iir is
+   begin
+      Check_Kind_For_We_Value (We);
+      return Get_Field1 (We);
+   end Get_We_Value;
+
+   procedure Set_We_Value (We : Iir_Waveform_Element; An_Iir : Iir) is
+   begin
+      Check_Kind_For_We_Value (We);
+      Set_Field1 (We, An_Iir);
+   end Set_We_Value;
+
+   procedure Check_Kind_For_Time (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Waveform_Element =>
+            null;
+         when others =>
+            Failed ("Time", Target);
+      end case;
+   end Check_Kind_For_Time;
+
+   function Get_Time (We : Iir_Waveform_Element) return Iir is
+   begin
+      Check_Kind_For_Time (We);
+      return Get_Field3 (We);
+   end Get_Time;
+
+   procedure Set_Time (We : Iir_Waveform_Element; An_Iir : Iir) is
+   begin
+      Check_Kind_For_Time (We);
+      Set_Field3 (We, An_Iir);
+   end Set_Time;
+
+   procedure Check_Kind_For_Associated (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Associated", Target);
+      end case;
+   end Check_Kind_For_Associated;
+
+   function Get_Associated (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Associated (Target);
+      return Get_Field1 (Target);
+   end Get_Associated;
+
+   procedure Set_Associated (Target : Iir; Associated : Iir) is
+   begin
+      Check_Kind_For_Associated (Target);
+      Set_Field1 (Target, Associated);
+   end Set_Associated;
+
+   procedure Check_Kind_For_Same_Alternative_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Same_Alternative_Flag", Target);
+      end case;
+   end Check_Kind_For_Same_Alternative_Flag;
+
+   function Get_Same_Alternative_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Same_Alternative_Flag (Target);
+      return Get_Flag1 (Target);
+   end Get_Same_Alternative_Flag;
+
+   procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean) is
+   begin
+      Check_Kind_For_Same_Alternative_Flag (Target);
+      Set_Flag1 (Target, Val);
+   end Set_Same_Alternative_Flag;
+
+   procedure Check_Kind_For_Architecture (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Entity_Aspect_Entity =>
+            null;
+         when others =>
+            Failed ("Architecture", Target);
+      end case;
+   end Check_Kind_For_Architecture;
+
+   function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir is
+   begin
+      Check_Kind_For_Architecture (Target);
+      return Get_Field2 (Target);
+   end Get_Architecture;
+
+   procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir)
+      is
+   begin
+      Check_Kind_For_Architecture (Target);
+      Set_Field2 (Target, Arch);
+   end Set_Architecture;
+
+   procedure Check_Kind_For_Block_Specification (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Configuration =>
+            null;
+         when others =>
+            Failed ("Block_Specification", Target);
+      end case;
+   end Check_Kind_For_Block_Specification;
+
+   function Get_Block_Specification (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Block_Specification (Target);
+      return Get_Field5 (Target);
+   end Get_Block_Specification;
+
+   procedure Set_Block_Specification (Target : Iir; Block : Iir) is
+   begin
+      Check_Kind_For_Block_Specification (Target);
+      Set_Field5 (Target, Block);
+   end Set_Block_Specification;
+
+   procedure Check_Kind_For_Prev_Block_Configuration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Configuration =>
+            null;
+         when others =>
+            Failed ("Prev_Block_Configuration", Target);
+      end case;
+   end Check_Kind_For_Prev_Block_Configuration;
+
+   function Get_Prev_Block_Configuration (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Prev_Block_Configuration (Target);
+      return Get_Field4 (Target);
+   end Get_Prev_Block_Configuration;
+
+   procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir) is
+   begin
+      Check_Kind_For_Prev_Block_Configuration (Target);
+      Set_Field4 (Target, Block);
+   end Set_Prev_Block_Configuration;
+
+   procedure Check_Kind_For_Configuration_Item_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Configuration =>
+            null;
+         when others =>
+            Failed ("Configuration_Item_Chain", Target);
+      end case;
+   end Check_Kind_For_Configuration_Item_Chain;
+
+   function Get_Configuration_Item_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Configuration_Item_Chain (Target);
+      return Get_Field3 (Target);
+   end Get_Configuration_Item_Chain;
+
+   procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Configuration_Item_Chain (Target);
+      Set_Field3 (Target, Chain);
+   end Set_Configuration_Item_Chain;
+
+   procedure Check_Kind_For_Attribute_Value_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_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 =>
+            null;
+         when others =>
+            Failed ("Attribute_Value_Chain", Target);
+      end case;
+   end Check_Kind_For_Attribute_Value_Chain;
+
+   function Get_Attribute_Value_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Attribute_Value_Chain (Target);
+      return Get_Field4 (Target);
+   end Get_Attribute_Value_Chain;
+
+   procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Attribute_Value_Chain (Target);
+      Set_Field4 (Target, Chain);
+   end Set_Attribute_Value_Chain;
+
+   procedure Check_Kind_For_Spec_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Value =>
+            null;
+         when others =>
+            Failed ("Spec_Chain", Target);
+      end case;
+   end Check_Kind_For_Spec_Chain;
+
+   function Get_Spec_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Spec_Chain (Target);
+      return Get_Field0 (Target);
+   end Get_Spec_Chain;
+
+   procedure Set_Spec_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Spec_Chain (Target);
+      Set_Field0 (Target, Chain);
+   end Set_Spec_Chain;
+
+   procedure Check_Kind_For_Attribute_Value_Spec_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Specification =>
+            null;
+         when others =>
+            Failed ("Attribute_Value_Spec_Chain", Target);
+      end case;
+   end Check_Kind_For_Attribute_Value_Spec_Chain;
+
+   function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Attribute_Value_Spec_Chain (Target);
+      return Get_Field4 (Target);
+   end Get_Attribute_Value_Spec_Chain;
+
+   procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Attribute_Value_Spec_Chain (Target);
+      Set_Field4 (Target, Chain);
+   end Set_Attribute_Value_Spec_Chain;
+
+   procedure Check_Kind_For_Entity (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Entity_Aspect_Entity
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Architecture_Declaration =>
+            null;
+         when others =>
+            Failed ("Entity", Target);
+      end case;
+   end Check_Kind_For_Entity;
+
+   function Get_Entity (Decl : Iir) return Iir is
+   begin
+      Check_Kind_For_Entity (Decl);
+      return Get_Field4 (Decl);
+   end Get_Entity;
+
+   procedure Set_Entity (Decl : Iir; Entity : Iir) is
+   begin
+      Check_Kind_For_Entity (Decl);
+      Set_Field4 (Decl, Entity);
+   end Set_Entity;
+
+   procedure Check_Kind_For_Package (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Package_Body =>
+            null;
+         when others =>
+            Failed ("Package", Target);
+      end case;
+   end Check_Kind_For_Package;
+
+   function Get_Package (Package_Body : Iir) return Iir_Package_Declaration is
+   begin
+      Check_Kind_For_Package (Package_Body);
+      return Get_Field4 (Package_Body);
+   end Get_Package;
+
+   procedure Set_Package (Package_Body : Iir; Decl : Iir_Package_Declaration)
+      is
+   begin
+      Check_Kind_For_Package (Package_Body);
+      Set_Field4 (Package_Body, Decl);
+   end Set_Package;
+
+   procedure Check_Kind_For_Package_Body (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Package_Declaration =>
+            null;
+         when others =>
+            Failed ("Package_Body", Target);
+      end case;
+   end Check_Kind_For_Package_Body;
+
+   function Get_Package_Body (Pkg : Iir) return Iir_Package_Body is
+   begin
+      Check_Kind_For_Package_Body (Pkg);
+      return Get_Field4 (Pkg);
+   end Get_Package_Body;
+
+   procedure Set_Package_Body (Pkg : Iir; Decl : Iir_Package_Body) is
+   begin
+      Check_Kind_For_Package_Body (Pkg);
+      Set_Field4 (Pkg, Decl);
+   end Set_Package_Body;
+
+   procedure Check_Kind_For_Need_Body (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Package_Declaration =>
+            null;
+         when others =>
+            Failed ("Need_Body", Target);
+      end case;
+   end Check_Kind_For_Need_Body;
+
+   function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean is
+   begin
+      Check_Kind_For_Need_Body (Decl);
+      return Get_Flag1 (Decl);
+   end Get_Need_Body;
+
+   procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean) is
+   begin
+      Check_Kind_For_Need_Body (Decl);
+      Set_Flag1 (Decl, Flag);
+   end Set_Need_Body;
+
+   procedure Check_Kind_For_Block_Configuration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Component_Configuration
+           | Iir_Kind_Configuration_Declaration =>
+            null;
+         when others =>
+            Failed ("Block_Configuration", Target);
+      end case;
+   end Check_Kind_For_Block_Configuration;
+
+   function Get_Block_Configuration (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Block_Configuration (Target);
+      return Get_Field5 (Target);
+   end Get_Block_Configuration;
+
+   procedure Set_Block_Configuration (Target : Iir; Block : Iir) is
+   begin
+      Check_Kind_For_Block_Configuration (Target);
+      Set_Field5 (Target, Block);
+   end Set_Block_Configuration;
+
+   procedure Check_Kind_For_Concurrent_Statement_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Declaration
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            null;
+         when others =>
+            Failed ("Concurrent_Statement_Chain", Target);
+      end case;
+   end Check_Kind_For_Concurrent_Statement_Chain;
+
+   function Get_Concurrent_Statement_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Concurrent_Statement_Chain (Target);
+      return Get_Field5 (Target);
+   end Get_Concurrent_Statement_Chain;
+
+   procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir) is
+   begin
+      Check_Kind_For_Concurrent_Statement_Chain (Target);
+      Set_Field5 (Target, First);
+   end Set_Concurrent_Statement_Chain;
+
+   procedure Check_Kind_For_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_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_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_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_Function_Body
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_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 =>
+            null;
+         when others =>
+            Failed ("Chain", Target);
+      end case;
+   end Check_Kind_For_Chain;
+
+   function Get_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Chain (Target);
+      return Get_Field2 (Target);
+   end Get_Chain;
+
+   procedure Set_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Chain (Target);
+      Set_Field2 (Target, Chain);
+   end Set_Chain;
+
+   procedure Check_Kind_For_Port_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Component_Declaration =>
+            null;
+         when others =>
+            Failed ("Port_Chain", Target);
+      end case;
+   end Check_Kind_For_Port_Chain;
+
+   function Get_Port_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Port_Chain (Target);
+      return Get_Field7 (Target);
+   end Get_Port_Chain;
+
+   procedure Set_Port_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Port_Chain (Target);
+      Set_Field7 (Target, Chain);
+   end Set_Port_Chain;
+
+   procedure Check_Kind_For_Generic_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Component_Declaration =>
+            null;
+         when others =>
+            Failed ("Generic_Chain", Target);
+      end case;
+   end Check_Kind_For_Generic_Chain;
+
+   function Get_Generic_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Generic_Chain (Target);
+      return Get_Field6 (Target);
+   end Get_Generic_Chain;
+
+   procedure Set_Generic_Chain (Target : Iir; Generics : Iir) is
+   begin
+      Check_Kind_For_Generic_Chain (Target);
+      Set_Field6 (Target, Generics);
+   end Set_Generic_Chain;
+
+   procedure Check_Kind_For_Type (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Error
+           | Iir_Kind_Character_Literal
+           | 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_Attribute_Value
+           | Iir_Kind_Disconnection_Specification
+           | Iir_Kind_Range_Expression
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration
+           | Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_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_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_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_Return_Statement
+           | Iir_Kind_Simple_Name
+           | 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_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_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_Attribute_Name =>
+            null;
+         when others =>
+            Failed ("Type", Target);
+      end case;
+   end Check_Kind_For_Type;
+
+   function Get_Type (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Type (Target);
+      return Get_Field1 (Target);
+   end Get_Type;
+
+   procedure Set_Type (Target : Iir; Atype : Iir) is
+   begin
+      Check_Kind_For_Type (Target);
+      Set_Field1 (Target, Atype);
+   end Set_Type;
+
+   procedure Check_Kind_For_Subtype_Definition (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            null;
+         when others =>
+            Failed ("Subtype_Definition", Target);
+      end case;
+   end Check_Kind_For_Subtype_Definition;
+
+   function Get_Subtype_Definition (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Subtype_Definition (Target);
+      return Get_Field4 (Target);
+   end Get_Subtype_Definition;
+
+   procedure Set_Subtype_Definition (Target : Iir; Def : Iir) is
+   begin
+      Check_Kind_For_Subtype_Definition (Target);
+      Set_Field4 (Target, Def);
+   end Set_Subtype_Definition;
+
+   procedure Check_Kind_For_Mode (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_File_Declaration
+           | Iir_Kind_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration =>
+            null;
+         when others =>
+            Failed ("Mode", Target);
+      end case;
+   end Check_Kind_For_Mode;
+
+   function Get_Mode (Target : Iir) return Iir_Mode is
+   begin
+      Check_Kind_For_Mode (Target);
+      return Iir_Mode'Val (Get_Odigit2 (Target));
+   end Get_Mode;
+
+   procedure Set_Mode (Target : Iir; Mode : Iir_Mode) is
+   begin
+      Check_Kind_For_Mode (Target);
+      Set_Odigit2 (Target, Iir_Mode'Pos (Mode));
+   end Set_Mode;
+
+   procedure Check_Kind_For_Signal_Kind (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Signal_Interface_Declaration =>
+            null;
+         when others =>
+            Failed ("Signal_Kind", Target);
+      end case;
+   end Check_Kind_For_Signal_Kind;
+
+   function Get_Signal_Kind (Target : Iir) return Iir_Signal_Kind is
+   begin
+      Check_Kind_For_Signal_Kind (Target);
+      return Iir_Signal_Kind'Val (Get_State4 (Target));
+   end Get_Signal_Kind;
+
+   procedure Set_Signal_Kind (Target : Iir; Signal_Kind : Iir_Signal_Kind) is
+   begin
+      Check_Kind_For_Signal_Kind (Target);
+      Set_State4 (Target, Iir_Signal_Kind'Pos (Signal_Kind));
+   end Set_Signal_Kind;
+
+   procedure Check_Kind_For_Base_Name (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Value
+           | 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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_Selected_By_All_Name
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            null;
+         when others =>
+            Failed ("Base_Name", Target);
+      end case;
+   end Check_Kind_For_Base_Name;
+
+   function Get_Base_Name (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Base_Name (Target);
+      return Get_Field5 (Target);
+   end Get_Base_Name;
+
+   procedure Set_Base_Name (Target : Iir; Name : Iir) is
+   begin
+      Check_Kind_For_Base_Name (Target);
+      Set_Field5 (Target, Name);
+   end Set_Base_Name;
+
+   procedure Check_Kind_For_Interface_Declaration_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            null;
+         when others =>
+            Failed ("Interface_Declaration_Chain", Target);
+      end case;
+   end Check_Kind_For_Interface_Declaration_Chain;
+
+   function Get_Interface_Declaration_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Interface_Declaration_Chain (Target);
+      return Get_Field5 (Target);
+   end Get_Interface_Declaration_Chain;
+
+   procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Interface_Declaration_Chain (Target);
+      Set_Field5 (Target, Chain);
+   end Set_Interface_Declaration_Chain;
+
+   procedure Check_Kind_For_Subprogram_Specification (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            null;
+         when others =>
+            Failed ("Subprogram_Specification", Target);
+      end case;
+   end Check_Kind_For_Subprogram_Specification;
+
+   function Get_Subprogram_Specification (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Subprogram_Specification (Target);
+      return Get_Field4 (Target);
+   end Get_Subprogram_Specification;
+
+   procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir) is
+   begin
+      Check_Kind_For_Subprogram_Specification (Target);
+      Set_Field4 (Target, Spec);
+   end Set_Subprogram_Specification;
+
+   procedure Check_Kind_For_Sequential_Statement_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Sequential_Statement_Chain", Target);
+      end case;
+   end Check_Kind_For_Sequential_Statement_Chain;
+
+   function Get_Sequential_Statement_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Sequential_Statement_Chain (Target);
+      return Get_Field5 (Target);
+   end Get_Sequential_Statement_Chain;
+
+   procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Sequential_Statement_Chain (Target);
+      Set_Field5 (Target, Chain);
+   end Set_Sequential_Statement_Chain;
+
+   procedure Check_Kind_For_Subprogram_Body (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            null;
+         when others =>
+            Failed ("Subprogram_Body", Target);
+      end case;
+   end Check_Kind_For_Subprogram_Body;
+
+   function Get_Subprogram_Body (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Subprogram_Body (Target);
+      return Get_Field6 (Target);
+   end Get_Subprogram_Body;
+
+   procedure Set_Subprogram_Body (Target : Iir; A_Body : Iir) is
+   begin
+      Check_Kind_For_Subprogram_Body (Target);
+      Set_Field6 (Target, A_Body);
+   end Set_Subprogram_Body;
+
+   procedure Check_Kind_For_Overload_Number (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            null;
+         when others =>
+            Failed ("Overload_Number", Target);
+      end case;
+   end Check_Kind_For_Overload_Number;
+
+   function Get_Overload_Number (Target : Iir) return Iir_Int32 is
+   begin
+      Check_Kind_For_Overload_Number (Target);
+      return Iir_Int32'Val (Get_Field9 (Target));
+   end Get_Overload_Number;
+
+   procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32) is
+   begin
+      Check_Kind_For_Overload_Number (Target);
+      Set_Field9 (Target, Iir_Int32'Pos (Val));
+   end Set_Overload_Number;
+
+   procedure Check_Kind_For_Subprogram_Depth (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            null;
+         when others =>
+            Failed ("Subprogram_Depth", Target);
+      end case;
+   end Check_Kind_For_Subprogram_Depth;
+
+   function Get_Subprogram_Depth (Target : Iir) return Iir_Int32 is
+   begin
+      Check_Kind_For_Subprogram_Depth (Target);
+      return Iir_Int32'Val (Get_Field10 (Target));
+   end Get_Subprogram_Depth;
+
+   procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32) is
+   begin
+      Check_Kind_For_Subprogram_Depth (Target);
+      Set_Field10 (Target, Iir_Int32'Pos (Depth));
+   end Set_Subprogram_Depth;
+
+   procedure Check_Kind_For_Subprogram_Hash (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Enumeration_Literal =>
+            null;
+         when others =>
+            Failed ("Subprogram_Hash", Target);
+      end case;
+   end Check_Kind_For_Subprogram_Hash;
+
+   function Get_Subprogram_Hash (Target : Iir) return Iir_Int32 is
+   begin
+      Check_Kind_For_Subprogram_Hash (Target);
+      return Iir_Int32'Val (Get_Field11 (Target));
+   end Get_Subprogram_Hash;
+
+   procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32) is
+   begin
+      Check_Kind_For_Subprogram_Hash (Target);
+      Set_Field11 (Target, Iir_Int32'Pos (Val));
+   end Set_Subprogram_Hash;
+
+   procedure Check_Kind_For_Extra_Info (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Extra_Info", Target);
+      end case;
+   end Check_Kind_For_Extra_Info;
+
+   function Get_Extra_Info (Target : Iir) return Iir_Int32 is
+   begin
+      Check_Kind_For_Extra_Info (Target);
+      return Iir_Int32'Val (Get_Field12 (Target));
+   end Get_Extra_Info;
+
+   procedure Set_Extra_Info (Target : Iir; Info : Iir_Int32) is
+   begin
+      Check_Kind_For_Extra_Info (Target);
+      Set_Field12 (Target, Iir_Int32'Pos (Info));
+   end Set_Extra_Info;
+
+   procedure Check_Kind_For_Impure_Depth (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            null;
+         when others =>
+            Failed ("Impure_Depth", Target);
+      end case;
+   end Check_Kind_For_Impure_Depth;
+
+   function Get_Impure_Depth (Target : Iir) return Iir_Int32 is
+   begin
+      Check_Kind_For_Impure_Depth (Target);
+      return Iir_To_Iir_Int32 (Get_Field3 (Target));
+   end Get_Impure_Depth;
+
+   procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32) is
+   begin
+      Check_Kind_For_Impure_Depth (Target);
+      Set_Field3 (Target, Iir_Int32_To_Iir (Depth));
+   end Set_Impure_Depth;
+
+   procedure Check_Kind_For_Return_Type (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Signature
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Enumeration_Literal =>
+            null;
+         when others =>
+            Failed ("Return_Type", Target);
+      end case;
+   end Check_Kind_For_Return_Type;
+
+   function Get_Return_Type (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Return_Type (Target);
+      return Get_Field1 (Target);
+   end Get_Return_Type;
+
+   procedure Set_Return_Type (Target : Iir; Decl : Iir) is
+   begin
+      Check_Kind_For_Return_Type (Target);
+      Set_Field1 (Target, Decl);
+   end Set_Return_Type;
+
+   procedure Check_Kind_For_Implicit_Definition (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            null;
+         when others =>
+            Failed ("Implicit_Definition", Target);
+      end case;
+   end Check_Kind_For_Implicit_Definition;
+
+   function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions
+      is
+   begin
+      Check_Kind_For_Implicit_Definition (D);
+      return Iir_Predefined_Functions'Val (Get_Field6 (D));
+   end Get_Implicit_Definition;
+
+   procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions)
+      is
+   begin
+      Check_Kind_For_Implicit_Definition (D);
+      Set_Field6 (D, Iir_Predefined_Functions'Pos (Def));
+   end Set_Implicit_Definition;
+
+   procedure Check_Kind_For_Type_Reference (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            null;
+         when others =>
+            Failed ("Type_Reference", Target);
+      end case;
+   end Check_Kind_For_Type_Reference;
+
+   function Get_Type_Reference (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Type_Reference (Target);
+      return Get_Field8 (Target);
+   end Get_Type_Reference;
+
+   procedure Set_Type_Reference (Target : Iir; Decl : Iir) is
+   begin
+      Check_Kind_For_Type_Reference (Target);
+      Set_Field8 (Target, Decl);
+   end Set_Type_Reference;
+
+   procedure Check_Kind_For_Default_Value (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration =>
+            null;
+         when others =>
+            Failed ("Default_Value", Target);
+      end case;
+   end Check_Kind_For_Default_Value;
+
+   function Get_Default_Value (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Default_Value (Target);
+      return Get_Field6 (Target);
+   end Get_Default_Value;
+
+   procedure Set_Default_Value (Target : Iir; Value : Iir) is
+   begin
+      Check_Kind_For_Default_Value (Target);
+      Set_Field6 (Target, Value);
+   end Set_Default_Value;
+
+   procedure Check_Kind_For_Deferred_Declaration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Constant_Declaration =>
+            null;
+         when others =>
+            Failed ("Deferred_Declaration", Target);
+      end case;
+   end Check_Kind_For_Deferred_Declaration;
+
+   function Get_Deferred_Declaration (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Deferred_Declaration (Target);
+      return Get_Field7 (Target);
+   end Get_Deferred_Declaration;
+
+   procedure Set_Deferred_Declaration (Target : Iir; Decl : Iir) is
+   begin
+      Check_Kind_For_Deferred_Declaration (Target);
+      Set_Field7 (Target, Decl);
+   end Set_Deferred_Declaration;
+
+   procedure Check_Kind_For_Deferred_Declaration_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Constant_Declaration =>
+            null;
+         when others =>
+            Failed ("Deferred_Declaration_Flag", Target);
+      end case;
+   end Check_Kind_For_Deferred_Declaration_Flag;
+
+   function Get_Deferred_Declaration_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Deferred_Declaration_Flag (Target);
+      return Get_Flag1 (Target);
+   end Get_Deferred_Declaration_Flag;
+
+   procedure Set_Deferred_Declaration_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Deferred_Declaration_Flag (Target);
+      Set_Flag1 (Target, Flag);
+   end Set_Deferred_Declaration_Flag;
+
+   procedure Check_Kind_For_Shared_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Variable_Declaration =>
+            null;
+         when others =>
+            Failed ("Shared_Flag", Target);
+      end case;
+   end Check_Kind_For_Shared_Flag;
+
+   function Get_Shared_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Shared_Flag (Target);
+      return Get_Flag2 (Target);
+   end Get_Shared_Flag;
+
+   procedure Set_Shared_Flag (Target : Iir; Shared : Boolean) is
+   begin
+      Check_Kind_For_Shared_Flag (Target);
+      Set_Flag2 (Target, Shared);
+   end Set_Shared_Flag;
+
+   procedure Check_Kind_For_Design_Unit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Architecture_Declaration =>
+            null;
+         when others =>
+            Failed ("Design_Unit", Target);
+      end case;
+   end Check_Kind_For_Design_Unit;
+
+   function Get_Design_Unit (Target : Iir) return Iir_Design_Unit is
+   begin
+      Check_Kind_For_Design_Unit (Target);
+      return Get_Field0 (Target);
+   end Get_Design_Unit;
+
+   procedure Set_Design_Unit (Target : Iir; Unit : Iir_Design_Unit) is
+   begin
+      Check_Kind_For_Design_Unit (Target);
+      Set_Field0 (Target, Unit);
+   end Set_Design_Unit;
+
+   procedure Check_Kind_For_Block_Statement (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Guard_Signal_Declaration =>
+            null;
+         when others =>
+            Failed ("Block_Statement", Target);
+      end case;
+   end Check_Kind_For_Block_Statement;
+
+   function Get_Block_Statement (Target : Iir) return Iir_Block_Statement is
+   begin
+      Check_Kind_For_Block_Statement (Target);
+      return Get_Field7 (Target);
+   end Get_Block_Statement;
+
+   procedure Set_Block_Statement (Target : Iir; Block : Iir_Block_Statement)
+      is
+   begin
+      Check_Kind_For_Block_Statement (Target);
+      Set_Field7 (Target, Block);
+   end Set_Block_Statement;
+
+   procedure Check_Kind_For_Signal_Driver (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Signal_Declaration =>
+            null;
+         when others =>
+            Failed ("Signal_Driver", Target);
+      end case;
+   end Check_Kind_For_Signal_Driver;
+
+   function Get_Signal_Driver (Target : Iir_Signal_Declaration) return Iir is
+   begin
+      Check_Kind_For_Signal_Driver (Target);
+      return Get_Field7 (Target);
+   end Get_Signal_Driver;
+
+   procedure Set_Signal_Driver (Target : Iir_Signal_Declaration; Driver : Iir)
+      is
+   begin
+      Check_Kind_For_Signal_Driver (Target);
+      Set_Field7 (Target, Driver);
+   end Set_Signal_Driver;
+
+   procedure Check_Kind_For_Declaration_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Configuration
+           | Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Architecture_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 =>
+            null;
+         when others =>
+            Failed ("Declaration_Chain", Target);
+      end case;
+   end Check_Kind_For_Declaration_Chain;
+
+   function Get_Declaration_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Declaration_Chain (Target);
+      return Get_Field1 (Target);
+   end Get_Declaration_Chain;
+
+   procedure Set_Declaration_Chain (Target : Iir; Decls : Iir) is
+   begin
+      Check_Kind_For_Declaration_Chain (Target);
+      Set_Field1 (Target, Decls);
+   end Set_Declaration_Chain;
+
+   procedure Check_Kind_For_File_Logical_Name (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_File_Declaration =>
+            null;
+         when others =>
+            Failed ("File_Logical_Name", Target);
+      end case;
+   end Check_Kind_For_File_Logical_Name;
+
+   function Get_File_Logical_Name (Target : Iir_File_Declaration) return Iir
+      is
+   begin
+      Check_Kind_For_File_Logical_Name (Target);
+      return Get_Field6 (Target);
+   end Get_File_Logical_Name;
+
+   procedure Set_File_Logical_Name (Target : Iir_File_Declaration; Name : Iir)
+      is
+   begin
+      Check_Kind_For_File_Logical_Name (Target);
+      Set_Field6 (Target, Name);
+   end Set_File_Logical_Name;
+
+   procedure Check_Kind_For_File_Open_Kind (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_File_Declaration =>
+            null;
+         when others =>
+            Failed ("File_Open_Kind", Target);
+      end case;
+   end Check_Kind_For_File_Open_Kind;
+
+   function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir is
+   begin
+      Check_Kind_For_File_Open_Kind (Target);
+      return Get_Field7 (Target);
+   end Get_File_Open_Kind;
+
+   procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir) is
+   begin
+      Check_Kind_For_File_Open_Kind (Target);
+      Set_Field7 (Target, Kind);
+   end Set_File_Open_Kind;
+
+   procedure Check_Kind_For_Element_Position (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Element_Declaration =>
+            null;
+         when others =>
+            Failed ("Element_Position", Target);
+      end case;
+   end Check_Kind_For_Element_Position;
+
+   function Get_Element_Position (Target : Iir) return Iir_Index32 is
+   begin
+      Check_Kind_For_Element_Position (Target);
+      return Iir_Index32'Val (Get_Field4 (Target));
+   end Get_Element_Position;
+
+   procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32) is
+   begin
+      Check_Kind_For_Element_Position (Target);
+      Set_Field4 (Target, Iir_Index32'Pos (Pos));
+   end Set_Element_Position;
+
+   procedure Check_Kind_For_Selected_Element (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Selected_Element =>
+            null;
+         when others =>
+            Failed ("Selected_Element", Target);
+      end case;
+   end Check_Kind_For_Selected_Element;
+
+   function Get_Selected_Element (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Selected_Element (Target);
+      return Get_Field2 (Target);
+   end Get_Selected_Element;
+
+   procedure Set_Selected_Element (Target : Iir; El : Iir) is
+   begin
+      Check_Kind_For_Selected_Element (Target);
+      Set_Field2 (Target, El);
+   end Set_Selected_Element;
+
+   procedure Check_Kind_For_Suffix_Identifier (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Selected_Name =>
+            null;
+         when others =>
+            Failed ("Suffix_Identifier", Target);
+      end case;
+   end Check_Kind_For_Suffix_Identifier;
+
+   function Get_Suffix_Identifier (Target : Iir) return Name_Id is
+   begin
+      Check_Kind_For_Suffix_Identifier (Target);
+      return Iir_To_Name_Id (Get_Field2 (Target));
+   end Get_Suffix_Identifier;
+
+   procedure Set_Suffix_Identifier (Target : Iir; Ident : Name_Id) is
+   begin
+      Check_Kind_For_Suffix_Identifier (Target);
+      Set_Field2 (Target, Name_Id_To_Iir (Ident));
+   end Set_Suffix_Identifier;
+
+   procedure Check_Kind_For_Attribute_Identifier (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Name =>
+            null;
+         when others =>
+            Failed ("Attribute_Identifier", Target);
+      end case;
+   end Check_Kind_For_Attribute_Identifier;
+
+   function Get_Attribute_Identifier (Target : Iir) return Name_Id is
+   begin
+      Check_Kind_For_Attribute_Identifier (Target);
+      return Iir_To_Name_Id (Get_Field2 (Target));
+   end Get_Attribute_Identifier;
+
+   procedure Set_Attribute_Identifier (Target : Iir; Ident : Name_Id) is
+   begin
+      Check_Kind_For_Attribute_Identifier (Target);
+      Set_Field2 (Target, Name_Id_To_Iir (Ident));
+   end Set_Attribute_Identifier;
+
+   procedure Check_Kind_For_Use_Clause_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Use_Clause =>
+            null;
+         when others =>
+            Failed ("Use_Clause_Chain", Target);
+      end case;
+   end Check_Kind_For_Use_Clause_Chain;
+
+   function Get_Use_Clause_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Use_Clause_Chain (Target);
+      return Get_Field3 (Target);
+   end Get_Use_Clause_Chain;
+
+   procedure Set_Use_Clause_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Use_Clause_Chain (Target);
+      Set_Field3 (Target, Chain);
+   end Set_Use_Clause_Chain;
+
+   procedure Check_Kind_For_Selected_Name (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Use_Clause =>
+            null;
+         when others =>
+            Failed ("Selected_Name", Target);
+      end case;
+   end Check_Kind_For_Selected_Name;
+
+   function Get_Selected_Name (Target : Iir_Use_Clause) return Iir is
+   begin
+      Check_Kind_For_Selected_Name (Target);
+      return Get_Field1 (Target);
+   end Get_Selected_Name;
+
+   procedure Set_Selected_Name (Target : Iir_Use_Clause; Name : Iir) is
+   begin
+      Check_Kind_For_Selected_Name (Target);
+      Set_Field1 (Target, Name);
+   end Set_Selected_Name;
+
+   procedure Check_Kind_For_Type_Declarator (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Unconstrained_Array_Subtype_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_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Type_Declarator", Target);
+      end case;
+   end Check_Kind_For_Type_Declarator;
+
+   function Get_Type_Declarator (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Type_Declarator (Target);
+      return Get_Field3 (Target);
+   end Get_Type_Declarator;
+
+   procedure Set_Type_Declarator (Target : Iir; Decl : Iir) is
+   begin
+      Check_Kind_For_Type_Declarator (Target);
+      Set_Field3 (Target, Decl);
+   end Set_Type_Declarator;
+
+   procedure Check_Kind_For_Enumeration_Literal_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Enumeration_Literal_List", Target);
+      end case;
+   end Check_Kind_For_Enumeration_Literal_List;
+
+   function Get_Enumeration_Literal_List (Target : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Enumeration_Literal_List (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
+      Check_Kind_For_Enumeration_Literal_List (Target);
+      Set_Field2 (Target, Iir_List_To_Iir (List));
+   end Set_Enumeration_Literal_List;
+
+   procedure Check_Kind_For_Entity_Class_Entry_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Group_Template_Declaration =>
+            null;
+         when others =>
+            Failed ("Entity_Class_Entry_Chain", Target);
+      end case;
+   end Check_Kind_For_Entity_Class_Entry_Chain;
+
+   function Get_Entity_Class_Entry_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Entity_Class_Entry_Chain (Target);
+      return Get_Field1 (Target);
+   end Get_Entity_Class_Entry_Chain;
+
+   procedure Set_Entity_Class_Entry_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Entity_Class_Entry_Chain (Target);
+      Set_Field1 (Target, Chain);
+   end Set_Entity_Class_Entry_Chain;
+
+   procedure Check_Kind_For_Group_Constituent_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Group_Declaration =>
+            null;
+         when others =>
+            Failed ("Group_Constituent_List", Target);
+      end case;
+   end Check_Kind_For_Group_Constituent_List;
+
+   function Get_Group_Constituent_List (Group : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Group_Constituent_List (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
+      Check_Kind_For_Group_Constituent_List (Group);
+      Set_Field1 (Group, Iir_List_To_Iir (List));
+   end Set_Group_Constituent_List;
+
+   procedure Check_Kind_For_Unit_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Physical_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Unit_Chain", Target);
+      end case;
+   end Check_Kind_For_Unit_Chain;
+
+   function Get_Unit_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Unit_Chain (Target);
+      return Get_Field1 (Target);
+   end Get_Unit_Chain;
+
+   procedure Set_Unit_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Unit_Chain (Target);
+      Set_Field1 (Target, Chain);
+   end Set_Unit_Chain;
+
+   procedure Check_Kind_For_Primary_Unit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Physical_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Primary_Unit", Target);
+      end case;
+   end Check_Kind_For_Primary_Unit;
+
+   function Get_Primary_Unit (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Primary_Unit (Target);
+      return Get_Field1 (Target);
+   end Get_Primary_Unit;
+
+   procedure Check_Kind_For_Identifier (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit
+           | Iir_Kind_Library_Clause
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Operator_Symbol
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Architecture_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_Element_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_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_Simple_Name =>
+            null;
+         when others =>
+            Failed ("Identifier", Target);
+      end case;
+   end Check_Kind_For_Identifier;
+
+   function Get_Identifier (Target : Iir) return Name_Id is
+   begin
+      Check_Kind_For_Identifier (Target);
+      return Iir_To_Name_Id (Get_Field3 (Target));
+   end Get_Identifier;
+
+   procedure Set_Identifier (Target : Iir; Identifier : Name_Id) is
+   begin
+      Check_Kind_For_Identifier (Target);
+      Set_Field3 (Target, Name_Id_To_Iir (Identifier));
+   end Set_Identifier;
+
+   procedure Check_Kind_For_Label (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_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 =>
+            null;
+         when others =>
+            Failed ("Label", Target);
+      end case;
+   end Check_Kind_For_Label;
+
+   function Get_Label (Target : Iir) return Name_Id is
+   begin
+      Check_Kind_For_Label (Target);
+      return Iir_To_Name_Id (Get_Field3 (Target));
+   end Get_Label;
+
+   procedure Set_Label (Target : Iir; Label : Name_Id) is
+   begin
+      Check_Kind_For_Label (Target);
+      Set_Field3 (Target, Name_Id_To_Iir (Label));
+   end Set_Label;
+
+   procedure Check_Kind_For_Visible_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_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_Element_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_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 =>
+            null;
+         when others =>
+            Failed ("Visible_Flag", Target);
+      end case;
+   end Check_Kind_For_Visible_Flag;
+
+   function Get_Visible_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Visible_Flag (Target);
+      return Get_Flag4 (Target);
+   end Get_Visible_Flag;
+
+   procedure Set_Visible_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Visible_Flag (Target);
+      Set_Flag4 (Target, Flag);
+   end Set_Visible_Flag;
+
+   procedure Check_Kind_For_Range_Constraint (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Range_Constraint", Target);
+      end case;
+   end Check_Kind_For_Range_Constraint;
+
+   function Get_Range_Constraint (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Range_Constraint (Target);
+      return Get_Field1 (Target);
+   end Get_Range_Constraint;
+
+   procedure Set_Range_Constraint (Target : Iir; Constraint : Iir) is
+   begin
+      Check_Kind_For_Range_Constraint (Target);
+      Set_Field1 (Target, Constraint);
+   end Set_Range_Constraint;
+
+   procedure Check_Kind_For_Direction (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Range_Expression =>
+            null;
+         when others =>
+            Failed ("Direction", Target);
+      end case;
+   end Check_Kind_For_Direction;
+
+   function Get_Direction (Decl : Iir) return Iir_Direction is
+   begin
+      Check_Kind_For_Direction (Decl);
+      return Iir_Direction'Val (Get_State2 (Decl));
+   end Get_Direction;
+
+   procedure Set_Direction (Decl : Iir; Dir : Iir_Direction) is
+   begin
+      Check_Kind_For_Direction (Decl);
+      Set_State2 (Decl, Iir_Direction'Pos (Dir));
+   end Set_Direction;
+
+   procedure Check_Kind_For_Left_Limit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Range_Expression =>
+            null;
+         when others =>
+            Failed ("Left_Limit", Target);
+      end case;
+   end Check_Kind_For_Left_Limit;
+
+   function Get_Left_Limit (Decl : Iir_Range_Expression) return Iir is
+   begin
+      Check_Kind_For_Left_Limit (Decl);
+      return Get_Field2 (Decl);
+   end Get_Left_Limit;
+
+   procedure Set_Left_Limit (Decl : Iir_Range_Expression; Limit : Iir) is
+   begin
+      Check_Kind_For_Left_Limit (Decl);
+      Set_Field2 (Decl, Limit);
+   end Set_Left_Limit;
+
+   procedure Check_Kind_For_Right_Limit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Range_Expression =>
+            null;
+         when others =>
+            Failed ("Right_Limit", Target);
+      end case;
+   end Check_Kind_For_Right_Limit;
+
+   function Get_Right_Limit (Decl : Iir_Range_Expression) return Iir is
+   begin
+      Check_Kind_For_Right_Limit (Decl);
+      return Get_Field3 (Decl);
+   end Get_Right_Limit;
+
+   procedure Set_Right_Limit (Decl : Iir_Range_Expression; Limit : Iir) is
+   begin
+      Check_Kind_For_Right_Limit (Decl);
+      Set_Field3 (Decl, Limit);
+   end Set_Right_Limit;
+
+   procedure Check_Kind_For_Base_Type (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Unconstrained_Array_Subtype_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_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Base_Type", Target);
+      end case;
+   end Check_Kind_For_Base_Type;
+
+   function Get_Base_Type (Decl : Iir) return Iir is
+   begin
+      Check_Kind_For_Base_Type (Decl);
+      return Get_Field4 (Decl);
+   end Get_Base_Type;
+
+   procedure Set_Base_Type (Decl : Iir; Base_Type : Iir) is
+   begin
+      Check_Kind_For_Base_Type (Decl);
+      Set_Field4 (Decl, Base_Type);
+   end Set_Base_Type;
+
+   procedure Check_Kind_For_Resolution_Function (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Unconstrained_Array_Subtype_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_Subtype_Definition =>
+            null;
+         when others =>
+            Failed ("Resolution_Function", Target);
+      end case;
+   end Check_Kind_For_Resolution_Function;
+
+   function Get_Resolution_Function (Decl : Iir) return Iir is
+   begin
+      Check_Kind_For_Resolution_Function (Decl);
+      return Get_Field5 (Decl);
+   end Get_Resolution_Function;
+
+   procedure Set_Resolution_Function (Decl : Iir; Func : Iir) is
+   begin
+      Check_Kind_For_Resolution_Function (Decl);
+      Set_Field5 (Decl, Func);
+   end Set_Resolution_Function;
+
+   procedure Check_Kind_For_Text_File_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_File_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Text_File_Flag", Target);
+      end case;
+   end Check_Kind_For_Text_File_Flag;
+
+   function Get_Text_File_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Text_File_Flag (Target);
+      return Get_Flag3 (Target);
+   end Get_Text_File_Flag;
+
+   procedure Set_Text_File_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Text_File_Flag (Target);
+      Set_Flag3 (Target, Flag);
+   end Set_Text_File_Flag;
+
+   procedure Check_Kind_For_Type_Staticness (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Unconstrained_Array_Subtype_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_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Type_Staticness", Target);
+      end case;
+   end Check_Kind_For_Type_Staticness;
+
+   function Get_Type_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      Check_Kind_For_Type_Staticness (Target);
+      return Iir_Staticness'Val (Get_State1 (Target));
+   end Get_Type_Staticness;
+
+   procedure Set_Type_Staticness (Target : Iir; Static : Iir_Staticness) is
+   begin
+      Check_Kind_For_Type_Staticness (Target);
+      Set_State1 (Target, Iir_Staticness'Pos (Static));
+   end Set_Type_Staticness;
+
+   procedure Check_Kind_For_Index_Subtype_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            null;
+         when others =>
+            Failed ("Index_Subtype_List", Target);
+      end case;
+   end Check_Kind_For_Index_Subtype_List;
+
+   function Get_Index_Subtype_List (Decl : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Index_Subtype_List (Decl);
+      return Iir_To_Iir_List (Get_Field6 (Decl));
+   end Get_Index_Subtype_List;
+
+   procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Index_Subtype_List (Decl);
+      Set_Field6 (Decl, Iir_List_To_Iir (List));
+   end Set_Index_Subtype_List;
+
+   procedure Check_Kind_For_Index_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Indexed_Name =>
+            null;
+         when others =>
+            Failed ("Index_List", Target);
+      end case;
+   end Check_Kind_For_Index_List;
+
+   function Get_Index_List (Decl : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Index_List (Decl);
+      return Iir_To_Iir_List (Get_Field2 (Decl));
+   end Get_Index_List;
+
+   procedure Set_Index_List (Decl : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Index_List (Decl);
+      Set_Field2 (Decl, Iir_List_To_Iir (List));
+   end Set_Index_List;
+
+   procedure Check_Kind_For_Element_Subtype (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            null;
+         when others =>
+            Failed ("Element_Subtype", Target);
+      end case;
+   end Check_Kind_For_Element_Subtype;
+
+   function Get_Element_Subtype (Decl : Iir) return Iir is
+   begin
+      Check_Kind_For_Element_Subtype (Decl);
+      return Get_Field1 (Decl);
+   end Get_Element_Subtype;
+
+   procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir) is
+   begin
+      Check_Kind_For_Element_Subtype (Decl);
+      Set_Field1 (Decl, Sub_Type);
+   end Set_Element_Subtype;
+
+   procedure Check_Kind_For_Element_Declaration_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Record_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Element_Declaration_Chain", Target);
+      end case;
+   end Check_Kind_For_Element_Declaration_Chain;
+
+   function Get_Element_Declaration_Chain (Decl : Iir) return Iir is
+   begin
+      Check_Kind_For_Element_Declaration_Chain (Decl);
+      return Get_Field2 (Decl);
+   end Get_Element_Declaration_Chain;
+
+   procedure Set_Element_Declaration_Chain (Decl : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Element_Declaration_Chain (Decl);
+      Set_Field2 (Decl, Chain);
+   end Set_Element_Declaration_Chain;
+
+   procedure Check_Kind_For_Number_Element_Declaration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Record_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Number_Element_Declaration", Target);
+      end case;
+   end Check_Kind_For_Number_Element_Declaration;
+
+   function Get_Number_Element_Declaration (Decl : Iir) return Iir_Index32 is
+   begin
+      Check_Kind_For_Number_Element_Declaration (Decl);
+      return Iir_To_Iir_Index32 (Get_Field1 (Decl));
+   end Get_Number_Element_Declaration;
+
+   procedure Set_Number_Element_Declaration (Decl : Iir; Val : Iir_Index32) is
+   begin
+      Check_Kind_For_Number_Element_Declaration (Decl);
+      Set_Field1 (Decl, Iir_Index32_To_Iir (Val));
+   end Set_Number_Element_Declaration;
+
+   procedure Check_Kind_For_Designated_Type (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Access_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Designated_Type", Target);
+      end case;
+   end Check_Kind_For_Designated_Type;
+
+   function Get_Designated_Type (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Designated_Type (Target);
+      return Get_Field2 (Target);
+   end Get_Designated_Type;
+
+   procedure Set_Designated_Type (Target : Iir; Dtype : Iir) is
+   begin
+      Check_Kind_For_Designated_Type (Target);
+      Set_Field2 (Target, Dtype);
+   end Set_Designated_Type;
+
+   procedure Check_Kind_For_Target (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Variable_Assignment_Statement =>
+            null;
+         when others =>
+            Failed ("Target", Target);
+      end case;
+   end Check_Kind_For_Target;
+
+   function Get_Target (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Target (Target);
+      return Get_Field1 (Target);
+   end Get_Target;
+
+   procedure Set_Target (Target : Iir; Atarget : Iir) is
+   begin
+      Check_Kind_For_Target (Target);
+      Set_Field1 (Target, Atarget);
+   end Set_Target;
+
+   procedure Check_Kind_For_Waveform_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Conditional_Waveform
+           | Iir_Kind_Signal_Assignment_Statement =>
+            null;
+         when others =>
+            Failed ("Waveform_Chain", Target);
+      end case;
+   end Check_Kind_For_Waveform_Chain;
+
+   function Get_Waveform_Chain (Target : Iir) return Iir_Waveform_Element is
+   begin
+      Check_Kind_For_Waveform_Chain (Target);
+      return Get_Field5 (Target);
+   end Get_Waveform_Chain;
+
+   procedure Set_Waveform_Chain (Target : Iir; Chain : Iir_Waveform_Element)
+      is
+   begin
+      Check_Kind_For_Waveform_Chain (Target);
+      Set_Field5 (Target, Chain);
+   end Set_Waveform_Chain;
+
+   procedure Check_Kind_For_Guard (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            null;
+         when others =>
+            Failed ("Guard", Target);
+      end case;
+   end Check_Kind_For_Guard;
+
+   function Get_Guard (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Guard (Target);
+      return Get_Field8 (Target);
+   end Get_Guard;
+
+   procedure Set_Guard (Target : Iir; Guard : Iir) is
+   begin
+      Check_Kind_For_Guard (Target);
+      Set_Field8 (Target, Guard);
+   end Set_Guard;
+
+   procedure Check_Kind_For_Delay_Mechanism (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Signal_Assignment_Statement =>
+            null;
+         when others =>
+            Failed ("Delay_Mechanism", Target);
+      end case;
+   end Check_Kind_For_Delay_Mechanism;
+
+   function Get_Delay_Mechanism (Target : Iir) return Iir_Delay_Mechanism is
+   begin
+      Check_Kind_For_Delay_Mechanism (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
+      Check_Kind_For_Delay_Mechanism (Target);
+      Set_Field12 (Target, Iir_Delay_Mechanism'Pos (Kind));
+   end Set_Delay_Mechanism;
+
+   procedure Check_Kind_For_Reject_Time_Expression (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Signal_Assignment_Statement =>
+            null;
+         when others =>
+            Failed ("Reject_Time_Expression", Target);
+      end case;
+   end Check_Kind_For_Reject_Time_Expression;
+
+   function Get_Reject_Time_Expression (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Reject_Time_Expression (Target);
+      return Get_Field6 (Target);
+   end Get_Reject_Time_Expression;
+
+   procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir) is
+   begin
+      Check_Kind_For_Reject_Time_Expression (Target);
+      Set_Field6 (Target, Expr);
+   end Set_Reject_Time_Expression;
+
+   procedure Check_Kind_For_Sensitivity_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Wait_Statement =>
+            null;
+         when others =>
+            Failed ("Sensitivity_List", Target);
+      end case;
+   end Check_Kind_For_Sensitivity_List;
+
+   function Get_Sensitivity_List (Wait : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Sensitivity_List (Wait);
+      return Iir_To_Iir_List (Get_Field6 (Wait));
+   end Get_Sensitivity_List;
+
+   procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Sensitivity_List (Wait);
+      Set_Field6 (Wait, Iir_List_To_Iir (List));
+   end Set_Sensitivity_List;
+
+   procedure Check_Kind_For_Condition_Clause (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Wait_Statement =>
+            null;
+         when others =>
+            Failed ("Condition_Clause", Target);
+      end case;
+   end Check_Kind_For_Condition_Clause;
+
+   function Get_Condition_Clause (Wait : Iir_Wait_Statement) return Iir is
+   begin
+      Check_Kind_For_Condition_Clause (Wait);
+      return Get_Field5 (Wait);
+   end Get_Condition_Clause;
+
+   procedure Set_Condition_Clause (Wait : Iir_Wait_Statement; Cond : Iir) is
+   begin
+      Check_Kind_For_Condition_Clause (Wait);
+      Set_Field5 (Wait, Cond);
+   end Set_Condition_Clause;
+
+   procedure Check_Kind_For_Timeout_Clause (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Wait_Statement =>
+            null;
+         when others =>
+            Failed ("Timeout_Clause", Target);
+      end case;
+   end Check_Kind_For_Timeout_Clause;
+
+   function Get_Timeout_Clause (Wait : Iir_Wait_Statement) return Iir is
+   begin
+      Check_Kind_For_Timeout_Clause (Wait);
+      return Get_Field1 (Wait);
+   end Get_Timeout_Clause;
+
+   procedure Set_Timeout_Clause (Wait : Iir_Wait_Statement; Timeout : Iir) is
+   begin
+      Check_Kind_For_Timeout_Clause (Wait);
+      Set_Field1 (Wait, Timeout);
+   end Set_Timeout_Clause;
+
+   procedure Check_Kind_For_Postponed_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Postponed_Flag", Target);
+      end case;
+   end Check_Kind_For_Postponed_Flag;
+
+   function Get_Postponed_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Postponed_Flag (Target);
+      return Get_Flag3 (Target);
+   end Get_Postponed_Flag;
+
+   procedure Set_Postponed_Flag (Target : Iir; Value : Boolean) is
+   begin
+      Check_Kind_For_Postponed_Flag (Target);
+      Set_Flag3 (Target, Value);
+   end Set_Postponed_Flag;
+
+   procedure Check_Kind_For_Driver_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            null;
+         when others =>
+            Failed ("Driver_List", Target);
+      end case;
+   end Check_Kind_For_Driver_List;
+
+   function Get_Driver_List (Stmt : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Driver_List (Stmt);
+      return Iir_To_Iir_List (Get_Field8 (Stmt));
+   end Get_Driver_List;
+
+   procedure Set_Driver_List (Stmt : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Driver_List (Stmt);
+      Set_Field8 (Stmt, Iir_List_To_Iir (List));
+   end Set_Driver_List;
+
+   procedure Check_Kind_For_Callees_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Callees_List", Target);
+      end case;
+   end Check_Kind_For_Callees_List;
+
+   function Get_Callees_List (Proc : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Callees_List (Proc);
+      return Iir_To_Iir_List (Get_Field7 (Proc));
+   end Get_Callees_List;
+
+   procedure Set_Callees_List (Proc : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Callees_List (Proc);
+      Set_Field7 (Proc, Iir_List_To_Iir (List));
+   end Set_Callees_List;
+
+   procedure Check_Kind_For_Passive_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            null;
+         when others =>
+            Failed ("Passive_Flag", Target);
+      end case;
+   end Check_Kind_For_Passive_Flag;
+
+   function Get_Passive_Flag (Proc : Iir) return Boolean is
+   begin
+      Check_Kind_For_Passive_Flag (Proc);
+      return Get_Flag2 (Proc);
+   end Get_Passive_Flag;
+
+   procedure Set_Passive_Flag (Proc : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Passive_Flag (Proc);
+      Set_Flag2 (Proc, Flag);
+   end Set_Passive_Flag;
+
+   procedure Check_Kind_For_Wait_State (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Wait_State", Target);
+      end case;
+   end Check_Kind_For_Wait_State;
+
+   function Get_Wait_State (Proc : Iir) return Tri_State_Type is
+   begin
+      Check_Kind_For_Wait_State (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
+      Check_Kind_For_Wait_State (Proc);
+      Set_State1 (Proc, Tri_State_Type'Pos (State));
+   end Set_Wait_State;
+
+   procedure Check_Kind_For_Seen_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            null;
+         when others =>
+            Failed ("Seen_Flag", Target);
+      end case;
+   end Check_Kind_For_Seen_Flag;
+
+   function Get_Seen_Flag (Proc : Iir) return Boolean is
+   begin
+      Check_Kind_For_Seen_Flag (Proc);
+      return Get_Flag1 (Proc);
+   end Get_Seen_Flag;
+
+   procedure Set_Seen_Flag (Proc : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Seen_Flag (Proc);
+      Set_Flag1 (Proc, Flag);
+   end Set_Seen_Flag;
+
+   procedure Check_Kind_For_Pure_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            null;
+         when others =>
+            Failed ("Pure_Flag", Target);
+      end case;
+   end Check_Kind_For_Pure_Flag;
+
+   function Get_Pure_Flag (Func : Iir) return Boolean is
+   begin
+      Check_Kind_For_Pure_Flag (Func);
+      return Get_Flag2 (Func);
+   end Get_Pure_Flag;
+
+   procedure Set_Pure_Flag (Func : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Pure_Flag (Func);
+      Set_Flag2 (Func, Flag);
+   end Set_Pure_Flag;
+
+   procedure Check_Kind_For_Foreign_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Architecture_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            null;
+         when others =>
+            Failed ("Foreign_Flag", Target);
+      end case;
+   end Check_Kind_For_Foreign_Flag;
+
+   function Get_Foreign_Flag (Decl : Iir) return Boolean is
+   begin
+      Check_Kind_For_Foreign_Flag (Decl);
+      return Get_Flag3 (Decl);
+   end Get_Foreign_Flag;
+
+   procedure Set_Foreign_Flag (Decl : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Foreign_Flag (Decl);
+      Set_Flag3 (Decl, Flag);
+   end Set_Foreign_Flag;
+
+   procedure Check_Kind_For_Resolved_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Unconstrained_Array_Subtype_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_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Resolved_Flag", Target);
+      end case;
+   end Check_Kind_For_Resolved_Flag;
+
+   function Get_Resolved_Flag (Atype : Iir) return Boolean is
+   begin
+      Check_Kind_For_Resolved_Flag (Atype);
+      return Get_Flag1 (Atype);
+   end Get_Resolved_Flag;
+
+   procedure Set_Resolved_Flag (Atype : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Resolved_Flag (Atype);
+      Set_Flag1 (Atype, Flag);
+   end Set_Resolved_Flag;
+
+   procedure Check_Kind_For_Signal_Type_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Unconstrained_Array_Subtype_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_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Signal_Type_Flag", Target);
+      end case;
+   end Check_Kind_For_Signal_Type_Flag;
+
+   function Get_Signal_Type_Flag (Atype : Iir) return Boolean is
+   begin
+      Check_Kind_For_Signal_Type_Flag (Atype);
+      return Get_Flag2 (Atype);
+   end Get_Signal_Type_Flag;
+
+   procedure Set_Signal_Type_Flag (Atype : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Signal_Type_Flag (Atype);
+      Set_Flag2 (Atype, Flag);
+   end Set_Signal_Type_Flag;
+
+   procedure Check_Kind_For_Purity_State (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Procedure_Declaration =>
+            null;
+         when others =>
+            Failed ("Purity_State", Target);
+      end case;
+   end Check_Kind_For_Purity_State;
+
+   function Get_Purity_State (Proc : Iir) return Iir_Pure_State is
+   begin
+      Check_Kind_For_Purity_State (Proc);
+      return Iir_Pure_State'Val (Get_State3 (Proc));
+   end Get_Purity_State;
+
+   procedure Set_Purity_State (Proc : Iir; State : Iir_Pure_State) is
+   begin
+      Check_Kind_For_Purity_State (Proc);
+      Set_State3 (Proc, Iir_Pure_State'Pos (State));
+   end Set_Purity_State;
+
+   procedure Check_Kind_For_Elab_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_File
+           | Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("Elab_Flag", Target);
+      end case;
+   end Check_Kind_For_Elab_Flag;
+
+   function Get_Elab_Flag (Design : Iir) return Boolean is
+   begin
+      Check_Kind_For_Elab_Flag (Design);
+      return Get_Flag3 (Design);
+   end Get_Elab_Flag;
+
+   procedure Set_Elab_Flag (Design : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Elab_Flag (Design);
+      Set_Flag3 (Design, Flag);
+   end Set_Elab_Flag;
+
+   procedure Check_Kind_For_Assertion_Condition (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Assertion_Statement =>
+            null;
+         when others =>
+            Failed ("Assertion_Condition", Target);
+      end case;
+   end Check_Kind_For_Assertion_Condition;
+
+   function Get_Assertion_Condition (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Assertion_Condition (Target);
+      return Get_Field1 (Target);
+   end Get_Assertion_Condition;
+
+   procedure Set_Assertion_Condition (Target : Iir; Cond : Iir) is
+   begin
+      Check_Kind_For_Assertion_Condition (Target);
+      Set_Field1 (Target, Cond);
+   end Set_Assertion_Condition;
+
+   procedure Check_Kind_For_Report_Expression (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement =>
+            null;
+         when others =>
+            Failed ("Report_Expression", Target);
+      end case;
+   end Check_Kind_For_Report_Expression;
+
+   function Get_Report_Expression (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Report_Expression (Target);
+      return Get_Field6 (Target);
+   end Get_Report_Expression;
+
+   procedure Set_Report_Expression (Target : Iir; Expr : Iir) is
+   begin
+      Check_Kind_For_Report_Expression (Target);
+      Set_Field6 (Target, Expr);
+   end Set_Report_Expression;
+
+   procedure Check_Kind_For_Severity_Expression (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement =>
+            null;
+         when others =>
+            Failed ("Severity_Expression", Target);
+      end case;
+   end Check_Kind_For_Severity_Expression;
+
+   function Get_Severity_Expression (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Severity_Expression (Target);
+      return Get_Field5 (Target);
+   end Get_Severity_Expression;
+
+   procedure Set_Severity_Expression (Target : Iir; Expr : Iir) is
+   begin
+      Check_Kind_For_Severity_Expression (Target);
+      Set_Field5 (Target, Expr);
+   end Set_Severity_Expression;
+
+   procedure Check_Kind_For_Instantiated_Unit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            null;
+         when others =>
+            Failed ("Instantiated_Unit", Target);
+      end case;
+   end Check_Kind_For_Instantiated_Unit;
+
+   function Get_Instantiated_Unit (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Instantiated_Unit (Target);
+      return Get_Field1 (Target);
+   end Get_Instantiated_Unit;
+
+   procedure Set_Instantiated_Unit (Target : Iir; Unit : Iir) is
+   begin
+      Check_Kind_For_Instantiated_Unit (Target);
+      Set_Field1 (Target, Unit);
+   end Set_Instantiated_Unit;
+
+   procedure Check_Kind_For_Generic_Map_Aspect_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Binding_Indication
+           | Iir_Kind_Component_Instantiation_Statement =>
+            null;
+         when others =>
+            Failed ("Generic_Map_Aspect_Chain", Target);
+      end case;
+   end Check_Kind_For_Generic_Map_Aspect_Chain;
+
+   function Get_Generic_Map_Aspect_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Generic_Map_Aspect_Chain (Target);
+      return Get_Field8 (Target);
+   end Get_Generic_Map_Aspect_Chain;
+
+   procedure Set_Generic_Map_Aspect_Chain (Target : Iir; Generics : Iir) is
+   begin
+      Check_Kind_For_Generic_Map_Aspect_Chain (Target);
+      Set_Field8 (Target, Generics);
+   end Set_Generic_Map_Aspect_Chain;
+
+   procedure Check_Kind_For_Port_Map_Aspect_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Binding_Indication
+           | Iir_Kind_Component_Instantiation_Statement =>
+            null;
+         when others =>
+            Failed ("Port_Map_Aspect_Chain", Target);
+      end case;
+   end Check_Kind_For_Port_Map_Aspect_Chain;
+
+   function Get_Port_Map_Aspect_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Port_Map_Aspect_Chain (Target);
+      return Get_Field9 (Target);
+   end Get_Port_Map_Aspect_Chain;
+
+   procedure Set_Port_Map_Aspect_Chain (Target : Iir; Port : Iir) is
+   begin
+      Check_Kind_For_Port_Map_Aspect_Chain (Target);
+      Set_Field9 (Target, Port);
+   end Set_Port_Map_Aspect_Chain;
+
+   procedure Check_Kind_For_Configuration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            null;
+         when others =>
+            Failed ("Configuration", Target);
+      end case;
+   end Check_Kind_For_Configuration;
+
+   function Get_Configuration (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Configuration (Target);
+      return Get_Field1 (Target);
+   end Get_Configuration;
+
+   procedure Set_Configuration (Target : Iir; Conf : Iir) is
+   begin
+      Check_Kind_For_Configuration (Target);
+      Set_Field1 (Target, Conf);
+   end Set_Configuration;
+
+   procedure Check_Kind_For_Component_Configuration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            null;
+         when others =>
+            Failed ("Component_Configuration", Target);
+      end case;
+   end Check_Kind_For_Component_Configuration;
+
+   function Get_Component_Configuration (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Component_Configuration (Target);
+      return Get_Field6 (Target);
+   end Get_Component_Configuration;
+
+   procedure Set_Component_Configuration (Target : Iir; Conf : Iir) is
+   begin
+      Check_Kind_For_Component_Configuration (Target);
+      Set_Field6 (Target, Conf);
+   end Set_Component_Configuration;
+
+   procedure Check_Kind_For_Configuration_Specification (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            null;
+         when others =>
+            Failed ("Configuration_Specification", Target);
+      end case;
+   end Check_Kind_For_Configuration_Specification;
+
+   function Get_Configuration_Specification (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Configuration_Specification (Target);
+      return Get_Field7 (Target);
+   end Get_Configuration_Specification;
+
+   procedure Set_Configuration_Specification (Target : Iir; Conf : Iir) is
+   begin
+      Check_Kind_For_Configuration_Specification (Target);
+      Set_Field7 (Target, Conf);
+   end Set_Configuration_Specification;
+
+   procedure Check_Kind_For_Default_Binding_Indication (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            null;
+         when others =>
+            Failed ("Default_Binding_Indication", Target);
+      end case;
+   end Check_Kind_For_Default_Binding_Indication;
+
+   function Get_Default_Binding_Indication (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Default_Binding_Indication (Target);
+      return Get_Field5 (Target);
+   end Get_Default_Binding_Indication;
+
+   procedure Set_Default_Binding_Indication (Target : Iir; Conf : Iir) is
+   begin
+      Check_Kind_For_Default_Binding_Indication (Target);
+      Set_Field5 (Target, Conf);
+   end Set_Default_Binding_Indication;
+
+   procedure Check_Kind_For_Default_Configuration_Declaration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Architecture_Declaration =>
+            null;
+         when others =>
+            Failed ("Default_Configuration_Declaration", Target);
+      end case;
+   end Check_Kind_For_Default_Configuration_Declaration;
+
+   function Get_Default_Configuration_Declaration (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Default_Configuration_Declaration (Target);
+      return Get_Field6 (Target);
+   end Get_Default_Configuration_Declaration;
+
+   procedure Set_Default_Configuration_Declaration (Target : Iir; Conf : Iir)
+      is
+   begin
+      Check_Kind_For_Default_Configuration_Declaration (Target);
+      Set_Field6 (Target, Conf);
+   end Set_Default_Configuration_Declaration;
+
+   procedure Check_Kind_For_Expression (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range
+           | Iir_Kind_Attribute_Specification
+           | Iir_Kind_Disconnection_Specification
+           | Iir_Kind_Qualified_Expression
+           | Iir_Kind_Type_Conversion
+           | Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_Case_Statement =>
+            null;
+         when others =>
+            Failed ("Expression", Target);
+      end case;
+   end Check_Kind_For_Expression;
+
+   function Get_Expression (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Expression (Target);
+      return Get_Field5 (Target);
+   end Get_Expression;
+
+   procedure Set_Expression (Target : Iir; Expr : Iir) is
+   begin
+      Check_Kind_For_Expression (Target);
+      Set_Field5 (Target, Expr);
+   end Set_Expression;
+
+   procedure Check_Kind_For_Selected_Waveform_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            null;
+         when others =>
+            Failed ("Selected_Waveform_Chain", Target);
+      end case;
+   end Check_Kind_For_Selected_Waveform_Chain;
+
+   function Get_Selected_Waveform_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Selected_Waveform_Chain (Target);
+      return Get_Field7 (Target);
+   end Get_Selected_Waveform_Chain;
+
+   procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Selected_Waveform_Chain (Target);
+      Set_Field7 (Target, Chain);
+   end Set_Selected_Waveform_Chain;
+
+   procedure Check_Kind_For_Conditional_Waveform_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+            null;
+         when others =>
+            Failed ("Conditional_Waveform_Chain", Target);
+      end case;
+   end Check_Kind_For_Conditional_Waveform_Chain;
+
+   function Get_Conditional_Waveform_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Conditional_Waveform_Chain (Target);
+      return Get_Field7 (Target);
+   end Get_Conditional_Waveform_Chain;
+
+   procedure Set_Conditional_Waveform_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Conditional_Waveform_Chain (Target);
+      Set_Field7 (Target, Chain);
+   end Set_Conditional_Waveform_Chain;
+
+   procedure Check_Kind_For_Guard_Expression (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Guard_Signal_Declaration =>
+            null;
+         when others =>
+            Failed ("Guard_Expression", Target);
+      end case;
+   end Check_Kind_For_Guard_Expression;
+
+   function Get_Guard_Expression (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Guard_Expression (Target);
+      return Get_Field2 (Target);
+   end Get_Guard_Expression;
+
+   procedure Set_Guard_Expression (Target : Iir; Expr : Iir) is
+   begin
+      Check_Kind_For_Guard_Expression (Target);
+      Set_Field2 (Target, Expr);
+   end Set_Guard_Expression;
+
+   procedure Check_Kind_For_Guard_Decl (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Statement =>
+            null;
+         when others =>
+            Failed ("Guard_Decl", Target);
+      end case;
+   end Check_Kind_For_Guard_Decl;
+
+   function Get_Guard_Decl (Target : Iir_Block_Statement) return Iir is
+   begin
+      Check_Kind_For_Guard_Decl (Target);
+      return Get_Field8 (Target);
+   end Get_Guard_Decl;
+
+   procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir) is
+   begin
+      Check_Kind_For_Guard_Decl (Target);
+      Set_Field8 (Target, Decl);
+   end Set_Guard_Decl;
+
+   procedure Check_Kind_For_Guard_Sensitivity_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Guard_Signal_Declaration =>
+            null;
+         when others =>
+            Failed ("Guard_Sensitivity_List", Target);
+      end case;
+   end Check_Kind_For_Guard_Sensitivity_List;
+
+   function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Guard_Sensitivity_List (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
+      Check_Kind_For_Guard_Sensitivity_List (Guard);
+      Set_Field6 (Guard, Iir_List_To_Iir (List));
+   end Set_Guard_Sensitivity_List;
+
+   procedure Check_Kind_For_Block_Block_Configuration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Statement =>
+            null;
+         when others =>
+            Failed ("Block_Block_Configuration", Target);
+      end case;
+   end Check_Kind_For_Block_Block_Configuration;
+
+   function Get_Block_Block_Configuration (Block : Iir) return Iir is
+   begin
+      Check_Kind_For_Block_Block_Configuration (Block);
+      return Get_Field6 (Block);
+   end Get_Block_Block_Configuration;
+
+   procedure Set_Block_Block_Configuration (Block : Iir; Conf : Iir) is
+   begin
+      Check_Kind_For_Block_Block_Configuration (Block);
+      Set_Field6 (Block, Conf);
+   end Set_Block_Block_Configuration;
+
+   procedure Check_Kind_For_Block_Header (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Block_Statement =>
+            null;
+         when others =>
+            Failed ("Block_Header", Target);
+      end case;
+   end Check_Kind_For_Block_Header;
+
+   function Get_Block_Header (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Block_Header (Target);
+      return Get_Field7 (Target);
+   end Get_Block_Header;
+
+   procedure Set_Block_Header (Target : Iir; Header : Iir) is
+   begin
+      Check_Kind_For_Block_Header (Target);
+      Set_Field7 (Target, Header);
+   end Set_Block_Header;
+
+   procedure Check_Kind_For_Generate_Block_Configuration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Generate_Statement =>
+            null;
+         when others =>
+            Failed ("Generate_Block_Configuration", Target);
+      end case;
+   end Check_Kind_For_Generate_Block_Configuration;
+
+   function Get_Generate_Block_Configuration (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Generate_Block_Configuration (Target);
+      return Get_Field7 (Target);
+   end Get_Generate_Block_Configuration;
+
+   procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir) is
+   begin
+      Check_Kind_For_Generate_Block_Configuration (Target);
+      Set_Field7 (Target, Conf);
+   end Set_Generate_Block_Configuration;
+
+   procedure Check_Kind_For_Generation_Scheme (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Generate_Statement =>
+            null;
+         when others =>
+            Failed ("Generation_Scheme", Target);
+      end case;
+   end Check_Kind_For_Generation_Scheme;
+
+   function Get_Generation_Scheme (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Generation_Scheme (Target);
+      return Get_Field6 (Target);
+   end Get_Generation_Scheme;
+
+   procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir) is
+   begin
+      Check_Kind_For_Generation_Scheme (Target);
+      Set_Field6 (Target, Scheme);
+   end Set_Generation_Scheme;
+
+   procedure Check_Kind_For_Condition (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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 =>
+            null;
+         when others =>
+            Failed ("Condition", Target);
+      end case;
+   end Check_Kind_For_Condition;
+
+   function Get_Condition (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Condition (Target);
+      return Get_Field1 (Target);
+   end Get_Condition;
+
+   procedure Set_Condition (Target : Iir; Condition : Iir) is
+   begin
+      Check_Kind_For_Condition (Target);
+      Set_Field1 (Target, Condition);
+   end Set_Condition;
+
+   procedure Check_Kind_For_Else_Clause (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            null;
+         when others =>
+            Failed ("Else_Clause", Target);
+      end case;
+   end Check_Kind_For_Else_Clause;
+
+   function Get_Else_Clause (Target : Iir) return Iir_Elsif is
+   begin
+      Check_Kind_For_Else_Clause (Target);
+      return Get_Field6 (Target);
+   end Get_Else_Clause;
+
+   procedure Set_Else_Clause (Target : Iir; Clause : Iir_Elsif) is
+   begin
+      Check_Kind_For_Else_Clause (Target);
+      Set_Field6 (Target, Clause);
+   end Set_Else_Clause;
+
+   procedure Check_Kind_For_Iterator_Scheme (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_For_Loop_Statement =>
+            null;
+         when others =>
+            Failed ("Iterator_Scheme", Target);
+      end case;
+   end Check_Kind_For_Iterator_Scheme;
+
+   function Get_Iterator_Scheme (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Iterator_Scheme (Target);
+      return Get_Field1 (Target);
+   end Get_Iterator_Scheme;
+
+   procedure Set_Iterator_Scheme (Target : Iir; Iterator : Iir) is
+   begin
+      Check_Kind_For_Iterator_Scheme (Target);
+      Set_Field1 (Target, Iterator);
+   end Set_Iterator_Scheme;
+
+   procedure Check_Kind_For_Parent (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Procedure_Call
+           | 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_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Architecture_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_Function_Body
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Procedure_Body
+           | 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_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 =>
+            null;
+         when others =>
+            Failed ("Parent", Target);
+      end case;
+   end Check_Kind_For_Parent;
+
+   function Get_Parent (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Parent (Target);
+      return Get_Field0 (Target);
+   end Get_Parent;
+
+   procedure Set_Parent (Target : Iir; Parent : Iir) is
+   begin
+      Check_Kind_For_Parent (Target);
+      Set_Field0 (Target, Parent);
+   end Set_Parent;
+
+   procedure Check_Kind_For_Loop (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement =>
+            null;
+         when others =>
+            Failed ("Loop", Target);
+      end case;
+   end Check_Kind_For_Loop;
+
+   function Get_Loop (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Loop (Target);
+      return Get_Field5 (Target);
+   end Get_Loop;
+
+   procedure Set_Loop (Target : Iir; Stmt : Iir) is
+   begin
+      Check_Kind_For_Loop (Target);
+      Set_Field5 (Target, Stmt);
+   end Set_Loop;
+
+   procedure Check_Kind_For_Component_Name (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Component_Configuration
+           | Iir_Kind_Configuration_Specification =>
+            null;
+         when others =>
+            Failed ("Component_Name", Target);
+      end case;
+   end Check_Kind_For_Component_Name;
+
+   function Get_Component_Name (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Component_Name (Target);
+      return Get_Field4 (Target);
+   end Get_Component_Name;
+
+   procedure Set_Component_Name (Target : Iir; Name : Iir) is
+   begin
+      Check_Kind_For_Component_Name (Target);
+      Set_Field4 (Target, Name);
+   end Set_Component_Name;
+
+   procedure Check_Kind_For_Instantiation_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Component_Configuration
+           | Iir_Kind_Configuration_Specification =>
+            null;
+         when others =>
+            Failed ("Instantiation_List", Target);
+      end case;
+   end Check_Kind_For_Instantiation_List;
+
+   function Get_Instantiation_List (Target : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Instantiation_List (Target);
+      return Iir_To_Iir_List (Get_Field1 (Target));
+   end Get_Instantiation_List;
+
+   procedure Set_Instantiation_List (Target : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Instantiation_List (Target);
+      Set_Field1 (Target, Iir_List_To_Iir (List));
+   end Set_Instantiation_List;
+
+   procedure Check_Kind_For_Entity_Aspect (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Binding_Indication =>
+            null;
+         when others =>
+            Failed ("Entity_Aspect", Target);
+      end case;
+   end Check_Kind_For_Entity_Aspect;
+
+   function Get_Entity_Aspect (Target : Iir_Binding_Indication) return Iir is
+   begin
+      Check_Kind_For_Entity_Aspect (Target);
+      return Get_Field3 (Target);
+   end Get_Entity_Aspect;
+
+   procedure Set_Entity_Aspect (Target : Iir_Binding_Indication; Entity : Iir)
+      is
+   begin
+      Check_Kind_For_Entity_Aspect (Target);
+      Set_Field3 (Target, Entity);
+   end Set_Entity_Aspect;
+
+   procedure Check_Kind_For_Default_Entity_Aspect (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Binding_Indication =>
+            null;
+         when others =>
+            Failed ("Default_Entity_Aspect", Target);
+      end case;
+   end Check_Kind_For_Default_Entity_Aspect;
+
+   function Get_Default_Entity_Aspect (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Default_Entity_Aspect (Target);
+      return Get_Field1 (Target);
+   end Get_Default_Entity_Aspect;
+
+   procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir) is
+   begin
+      Check_Kind_For_Default_Entity_Aspect (Target);
+      Set_Field1 (Target, Aspect);
+   end Set_Default_Entity_Aspect;
+
+   procedure Check_Kind_For_Default_Generic_Map_Aspect_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Binding_Indication =>
+            null;
+         when others =>
+            Failed ("Default_Generic_Map_Aspect_Chain", Target);
+      end case;
+   end Check_Kind_For_Default_Generic_Map_Aspect_Chain;
+
+   function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Default_Generic_Map_Aspect_Chain (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
+      Check_Kind_For_Default_Generic_Map_Aspect_Chain (Target);
+      Set_Field6 (Target, Chain);
+   end Set_Default_Generic_Map_Aspect_Chain;
+
+   procedure Check_Kind_For_Default_Port_Map_Aspect_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Binding_Indication =>
+            null;
+         when others =>
+            Failed ("Default_Port_Map_Aspect_Chain", Target);
+      end case;
+   end Check_Kind_For_Default_Port_Map_Aspect_Chain;
+
+   function Get_Default_Port_Map_Aspect_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Default_Port_Map_Aspect_Chain (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
+      Check_Kind_For_Default_Port_Map_Aspect_Chain (Target);
+      Set_Field7 (Target, Chain);
+   end Set_Default_Port_Map_Aspect_Chain;
+
+   procedure Check_Kind_For_Binding_Indication (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Component_Configuration
+           | Iir_Kind_Configuration_Specification =>
+            null;
+         when others =>
+            Failed ("Binding_Indication", Target);
+      end case;
+   end Check_Kind_For_Binding_Indication;
+
+   function Get_Binding_Indication (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Binding_Indication (Target);
+      return Get_Field3 (Target);
+   end Get_Binding_Indication;
+
+   procedure Set_Binding_Indication (Target : Iir; Binding : Iir) is
+   begin
+      Check_Kind_For_Binding_Indication (Target);
+      Set_Field3 (Target, Binding);
+   end Set_Binding_Indication;
+
+   procedure Check_Kind_For_Named_Entity (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Operator_Symbol
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Attribute_Name =>
+            null;
+         when others =>
+            Failed ("Named_Entity", Target);
+      end case;
+   end Check_Kind_For_Named_Entity;
+
+   function Get_Named_Entity (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Named_Entity (Target);
+      return Get_Field4 (Target);
+   end Get_Named_Entity;
+
+   procedure Set_Named_Entity (Target : Iir; Val : Iir) is
+   begin
+      Check_Kind_For_Named_Entity (Target);
+      Set_Field4 (Target, Val);
+   end Set_Named_Entity;
+
+   procedure Check_Kind_For_Expr_Staticness (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Attribute_Value
+           | Iir_Kind_Range_Expression
+           | Iir_Kind_Unit_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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration
+           | Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_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_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_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_Simple_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_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_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_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_Attribute_Name =>
+            null;
+         when others =>
+            Failed ("Expr_Staticness", Target);
+      end case;
+   end Check_Kind_For_Expr_Staticness;
+
+   function Get_Expr_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      Check_Kind_For_Expr_Staticness (Target);
+      return Iir_Staticness'Val (Get_State1 (Target));
+   end Get_Expr_Staticness;
+
+   procedure Set_Expr_Staticness (Target : Iir; Static : Iir_Staticness) is
+   begin
+      Check_Kind_For_Expr_Staticness (Target);
+      Set_State1 (Target, Iir_Staticness'Pos (Static));
+   end Set_Expr_Staticness;
+
+   procedure Check_Kind_For_Error_Origin (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Error =>
+            null;
+         when others =>
+            Failed ("Error_Origin", Target);
+      end case;
+   end Check_Kind_For_Error_Origin;
+
+   function Get_Error_Origin (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Error_Origin (Target);
+      return Get_Field2 (Target);
+   end Get_Error_Origin;
+
+   procedure Set_Error_Origin (Target : Iir; Origin : Iir) is
+   begin
+      Check_Kind_For_Error_Origin (Target);
+      Set_Field2 (Target, Origin);
+   end Set_Error_Origin;
+
+   procedure Check_Kind_For_Operand (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_Operator =>
+            null;
+         when others =>
+            Failed ("Operand", Target);
+      end case;
+   end Check_Kind_For_Operand;
+
+   function Get_Operand (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Operand (Target);
+      return Get_Field2 (Target);
+   end Get_Operand;
+
+   procedure Set_Operand (Target : Iir; An_Iir : Iir) is
+   begin
+      Check_Kind_For_Operand (Target);
+      Set_Field2 (Target, An_Iir);
+   end Set_Operand;
+
+   procedure Check_Kind_For_Left (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_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 =>
+            null;
+         when others =>
+            Failed ("Left", Target);
+      end case;
+   end Check_Kind_For_Left;
+
+   function Get_Left (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Left (Target);
+      return Get_Field2 (Target);
+   end Get_Left;
+
+   procedure Set_Left (Target : Iir; An_Iir : Iir) is
+   begin
+      Check_Kind_For_Left (Target);
+      Set_Field2 (Target, An_Iir);
+   end Set_Left;
+
+   procedure Check_Kind_For_Right (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_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 =>
+            null;
+         when others =>
+            Failed ("Right", Target);
+      end case;
+   end Check_Kind_For_Right;
+
+   function Get_Right (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Right (Target);
+      return Get_Field4 (Target);
+   end Get_Right;
+
+   procedure Set_Right (Target : Iir; An_Iir : Iir) is
+   begin
+      Check_Kind_For_Right (Target);
+      Set_Field4 (Target, An_Iir);
+   end Set_Right;
+
+   procedure Check_Kind_For_Unit_Name (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            null;
+         when others =>
+            Failed ("Unit_Name", Target);
+      end case;
+   end Check_Kind_For_Unit_Name;
+
+   function Get_Unit_Name (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Unit_Name (Target);
+      return Get_Field3 (Target);
+   end Get_Unit_Name;
+
+   procedure Set_Unit_Name (Target : Iir; Name : Iir) is
+   begin
+      Check_Kind_For_Unit_Name (Target);
+      Set_Field3 (Target, Name);
+   end Set_Unit_Name;
+
+   procedure Check_Kind_For_Name (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Choice_By_Name
+           | Iir_Kind_Signature
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Object_Alias_Declaration =>
+            null;
+         when others =>
+            Failed ("Name", Target);
+      end case;
+   end Check_Kind_For_Name;
+
+   function Get_Name (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Name (Target);
+      return Get_Field4 (Target);
+   end Get_Name;
+
+   procedure Set_Name (Target : Iir; Name : Iir) is
+   begin
+      Check_Kind_For_Name (Target);
+      Set_Field4 (Target, Name);
+   end Set_Name;
+
+   procedure Check_Kind_For_Group_Template_Name (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Group_Declaration =>
+            null;
+         when others =>
+            Failed ("Group_Template_Name", Target);
+      end case;
+   end Check_Kind_For_Group_Template_Name;
+
+   function Get_Group_Template_Name (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Group_Template_Name (Target);
+      return Get_Field5 (Target);
+   end Get_Group_Template_Name;
+
+   procedure Set_Group_Template_Name (Target : Iir; Name : Iir) is
+   begin
+      Check_Kind_For_Group_Template_Name (Target);
+      Set_Field5 (Target, Name);
+   end Set_Group_Template_Name;
+
+   procedure Check_Kind_For_Name_Staticness (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Attribute_Value
+           | 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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_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 =>
+            null;
+         when others =>
+            Failed ("Name_Staticness", Target);
+      end case;
+   end Check_Kind_For_Name_Staticness;
+
+   function Get_Name_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      Check_Kind_For_Name_Staticness (Target);
+      return Iir_Staticness'Val (Get_State2 (Target));
+   end Get_Name_Staticness;
+
+   procedure Set_Name_Staticness (Target : Iir; Static : Iir_Staticness) is
+   begin
+      Check_Kind_For_Name_Staticness (Target);
+      Set_State2 (Target, Iir_Staticness'Pos (Static));
+   end Set_Name_Staticness;
+
+   procedure Check_Kind_For_Prefix (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when 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_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_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_Attribute_Name =>
+            null;
+         when others =>
+            Failed ("Prefix", Target);
+      end case;
+   end Check_Kind_For_Prefix;
+
+   function Get_Prefix (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Prefix (Target);
+      return Get_Field3 (Target);
+   end Get_Prefix;
+
+   procedure Set_Prefix (Target : Iir; Prefix : Iir) is
+   begin
+      Check_Kind_For_Prefix (Target);
+      Set_Field3 (Target, Prefix);
+   end Set_Prefix;
+
+   procedure Check_Kind_For_Suffix (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Slice_Name =>
+            null;
+         when others =>
+            Failed ("Suffix", Target);
+      end case;
+   end Check_Kind_For_Suffix;
+
+   function Get_Suffix (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Suffix (Target);
+      return Get_Field2 (Target);
+   end Get_Suffix;
+
+   procedure Set_Suffix (Target : Iir; Suffix : Iir) is
+   begin
+      Check_Kind_For_Suffix (Target);
+      Set_Field2 (Target, Suffix);
+   end Set_Suffix;
+
+   procedure Check_Kind_For_Parameter (Target : Iir) is
+   begin
+      case Get_Kind (Target) 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_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            null;
+         when others =>
+            Failed ("Parameter", Target);
+      end case;
+   end Check_Kind_For_Parameter;
+
+   function Get_Parameter (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Parameter (Target);
+      return Get_Field4 (Target);
+   end Get_Parameter;
+
+   procedure Set_Parameter (Target : Iir; Param : Iir) is
+   begin
+      Check_Kind_For_Parameter (Target);
+      Set_Field4 (Target, Param);
+   end Set_Parameter;
+
+   procedure Check_Kind_For_Actual_Type (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_By_Individual =>
+            null;
+         when others =>
+            Failed ("Actual_Type", Target);
+      end case;
+   end Check_Kind_For_Actual_Type;
+
+   function Get_Actual_Type (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Actual_Type (Target);
+      return Get_Field3 (Target);
+   end Get_Actual_Type;
+
+   procedure Set_Actual_Type (Target : Iir; Atype : Iir) is
+   begin
+      Check_Kind_For_Actual_Type (Target);
+      Set_Field3 (Target, Atype);
+   end Set_Actual_Type;
+
+   procedure Check_Kind_For_Association_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Parenthesis_Name =>
+            null;
+         when others =>
+            Failed ("Association_Chain", Target);
+      end case;
+   end Check_Kind_For_Association_Chain;
+
+   function Get_Association_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Association_Chain (Target);
+      return Get_Field2 (Target);
+   end Get_Association_Chain;
+
+   procedure Set_Association_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Association_Chain (Target);
+      Set_Field2 (Target, Chain);
+   end Set_Association_Chain;
+
+   procedure Check_Kind_For_Individual_Association_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Association_Element_By_Individual =>
+            null;
+         when others =>
+            Failed ("Individual_Association_Chain", Target);
+      end case;
+   end Check_Kind_For_Individual_Association_Chain;
+
+   function Get_Individual_Association_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Individual_Association_Chain (Target);
+      return Get_Field4 (Target);
+   end Get_Individual_Association_Chain;
+
+   procedure Set_Individual_Association_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Individual_Association_Chain (Target);
+      Set_Field4 (Target, Chain);
+   end Set_Individual_Association_Chain;
+
+   procedure Check_Kind_For_Aggregate_Info (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate =>
+            null;
+         when others =>
+            Failed ("Aggregate_Info", Target);
+      end case;
+   end Check_Kind_For_Aggregate_Info;
+
+   function Get_Aggregate_Info (Target : Iir) return Iir_Aggregate_Info is
+   begin
+      Check_Kind_For_Aggregate_Info (Target);
+      return Get_Field2 (Target);
+   end Get_Aggregate_Info;
+
+   procedure Set_Aggregate_Info (Target : Iir; Info : Iir_Aggregate_Info) is
+   begin
+      Check_Kind_For_Aggregate_Info (Target);
+      Set_Field2 (Target, Info);
+   end Set_Aggregate_Info;
+
+   procedure Check_Kind_For_Sub_Aggregate_Info (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate_Info =>
+            null;
+         when others =>
+            Failed ("Sub_Aggregate_Info", Target);
+      end case;
+   end Check_Kind_For_Sub_Aggregate_Info;
+
+   function Get_Sub_Aggregate_Info (Target : Iir) return Iir_Aggregate_Info is
+   begin
+      Check_Kind_For_Sub_Aggregate_Info (Target);
+      return Get_Field1 (Target);
+   end Get_Sub_Aggregate_Info;
+
+   procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir_Aggregate_Info)
+      is
+   begin
+      Check_Kind_For_Sub_Aggregate_Info (Target);
+      Set_Field1 (Target, Info);
+   end Set_Sub_Aggregate_Info;
+
+   procedure Check_Kind_For_Aggr_Dynamic_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate_Info =>
+            null;
+         when others =>
+            Failed ("Aggr_Dynamic_Flag", Target);
+      end case;
+   end Check_Kind_For_Aggr_Dynamic_Flag;
+
+   function Get_Aggr_Dynamic_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Aggr_Dynamic_Flag (Target);
+      return Get_Flag3 (Target);
+   end Get_Aggr_Dynamic_Flag;
+
+   procedure Set_Aggr_Dynamic_Flag (Target : Iir; Val : Boolean) is
+   begin
+      Check_Kind_For_Aggr_Dynamic_Flag (Target);
+      Set_Flag3 (Target, Val);
+   end Set_Aggr_Dynamic_Flag;
+
+   procedure Check_Kind_For_Aggr_Max_Length (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate_Info =>
+            null;
+         when others =>
+            Failed ("Aggr_Max_Length", Target);
+      end case;
+   end Check_Kind_For_Aggr_Max_Length;
+
+   function Get_Aggr_Max_Length (Info : Iir_Aggregate_Info) return Iir_Int32
+      is
+   begin
+      Check_Kind_For_Aggr_Max_Length (Info);
+      return Iir_To_Iir_Int32 (Get_Field4 (Info));
+   end Get_Aggr_Max_Length;
+
+   procedure Set_Aggr_Max_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32)
+      is
+   begin
+      Check_Kind_For_Aggr_Max_Length (Info);
+      Set_Field4 (Info, Iir_Int32_To_Iir (Nbr));
+   end Set_Aggr_Max_Length;
+
+   procedure Check_Kind_For_Aggr_Low_Limit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate_Info =>
+            null;
+         when others =>
+            Failed ("Aggr_Low_Limit", Target);
+      end case;
+   end Check_Kind_For_Aggr_Low_Limit;
+
+   function Get_Aggr_Low_Limit (Target : Iir_Aggregate_Info) return Iir is
+   begin
+      Check_Kind_For_Aggr_Low_Limit (Target);
+      return Get_Field2 (Target);
+   end Get_Aggr_Low_Limit;
+
+   procedure Set_Aggr_Low_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is
+   begin
+      Check_Kind_For_Aggr_Low_Limit (Target);
+      Set_Field2 (Target, Limit);
+   end Set_Aggr_Low_Limit;
+
+   procedure Check_Kind_For_Aggr_High_Limit (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate_Info =>
+            null;
+         when others =>
+            Failed ("Aggr_High_Limit", Target);
+      end case;
+   end Check_Kind_For_Aggr_High_Limit;
+
+   function Get_Aggr_High_Limit (Target : Iir_Aggregate_Info) return Iir is
+   begin
+      Check_Kind_For_Aggr_High_Limit (Target);
+      return Get_Field3 (Target);
+   end Get_Aggr_High_Limit;
+
+   procedure Set_Aggr_High_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is
+   begin
+      Check_Kind_For_Aggr_High_Limit (Target);
+      Set_Field3 (Target, Limit);
+   end Set_Aggr_High_Limit;
+
+   procedure Check_Kind_For_Aggr_Others_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate_Info =>
+            null;
+         when others =>
+            Failed ("Aggr_Others_Flag", Target);
+      end case;
+   end Check_Kind_For_Aggr_Others_Flag;
+
+   function Get_Aggr_Others_Flag (Target : Iir_Aggregate_Info) return Boolean
+      is
+   begin
+      Check_Kind_For_Aggr_Others_Flag (Target);
+      return Get_Flag2 (Target);
+   end Get_Aggr_Others_Flag;
+
+   procedure Set_Aggr_Others_Flag (Target : Iir_Aggregate_Info; Val : Boolean)
+      is
+   begin
+      Check_Kind_For_Aggr_Others_Flag (Target);
+      Set_Flag2 (Target, Val);
+   end Set_Aggr_Others_Flag;
+
+   procedure Check_Kind_For_Aggr_Named_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate_Info =>
+            null;
+         when others =>
+            Failed ("Aggr_Named_Flag", Target);
+      end case;
+   end Check_Kind_For_Aggr_Named_Flag;
+
+   function Get_Aggr_Named_Flag (Target : Iir_Aggregate_Info) return Boolean
+      is
+   begin
+      Check_Kind_For_Aggr_Named_Flag (Target);
+      return Get_Flag4 (Target);
+   end Get_Aggr_Named_Flag;
+
+   procedure Set_Aggr_Named_Flag (Target : Iir_Aggregate_Info; Val : Boolean)
+      is
+   begin
+      Check_Kind_For_Aggr_Named_Flag (Target);
+      Set_Flag4 (Target, Val);
+   end Set_Aggr_Named_Flag;
+
+   procedure Check_Kind_For_Value_Staticness (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate =>
+            null;
+         when others =>
+            Failed ("Value_Staticness", Target);
+      end case;
+   end Check_Kind_For_Value_Staticness;
+
+   function Get_Value_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      Check_Kind_For_Value_Staticness (Target);
+      return Iir_Staticness'Val (Get_State2 (Target));
+   end Get_Value_Staticness;
+
+   procedure Set_Value_Staticness (Target : Iir; Staticness : Iir_Staticness)
+      is
+   begin
+      Check_Kind_For_Value_Staticness (Target);
+      Set_State2 (Target, Iir_Staticness'Pos (Staticness));
+   end Set_Value_Staticness;
+
+   procedure Check_Kind_For_Association_Choices_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate =>
+            null;
+         when others =>
+            Failed ("Association_Choices_Chain", Target);
+      end case;
+   end Check_Kind_For_Association_Choices_Chain;
+
+   function Get_Association_Choices_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Association_Choices_Chain (Target);
+      return Get_Field4 (Target);
+   end Get_Association_Choices_Chain;
+
+   procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Association_Choices_Chain (Target);
+      Set_Field4 (Target, Chain);
+   end Set_Association_Choices_Chain;
+
+   procedure Check_Kind_For_Case_Statement_Alternative_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Case_Statement =>
+            null;
+         when others =>
+            Failed ("Case_Statement_Alternative_Chain", Target);
+      end case;
+   end Check_Kind_For_Case_Statement_Alternative_Chain;
+
+   function Get_Case_Statement_Alternative_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Case_Statement_Alternative_Chain (Target);
+      return Get_Field1 (Target);
+   end Get_Case_Statement_Alternative_Chain;
+
+   procedure Set_Case_Statement_Alternative_Chain (Target : Iir; Chain : Iir)
+      is
+   begin
+      Check_Kind_For_Case_Statement_Alternative_Chain (Target);
+      Set_Field1 (Target, Chain);
+   end Set_Case_Statement_Alternative_Chain;
+
+   procedure Check_Kind_For_Choice_Staticness (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range =>
+            null;
+         when others =>
+            Failed ("Choice_Staticness", Target);
+      end case;
+   end Check_Kind_For_Choice_Staticness;
+
+   function Get_Choice_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      Check_Kind_For_Choice_Staticness (Target);
+      return Iir_Staticness'Val (Get_State2 (Target));
+   end Get_Choice_Staticness;
+
+   procedure Set_Choice_Staticness (Target : Iir; Staticness : Iir_Staticness)
+      is
+   begin
+      Check_Kind_For_Choice_Staticness (Target);
+      Set_State2 (Target, Iir_Staticness'Pos (Staticness));
+   end Set_Choice_Staticness;
+
+   procedure Check_Kind_For_Procedure_Call (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Procedure_Call_Statement =>
+            null;
+         when others =>
+            Failed ("Procedure_Call", Target);
+      end case;
+   end Check_Kind_For_Procedure_Call;
+
+   function Get_Procedure_Call (Stmt : Iir) return Iir is
+   begin
+      Check_Kind_For_Procedure_Call (Stmt);
+      return Get_Field1 (Stmt);
+   end Get_Procedure_Call;
+
+   procedure Set_Procedure_Call (Stmt : Iir; Call : Iir) is
+   begin
+      Check_Kind_For_Procedure_Call (Stmt);
+      Set_Field1 (Stmt, Call);
+   end Set_Procedure_Call;
+
+   procedure Check_Kind_For_Implementation (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Procedure_Call
+           | Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_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_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 =>
+            null;
+         when others =>
+            Failed ("Implementation", Target);
+      end case;
+   end Check_Kind_For_Implementation;
+
+   function Get_Implementation (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Implementation (Target);
+      return Get_Field3 (Target);
+   end Get_Implementation;
+
+   procedure Set_Implementation (Target : Iir; Decl : Iir) is
+   begin
+      Check_Kind_For_Implementation (Target);
+      Set_Field3 (Target, Decl);
+   end Set_Implementation;
+
+   procedure Check_Kind_For_Parameter_Association_Chain (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Procedure_Call
+           | Iir_Kind_Function_Call =>
+            null;
+         when others =>
+            Failed ("Parameter_Association_Chain", Target);
+      end case;
+   end Check_Kind_For_Parameter_Association_Chain;
+
+   function Get_Parameter_Association_Chain (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Parameter_Association_Chain (Target);
+      return Get_Field2 (Target);
+   end Get_Parameter_Association_Chain;
+
+   procedure Set_Parameter_Association_Chain (Target : Iir; Chain : Iir) is
+   begin
+      Check_Kind_For_Parameter_Association_Chain (Target);
+      Set_Field2 (Target, Chain);
+   end Set_Parameter_Association_Chain;
+
+   procedure Check_Kind_For_Method_Object (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Procedure_Call
+           | Iir_Kind_Function_Call =>
+            null;
+         when others =>
+            Failed ("Method_Object", Target);
+      end case;
+   end Check_Kind_For_Method_Object;
+
+   function Get_Method_Object (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Method_Object (Target);
+      return Get_Field4 (Target);
+   end Get_Method_Object;
+
+   procedure Set_Method_Object (Target : Iir; Object : Iir) is
+   begin
+      Check_Kind_For_Method_Object (Target);
+      Set_Field4 (Target, Object);
+   end Set_Method_Object;
+
+   procedure Check_Kind_For_Type_Mark (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_File_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_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_Subtype_Definition
+           | Iir_Kind_Qualified_Expression
+           | Iir_Kind_Type_Conversion =>
+            null;
+         when others =>
+            Failed ("Type_Mark", Target);
+      end case;
+   end Check_Kind_For_Type_Mark;
+
+   function Get_Type_Mark (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Type_Mark (Target);
+      return Get_Field2 (Target);
+   end Get_Type_Mark;
+
+   procedure Set_Type_Mark (Target : Iir; Mark : Iir) is
+   begin
+      Check_Kind_For_Type_Mark (Target);
+      Set_Field2 (Target, Mark);
+   end Set_Type_Mark;
+
+   procedure Check_Kind_For_Lexical_Layout (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration =>
+            null;
+         when others =>
+            Failed ("Lexical_Layout", Target);
+      end case;
+   end Check_Kind_For_Lexical_Layout;
+
+   function Get_Lexical_Layout (Decl : Iir) return Iir_Lexical_Layout_Type is
+   begin
+      Check_Kind_For_Lexical_Layout (Decl);
+      return Iir_Lexical_Layout_Type'Val (Get_Odigit1 (Decl));
+   end Get_Lexical_Layout;
+
+   procedure Set_Lexical_Layout (Decl : Iir; Lay : Iir_Lexical_Layout_Type) is
+   begin
+      Check_Kind_For_Lexical_Layout (Decl);
+      Set_Odigit1 (Decl, Iir_Lexical_Layout_Type'Pos (Lay));
+   end Set_Lexical_Layout;
+
+   procedure Check_Kind_For_Incomplete_Type_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Incomplete_Type_Definition =>
+            null;
+         when others =>
+            Failed ("Incomplete_Type_List", Target);
+      end case;
+   end Check_Kind_For_Incomplete_Type_List;
+
+   function Get_Incomplete_Type_List (Target : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Incomplete_Type_List (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
+      Check_Kind_For_Incomplete_Type_List (Target);
+      Set_Field2 (Target, Iir_List_To_Iir (List));
+   end Set_Incomplete_Type_List;
+
+   procedure Check_Kind_For_Has_Disconnect_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Signal_Interface_Declaration =>
+            null;
+         when others =>
+            Failed ("Has_Disconnect_Flag", Target);
+      end case;
+   end Check_Kind_For_Has_Disconnect_Flag;
+
+   function Get_Has_Disconnect_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Has_Disconnect_Flag (Target);
+      return Get_Flag1 (Target);
+   end Get_Has_Disconnect_Flag;
+
+   procedure Set_Has_Disconnect_Flag (Target : Iir; Val : Boolean) is
+   begin
+      Check_Kind_For_Has_Disconnect_Flag (Target);
+      Set_Flag1 (Target, Val);
+   end Set_Has_Disconnect_Flag;
+
+   procedure Check_Kind_For_Has_Active_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            null;
+         when others =>
+            Failed ("Has_Active_Flag", Target);
+      end case;
+   end Check_Kind_For_Has_Active_Flag;
+
+   function Get_Has_Active_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Has_Active_Flag (Target);
+      return Get_Flag2 (Target);
+   end Get_Has_Active_Flag;
+
+   procedure Set_Has_Active_Flag (Target : Iir; Val : Boolean) is
+   begin
+      Check_Kind_For_Has_Active_Flag (Target);
+      Set_Flag2 (Target, Val);
+   end Set_Has_Active_Flag;
+
+   procedure Check_Kind_For_Is_Within_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Declaration
+           | 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 =>
+            null;
+         when others =>
+            Failed ("Is_Within_Flag", Target);
+      end case;
+   end Check_Kind_For_Is_Within_Flag;
+
+   function Get_Is_Within_Flag (Target : Iir) return Boolean is
+   begin
+      Check_Kind_For_Is_Within_Flag (Target);
+      return Get_Flag5 (Target);
+   end Get_Is_Within_Flag;
+
+   procedure Set_Is_Within_Flag (Target : Iir; Val : Boolean) is
+   begin
+      Check_Kind_For_Is_Within_Flag (Target);
+      Set_Flag5 (Target, Val);
+   end Set_Is_Within_Flag;
+
+   procedure Check_Kind_For_Type_Marks_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Signature =>
+            null;
+         when others =>
+            Failed ("Type_Marks_List", Target);
+      end case;
+   end Check_Kind_For_Type_Marks_List;
+
+   function Get_Type_Marks_List (Target : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Type_Marks_List (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
+      Check_Kind_For_Type_Marks_List (Target);
+      Set_Field2 (Target, Iir_List_To_Iir (List));
+   end Set_Type_Marks_List;
+
+   procedure Check_Kind_For_Signature (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Attribute_Name =>
+            null;
+         when others =>
+            Failed ("Signature", Target);
+      end case;
+   end Check_Kind_For_Signature;
+
+   function Get_Signature (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Signature (Target);
+      return Get_Field5 (Target);
+   end Get_Signature;
+
+   procedure Set_Signature (Target : Iir; Value : Iir) is
+   begin
+      Check_Kind_For_Signature (Target);
+      Set_Field5 (Target, Value);
+   end Set_Signature;
+
+   procedure Check_Kind_For_Overload_List (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Overload_List =>
+            null;
+         when others =>
+            Failed ("Overload_List", Target);
+      end case;
+   end Check_Kind_For_Overload_List;
+
+   function Get_Overload_List (Target : Iir) return Iir_List is
+   begin
+      Check_Kind_For_Overload_List (Target);
+      return Iir_To_Iir_List (Get_Field1 (Target));
+   end Get_Overload_List;
+
+   procedure Set_Overload_List (Target : Iir; List : Iir_List) is
+   begin
+      Check_Kind_For_Overload_List (Target);
+      Set_Field1 (Target, Iir_List_To_Iir (List));
+   end Set_Overload_List;
+
+   procedure Check_Kind_For_Simple_Name_Identifier (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Simple_Name_Attribute =>
+            null;
+         when others =>
+            Failed ("Simple_Name_Identifier", Target);
+      end case;
+   end Check_Kind_For_Simple_Name_Identifier;
+
+   function Get_Simple_Name_Identifier (Target : Iir) return Name_Id is
+   begin
+      Check_Kind_For_Simple_Name_Identifier (Target);
+      return Iir_To_Name_Id (Get_Field2 (Target));
+   end Get_Simple_Name_Identifier;
+
+   procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id) is
+   begin
+      Check_Kind_For_Simple_Name_Identifier (Target);
+      Set_Field2 (Target, Name_Id_To_Iir (Ident));
+   end Set_Simple_Name_Identifier;
+
+   procedure Check_Kind_For_Protected_Type_Body (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Protected_Type_Declaration =>
+            null;
+         when others =>
+            Failed ("Protected_Type_Body", Target);
+      end case;
+   end Check_Kind_For_Protected_Type_Body;
+
+   function Get_Protected_Type_Body (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Protected_Type_Body (Target);
+      return Get_Field2 (Target);
+   end Get_Protected_Type_Body;
+
+   procedure Set_Protected_Type_Body (Target : Iir; Bod : Iir) is
+   begin
+      Check_Kind_For_Protected_Type_Body (Target);
+      Set_Field2 (Target, Bod);
+   end Set_Protected_Type_Body;
+
+   procedure Check_Kind_For_Protected_Type_Declaration (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Protected_Type_Body =>
+            null;
+         when others =>
+            Failed ("Protected_Type_Declaration", Target);
+      end case;
+   end Check_Kind_For_Protected_Type_Declaration;
+
+   function Get_Protected_Type_Declaration (Target : Iir) return Iir is
+   begin
+      Check_Kind_For_Protected_Type_Declaration (Target);
+      return Get_Field4 (Target);
+   end Get_Protected_Type_Declaration;
+
+   procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir) is
+   begin
+      Check_Kind_For_Protected_Type_Declaration (Target);
+      Set_Field4 (Target, Decl);
+   end Set_Protected_Type_Declaration;
+
+   procedure Check_Kind_For_End_Location (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Design_Unit =>
+            null;
+         when others =>
+            Failed ("End_Location", Target);
+      end case;
+   end Check_Kind_For_End_Location;
+
+   function Get_End_Location (Target : Iir) return Location_Type is
+   begin
+      Check_Kind_For_End_Location (Target);
+      return Iir_To_Location_Type (Get_Field6 (Target));
+   end Get_End_Location;
+
+   procedure Set_End_Location (Target : Iir; Loc : Location_Type) is
+   begin
+      Check_Kind_For_End_Location (Target);
+      Set_Field6 (Target, Location_Type_To_Iir (Loc));
+   end Set_End_Location;
+
+   procedure Check_Kind_For_String_Id (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            null;
+         when others =>
+            Failed ("String_Id", Target);
+      end case;
+   end Check_Kind_For_String_Id;
+
+   function Get_String_Id (Lit : Iir) return String_Id is
+   begin
+      Check_Kind_For_String_Id (Lit);
+      return Iir_To_String_Id (Get_Field3 (Lit));
+   end Get_String_Id;
+
+   procedure Set_String_Id (Lit : Iir; Id : String_Id) is
+   begin
+      Check_Kind_For_String_Id (Lit);
+      Set_Field3 (Lit, String_Id_To_Iir (Id));
+   end Set_String_Id;
+
+   procedure Check_Kind_For_String_Length (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            null;
+         when others =>
+            Failed ("String_Length", Target);
+      end case;
+   end Check_Kind_For_String_Length;
+
+   function Get_String_Length (Lit : Iir) return Int32 is
+   begin
+      Check_Kind_For_String_Length (Lit);
+      return Iir_To_Int32 (Get_Field0 (Lit));
+   end Get_String_Length;
+
+   procedure Set_String_Length (Lit : Iir; Len : Int32) is
+   begin
+      Check_Kind_For_String_Length (Lit);
+      Set_Field0 (Lit, Int32_To_Iir (Len));
+   end Set_String_Length;
+
+   procedure Check_Kind_For_Use_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_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_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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration =>
+            null;
+         when others =>
+            Failed ("Use_Flag", Target);
+      end case;
+   end Check_Kind_For_Use_Flag;
+
+   function Get_Use_Flag (Decl : Iir) return Boolean is
+   begin
+      Check_Kind_For_Use_Flag (Decl);
+      return Get_Flag6 (Decl);
+   end Get_Use_Flag;
+
+   procedure Set_Use_Flag (Decl : Iir; Val : Boolean) is
+   begin
+      Check_Kind_For_Use_Flag (Decl);
+      Set_Flag6 (Decl, Val);
+   end Set_Use_Flag;
+
+end Iirs;
diff --git a/iirs.adb.in b/iirs.adb.in
new file mode 100644
index 000000000..3af6920a4
--- /dev/null
+++ b/iirs.adb.in
@@ -0,0 +1,316 @@
+--  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 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 Ada.Unchecked_Conversion;
+with Ada.Text_IO;
+with Errorout; use Errorout;
+with Nodes; use Nodes;
+with Lists; use Lists;
+
+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 --
+   ---------------------------------------------------
+
+   -- This is the procedure to call when an internal consistancy test has
+   -- failed.
+   -- The main idea is the consistancy test *MUST* have no side effect,
+   -- except calling this procedure.  To speed up, this procedure could
+   -- be a no-op.
+   procedure Failed (Func: String := ""; Node : Iir := Null_Iir)
+   is
+   begin
+      if Func /= "" then
+         Error_Kind (Func, Node);
+      end if;
+      raise Internal_Error;
+   end Failed;
+
+   function Get_Format (Kind : Iir_Kind) return Format_Type;
+
+   --  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_Proxy (Proxy: Iir) return Iir_Proxy is
+      Res : Iir_Proxy;
+   begin
+      Res := Create_Iir (Iir_Kind_Proxy);
+      Set_Proxy (Res, Proxy);
+      return Res;
+   end Create_Proxy;
+
+   --
+
+   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 Clone_Iir (Src : Iir; New_Kind : Iir_Kind) return Iir
+--    is
+--       Res : Iir;
+--    begin
+--       Res := new Iir_Node (New_Kind);
+--       Res.Flag1 := Src.Flag1;
+--       Res.Flag2 := Src.Flag2;
+--       Res.Flag3 := Src.Flag3;
+--       Res.Flag4 := Src.Flag4;
+--       Res.Flag5 := Src.Flag5;
+--       Res.Flag6 := Src.Flag6;
+--       Res.Flag7 := Src.Flag7;
+--       Res.Flag8 := Src.Flag8;
+--       Res.State1 := Src.State1;
+--       Res.State2 := Src.State2;
+--       Res.State3 := Src.State3;
+--       Res.Staticness1 := Src.Staticness1;
+--       Res.Staticness2 := Src.Staticness2;
+--       Res.Odigit1 := Src.Odigit1;
+--       Res.Odigit2 := Src.Odigit2;
+--       Res.Location := Src.Location;
+--       Res.Back_End_Info := Src.Back_End_Info;
+--       Res.Identifier := Src.Identifier;
+--       Res.Field1 := Src.Field1;
+--       Res.Field2 := Src.Field2;
+--       Res.Field3 := Src.Field3;
+--       Res.Field4 := Src.Field4;
+--       Res.Field5 := Src.Field5;
+--       Res.Nbr2 := Src.Nbr2;
+--       Res.Nbr3 := Src.Nbr3;
+
+--       Src.Identifier := Null_Identifier;
+--       Src.Field1 := null;
+--       Src.Field2 := null;
+--       Src.Field3 := null;
+--       Src.Field4 := null;
+--       Src.Field5 := null;
+--       return Res;
+--    end Clone_Iir;
+
+
+   -----------------
+   -- design file --
+   -----------------
+
+   -- Iir_Design_File
+
+--   type Int_Access_Type is new Integer;
+--   for Int_Access_Type'Size use System.Word_Size; --Iir_Identifier_Acc'Size;
+
+   --  Safe conversions.
+--    function Iir_To_Int_Access_Type is
+--       new Ada.Unchecked_Conversion (Source => Iir,
+--                                     Target => Int_Access_Type);
+--    function Int_Access_Type_To_Iir is
+--       new Ada.Unchecked_Conversion (Source => Int_Access_Type,
+--                                     Target => Iir);
+
+--    function To_Iir (V : Integer) return Iir is
+--    begin
+--       return Int_Access_Type_To_Iir (Int_Access_Type (V));
+--    end To_Iir;
+
+--    function To_Integer (N : Iir) return Integer is
+--    begin
+--       return Integer (Iir_To_Int_Access_Type (N));
+--    end To_Integer;
+
+   procedure Set_Pos_Line_Off (Design_Unit: Iir_Design_Unit;
+                               Pos : Source_Ptr; Line, Off: Natural) is
+   begin
+      Set_Field1 (Design_Unit, Node_Type (Pos));
+      Set_Field11 (Design_Unit, Node_Type (Off));
+      Set_Field12 (Design_Unit, Node_Type (Line));
+   end Set_Pos_Line_Off;
+
+   procedure Get_Pos_Line_Off (Design_Unit: Iir_Design_Unit;
+                               Pos : out Source_Ptr; Line, Off: out Natural) is
+   begin
+      Pos := Source_Ptr (Get_Field1 (Design_Unit));
+      Off := Natural (Get_Field11 (Design_Unit));
+      Line := Natural (Get_Field12 (Design_Unit));
+   end Get_Pos_Line_Off;
+
+   -----------
+   -- Lists --
+   -----------
+   --  Layout of lists:
+   --  A list is stored into an IIR.
+   --  There are two bounds for a list:
+   --    the current number of elements
+   --    the maximum number of elements.
+   --  Using a maximum number of element bound (which can be increased) avoid
+   --  to reallocating memory at each insertion.
+
+   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_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);
+
+   --  Subprograms
+end Iirs;
diff --git a/iirs.ads b/iirs.ads
new file mode 100644
index 000000000..cdf471324
--- /dev/null
+++ b/iirs.ads
@@ -0,0 +1,4920 @@
+--  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 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 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_declaration
+   -- ...
+
+   -- 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
+   --   add a declaration of access type of name iir_kind_NAME_acc
+   --   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 create_iir and free_iir
+   --   add an entry in disp_tree (debugging)
+
+   -------------------------------------------------
+   -- 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;
+   --
+   --   function Get_Line_Number (Target: Iir) return Natural;
+   --   function Get_Column_Number (Target: Iir) return natural;
+   --   function Get_File_Name (Target: in Iir) return name_id;
+   --
+   -- Copy a location from a node to another one.
+   --   procedure Location_Copy (Target: in out Iir; Src: in Iir);
+
+   -- Get or Set info for a back-end.
+   --   function  Get_Back_End_Info (Target: in Iir) return System.Address;
+   --   procedure Set_Back_End_Info (Target: in out Iir; Addr: System.Address);
+
+
+   -- 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_Context_Items (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   -- 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_Pos_Line_Off (Field1,Field11,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)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Library_Clause (Short)
+   -- 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)
+
+   --------------
+   -- Literals --
+   --------------
+
+   -- Iir_Kind_Character_Literal (Short)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Type (Field1)
+
+   -- Iir_Kind_String_Literal (Short)
+   -- Iir_Kind_Bit_String_Literal (Medium)
+   --
+   -- Type of the literal.  Note: for a (bit_)string_literal, the type must be
+   -- computed during semantization.  Roughly speaking, this is possible since
+   -- integer type range constraint are locally static.
+   --   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)
+   --
+   --   Get/Set_String_Length (Field0)
+   --
+   -- 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 (Field4)
+   -- Only for Iir_Kind_Bit_String_Literal:
+   --   Get/Set_Bit_String_1 (Field5)
+   --
+   -- Only for Iir_Kind_Bit_String_Literal:
+   --   Get/Set_Bit_String_Base (Field11)
+   --
+   --   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)
+   --
+   -- Get/Set 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)
+   --
+   -- Get/Set 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)
+
+   ------------
+   -- Tuples --
+   ------------
+
+   -- Iir_Kind_Association_Element_By_Expression (Short)
+   -- Iir_Kind_Association_Element_Open (Short)
+   -- Iir_Kind_Association_Element_By_Individual (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:
+   --   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_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, see LRM 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_Proxy (Short)
+   -- A proxy is used to avoid duplication of a node.
+   -- Ex: instead of copying a default value of an insterface in the subprogram
+   -- call, a proxy is used.  The default value can't be so easily aliased
+   -- due to annotation.
+   --
+   -- Create a proxy for PROXY.
+   --   function Create_Proxy (Proxy: Iir) return Iir_Proxy;
+   --
+   -- Get/Set the value of the proxy.
+   --   Get/Set_Proxy (Field1)
+
+   -- 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)
+   --
+   -- 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.  This can be:
+   -- * a waveform_chain for a concurrent_select_signal_assignment,
+   -- * an expression for an aggregate,
+   -- * a sequential statement list for a case_statement.
+   -- For a list of choices, only the first one is associated, the following
+   -- associations have the same_alternative_flag set.
+   --   Get/Set_Associated (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   -- Only for Iir_Kind_Choice_By_Name:
+   -- Get/Set the name.
+   --   Get/Set_Name (Field4)
+   --
+   -- Only for Iir_Kind_Choice_By_Expression:
+   --   Get/Set_Expression (Field5)
+   --
+   -- Only for Iir_Kind_Choice_By_Range:
+   -- Get/Set the range.
+   --   Get/Set_Expression (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)
+   --
+   -- Parse: a name
+   -- Sem: a design unit
+   --   Get/Set_Entity (Field4)
+   --
+   -- parse: a simple name.
+   -- sem: an architecture declaration or NULL_IIR.
+   --   Get/Set_Architecture (Field2)
+
+   -- Iir_Kind_Entity_Aspect_Open (Short)
+
+   -- Iir_Kind_Entity_Aspect_Configuration (Short)
+   --
+   -- Parse: a name
+   -- Sem: a design unit
+   --   Get/Set_Configuration (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 a selected_name, whose identifier 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)
+   --
+   -- 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)
+   --
+   -- The declaration containing this type declaration.
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Signal_List (Field4)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Chain (Field2)
+
+   -- 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)
+   --
+   --   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)
+   --
+   --   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_Selected_Element (Short)
+   -- A record element selection.
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   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_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Signature (Short)
+   --
+   --   Get/Set_Return_Type (Field1)
+   --
+   --   Get/Set_Type_Marks_List (Field2)
+   --
+   -- Used only for attribute specification.
+   --   Get/Set_Name (Field4)
+
+   -- 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_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Concurrent_Statement_Chain (Field5)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   Get/Set_Port_Chain (Field7)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+
+   -- Iir_Kind_Architecture_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   -- Set the entity of an architecture.
+   -- Before the semantic pass, it can be a name.
+   --   Get/Set_Entity (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_Is_Within_Flag (Flag5)
+
+   -- Iir_Kind_Configuration_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   -- Set the entity of a configuration (a design_unit)
+   -- Before the semantic pass, it can be an identifier.
+   --   Get/Set_Entity (Field4)
+   --
+   --   Get/Set_Block_Configuration (Field5)
+
+   -- Iir_Kind_Package_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Package_Body (Field4)
+   --
+   --   Get/Set_Need_Body (Flag1)
+
+   -- 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_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Package (Field4)
+
+   -- 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)
+
+   -- Iir_Kind_Object_Alias_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Name (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- 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_Signature (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Anonymous_Type_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   -- Used for informative purpose only.
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Subtype_Definition (Field4)
+
+   -- Iir_Kind_Type_Declaration (Short)
+   --
+   --   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 (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)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (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_Signal_Interface_Declaration (Medium)
+   -- Iir_Kind_Constant_Interface_Declaration (Medium)
+   -- Iir_Kind_Variable_Interface_Declaration (Medium)
+   -- Iir_Kind_File_Interface_Declaration (Medium)
+   --
+   -- Note: If type is an iir_kind_proxy node, then type *and* default value
+   -- (if any) must be extracted from proxy.
+   --
+   -- 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)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   -- Must always be null_iir for iir_kind_file_interface_declaration.
+   --   Get/Set_Default_Value (Field6)
+   --
+   --   Get/Set_Lexical_Layout (Odigit1)
+   --
+   --   Get/Set_Mode (Odigit2)
+   --
+   -- Only for Iir_Kind_Signal_Interface_Declaration:
+   --   Get/Set_Has_Disconnect_Flag (Flag1)
+   --
+   -- Only for Iir_Kind_Signal_Interface_Declaration:
+   --   Get/Set_Has_Active_Flag (Flag2)
+   --
+   -- Only for Iir_Kind_Signal_Interface_Declaration:
+   --   Get/Set_Open_Flag (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   -- Only for Iir_Kind_Signal_Interface_Declaration:
+   --   Get/Set_Signal_Kind (State4)
+
+   -- Iir_Kind_Function_Declaration (Medium)
+   -- Iir_Kind_Procedure_Declaration (Medium)
+   --
+   -- Subprogram declaration.
+   --
+   -- The declaration containing this type 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_Interface_Declaration_Chain (Field5)
+   --
+   --   Get/Set_Subprogram_Body (Field6)
+   --
+   --   Get/Set_Callees_List (Field7)
+   --
+   -- FIXME: to be removed.
+   --   Get/Set_Driver_List (Field8)
+   --
+   --   Get/Set_Overload_Number (Field9)
+   --
+   --   Get/Set_Subprogram_Depth (Field10)
+   --
+   --   Get/Set_Subprogram_Hash (Field11)
+   --
+   --   Get/Set_Extra_Info (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_Procedure_Declaration:
+   --   Get/Set_Purity_State (State3)
+   --
+   --   Get/Set_Wait_State (State1)
+
+   -- Iir_Kind_Function_Body (Short)
+   -- Iir_Kind_Procedure_Body (Short)
+   --
+   --   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_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Impure_Depth (Field3)
+   --
+   --   Get/Set_Subprogram_Specification (Field4)
+   --
+   --   Get/Set_Sequential_Statement_Chain (Field5)
+
+   -- 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_Interface_Declaration_Chain (Field5)
+   --
+   --   Get/Set_Implicit_Definition (Field6)
+   --
+   --   Get/Set_Callees_List (Field7)
+   --
+   --   Get/Set_Type_Reference (Field8)
+   --
+   --   Get/Set_Overload_Number (Field9)
+   --
+   --   Get/Set_Subprogram_Hash (Field11)
+   --
+   --   Get/Set_Extra_Info (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_Base_Name (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_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 (State4)
+
+   -- 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_Base_Name (Field5)
+   --
+   --   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 (State4)
+
+   -- 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)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   -- 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_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   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_Base_Name (Field5)
+   --
+   --   Get/Set_Default_Value (Field6)
+   --
+   -- True if the variable is a shared variable.
+   --   Get/Set_Shared_Flag (Flag2)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_File_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_Base_Name (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 (Odigit2)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Element_Declaration (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (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)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   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 constituent.
+   --   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_Use_Clause (Short)
+   --
+   --   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)
+   --
+   -- Get/Set the base type.
+   -- For a subtype, it returns the type.
+   -- For a type, it must return the type itself.
+   --   Get/Set_Base_Type (Field4)
+   --
+   -- Get/Set 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)
+   --
+   -- Get/Set the resolved flag of a subtype, according to LRM93 2.4
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   -- Get/Set 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)
+
+   -- 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_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)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   -- 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)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Physical_Type_Definition (Short)
+   --
+   --   Get/Set_Unit_Chain (Field1)
+   --   Get_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_Type_Staticness (State1)
+
+   -- Iir_Kind_Unit_Declaration (Medium)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Physical_Literal (Field6)
+   --
+   --   Get/Set_Physical_Unit_Value (Field7)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Integer_Type_Definition (Short)
+   -- Iir_Kind_Floating_Type_Definition (Short)
+   --
+   -- Get/Set the declarator that has created this integer 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)
+
+   -- Iir_Kind_Array_Type_Definition (Medium)
+   -- This defines an unconstrained array type.
+   --
+   --   Get/Set_Element_Subtype (Field1)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Index_Subtype_List (Field6)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+
+   -- Iir_Kind_Record_Type_Definition (Short)
+   --
+   --   Get/Set_Number_Element_Declaration (Field1)
+   --
+   --   Get/Set_Element_Declaration_Chain (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)
+
+   -- Iir_Kind_Access_Type_Definition (Short)
+   --
+   --   Get/Set_Designated_Type (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   -- FIXME: Only for access_subtype.
+   -- FIXME:  Get/Set_Resolution_Function (Field5)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Type_Staticness (State1)
+
+   -- Iir_Kind_File_Type_Definition (Short)
+   --
+   -- True if this is the std.textio.text file type, which may require special
+   -- handling.
+   --   Get/Set_Text_File_Flag (Flag3)
+   --
+   --   Get/Set_Type_Mark (Field2)
+   --
+   --   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_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)
+
+   -- 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)
+
+   -- 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)
+
+   -------------------------
+   -- subtype definitions --
+   -------------------------
+
+   -- Iir_Kind_Enumeration_Subtype_Definition (Short)
+   -- Iir_Kind_Integer_Subtype_Definition (Short)
+   -- Iir_Kind_Floating_Subtype_Definition (Short)
+   -- Iir_Kind_Physical_Subtype_Definition (Short)
+   --
+   --   Get/Set_Range_Constraint (Field1)
+   --
+   --   Get/Set_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolution_Function (Field5)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Type_Staticness (State1)
+
+   -- Iir_Kind_Access_Subtype_Definition (Short)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   -- Note: no resolution function for access subtype.
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+
+   -- Iir_Kind_Record_Subtype_Definition (Short)
+   --
+   --   Get/Set_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolution_Function (Field5)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Type_Staticness (State1)
+
+   -- Iir_Kind_Array_Subtype_Definition (Medium)
+   -- Iir_Kind_Unconstrained_Array_Subtype_Definition (Medium)
+   --
+   -- Iir_Kind_Array_Subtype_definition defines a constrained array
+   -- subtype, which *must* be a subtype of an iir_array_type_definition.
+   --
+   -- Iir_Kind_Unconstrained_Array_Subtype_Definition defines a
+   -- unconstrained array subtype, which *must* be a subtype of an
+   -- iir_array_type_definition.  The only way to create such a
+   -- subtype is via a subtype declaration, without adding
+   -- constraints.
+   --
+   --   Get/Set_Element_Subtype (Field1)
+   --
+   --   Get/Set_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolution_Function (Field5)
+   --
+   --   Get/Set_Index_Subtype_List (Field6)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+
+   -- Iir_Kind_Range_Expression (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Left_Limit (Field2)
+   --
+   --   Get/Set_Right_Limit (Field3)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Direction (State2)
+
+   -- Iir_Kind_Subtype_Definition (Short)
+   -- 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_Type_Mark (Field2)
+   --
+   --   Get/Set_Resolution_Function (Field5)
+
+   ---------------------------
+   -- 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_Guarded_Target_State (State4)
+
+   -- Iir_Kind_Sensitized_Process_Statement (Medium)
+   -- Iir_Kind_Process_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get_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_Sensitivity_List (Field6)
+   --
+   --   Get/Set_Callees_List (Field7)
+   --
+   --   Get/Set_Driver_List (Field8)
+   --
+   --   Get/Set_Extra_Info (Field12)
+   --
+   --   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)
+
+   -- 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_Component_Instantiation_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   -- Unit instantiated.
+   -- Parse: a name, a entity_aspect_entity or a entity_aspect_configuration
+   -- Sem: the component declaration or the design unit.
+   --   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_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)
+
+   -- Iir_Kind_Generate_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get_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)
+
+   ---------------------------
+   -- 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)
+
+   -- Iir_Kind_For_Loop_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Iterator_Scheme (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)
+
+   -- 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)
+
+   -- Iir_Kind_Exit_Statement (Short)
+   -- Iir_Kind_Next_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)
+   --
+   -- Label identifier after parse.
+   --   Get/Set_Loop (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_Guarded_Target_State (State4)
+
+   -- 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)
+   --
+   --   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)
+
+   -- 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_Parent (Field0)
+   --
+   --   Get/Set_Parameter_Association_Chain (Field2)
+   --
+   --   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_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)
+   --
+   --   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 aggregate bounds 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 maximum number of elements, if any.
+   --   Get/Set_Aggr_Max_Length (Field4)
+   --
+   -- True if the choice list has an 'others' choice.
+   --   Get/Set_Aggr_Others_Flag (Flag2)
+
+   -- Iir_Kind_Qualified_Expression (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Type_Mark (Field2)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Type_Conversion (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Type_Mark (Field2)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Allocator_By_Expression (Short)
+   -- Iir_Kind_Allocator_By_Subtype (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   -- Contains the expression for a by expression allocator or the
+   -- subtype indication for a by subtype allocator.
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -----------
+   -- names --
+   -----------
+
+   -- Iir_Kind_Simple_Name (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Selected_Name (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Suffix_Identifier (Field2)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Selected_By_All_Name (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Operator_Symbol (Short)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+
+   -- Iir_Kind_Indexed_Name (Short)
+   -- Select the element designed with the INDEX_LIST from array PREFIX.
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Index_List (Field2)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Slice_Name (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Suffix (Field2)
+   --
+   --   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.
+   --
+   -- Always returns null_iir.
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Association_Chain (Field2)
+
+   ----------------
+   -- attributes --
+   ----------------
+
+   -- Iir_Kind_Attribute_Name (Short)
+   --
+   --   Get/Set_Attribute_Identifier (Field2)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Signature (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Base_Attribute (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+
+   -- 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_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- 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_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Parameter (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- 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_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   -- Not used by Iir_Kind_Transaction_Attribute
+   --   Get/Set_Parameter (Field4)
+   --
+   --   Get/Set_Has_Active_Flag (Flag2)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   --   Get/Set_Base_Name (Field5)
+
+   -- 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_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   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_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Parameter (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Image_Attribute (Short)
+   -- Iir_Kind_Value_Attribute (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   --   Get/Set_Parameter (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Simple_Name_Attribute (Short)
+   -- Iir_Kind_Instance_Name_Attribute (Short)
+   -- Iir_Kind_Path_Name_Attribute (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Prefix (Field3)
+   --
+   -- Only for Iir_Kind_Simple_Name_Attribute:
+   --   Get/Set_Simple_Name_Identifier (Field2)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- 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)
+
+
+   -- End of Iir_Kind.
+
+
+   type Iir_Kind is
+      (
+   -- Erroneous IIR.
+       Iir_Kind_Error,
+
+       Iir_Kind_Design_File,
+       Iir_Kind_Design_Unit,
+       Iir_Kind_Library_Clause,
+       Iir_Kind_Use_Clause,
+
+   -- Literals.
+       Iir_Kind_Character_Literal,
+       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,
+
+   -- Tuple,
+       Iir_Kind_Proxy,
+       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_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_Operator_Symbol,
+
+       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_Unconstrained_Array_Subtype_Definition, -- composite, array, st
+       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
+       Iir_Kind_Floating_Subtype_Definition,            -- scalar, st
+       Iir_Kind_Integer_Subtype_Definition,             -- scalar, disc, st
+       Iir_Kind_Enumeration_Subtype_Definition,         -- scalar, disc, st
+       Iir_Kind_Integer_Type_Definition,                -- scalar, disc
+       Iir_Kind_Enumeration_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).
+
+   -- Lists.
+       Iir_Kind_Overload_List,  -- used internally by sem_expr.
+
+   -- Declarations.
+   --  iir_kinds_nonoverloadable_declaration
+       Iir_Kind_Type_Declaration,
+       Iir_Kind_Anonymous_Type_Declaration,
+       Iir_Kind_Subtype_Declaration,
+       Iir_Kind_Configuration_Declaration,
+       Iir_Kind_Entity_Declaration,
+       Iir_Kind_Package_Declaration,
+       Iir_Kind_Package_Body,
+       Iir_Kind_Architecture_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_Element_Declaration,
+       Iir_Kind_Non_Object_Alias_Declaration,
+
+       Iir_Kind_Function_Body,
+       Iir_Kind_Function_Declaration,
+       Iir_Kind_Implicit_Function_Declaration,
+       Iir_Kind_Implicit_Procedure_Declaration,
+       Iir_Kind_Procedure_Declaration,
+       Iir_Kind_Procedure_Body,
+       Iir_Kind_Enumeration_Literal,
+
+       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_Constant_Interface_Declaration, -- object, interface
+       Iir_Kind_Variable_Interface_Declaration, -- object, interface
+       Iir_Kind_Signal_Interface_Declaration,   -- object, interface
+       Iir_Kind_File_Interface_Declaration,     -- object, interface
+
+   -- Expressions.
+       Iir_Kind_Identity_Operator,
+       Iir_Kind_Negation_Operator,
+       Iir_Kind_Absolute_Operator,
+       Iir_Kind_Not_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_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_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,
+
+   -- 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_Concurrent_Procedure_Call_Statement,
+       Iir_Kind_Block_Statement,
+       Iir_Kind_Generate_Statement,
+       Iir_Kind_Component_Instantiation_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_Simple_Name,
+       Iir_Kind_Slice_Name,
+       Iir_Kind_Indexed_Name,
+       Iir_Kind_Selected_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_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_Range_Array_Attribute,          --  array_attribute
+       Iir_Kind_Reverse_Range_Array_Attribute,  --  array_attribute
+       Iir_Kind_Length_Array_Attribute,         --  array_attribute
+       Iir_Kind_Ascending_Array_Attribute,      --  array_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_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;
+   --               C: in constant bit;
+   --               D: inout bit;
+   --               E: variable bit;
+   --               F, G: in bit;
+   --               H, I: constant bit;
+   --               J, K: in constant bit);
+   --  A:
+   --  B:                         has_type
+   --  C, K: has_mode, has_class, has_type
+   --  D:    has_mode,            has_type
+   --  E, I:           has_class, has_type
+   --  F:    has_mode
+   --  G:    has_mode,            has_type
+   --  H:              has_class
+   --  J:    has_mode, has_class
+   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,
+
+   --  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,
+
+   --  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,
+
+   --  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,
+
+   --  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,
+
+   --  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,
+
+   --  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,
+
+   --  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
+       Iir_Predefined_Bit_Array_And,
+       Iir_Predefined_Bit_Array_Or,
+       Iir_Predefined_Bit_Array_Nand,
+       Iir_Predefined_Bit_Array_Nor,
+       Iir_Predefined_Bit_Array_Xor,
+       Iir_Predefined_Bit_Array_Xnor,
+       Iir_Predefined_Bit_Array_Not,
+
+       Iir_Predefined_Boolean_Array_And,
+       Iir_Predefined_Boolean_Array_Or,
+       Iir_Predefined_Boolean_Array_Nand,
+       Iir_Predefined_Boolean_Array_Nor,
+       Iir_Predefined_Boolean_Array_Xor,
+       Iir_Predefined_Boolean_Array_Xnor,
+       Iir_Predefined_Boolean_Array_Not,
+
+   --  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_Low,
+       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_Write,
+       Iir_Predefined_Endfile,
+
+   --  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_Bit_Array_Functions
+   is Iir_Predefined_Functions range
+     Iir_Predefined_Bit_Array_And ..
+   --Iir_Predefined_Bit_Array_Or
+   --Iir_Predefined_Bit_Array_Nand
+   --Iir_Predefined_Bit_Array_Nor
+   --Iir_Predefined_Bit_Array_Xor
+     Iir_Predefined_Bit_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;
+
+   -- 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);
+
+   ---------------
+   -- 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_Configuration_Declaration ..
+   --Iir_Kind_Entity_Declaration
+   --Iir_Kind_Package_Declaration
+   --Iir_Kind_Package_Body
+     Iir_Kind_Architecture_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_Character_Literal ..
+   --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_Unconstrained_Array_Subtype_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_Unconstrained_Array_Subtype_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_Integer_Type_Definition
+   --Iir_Kind_Enumeration_Type_Definition
+   --Iir_Kind_Floating_Type_Definition
+     Iir_Kind_Physical_Type_Definition;
+
+   subtype Iir_Kinds_Subtype_Definition is Iir_Kind range
+     Iir_Kind_Unconstrained_Array_Subtype_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;
+
+   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_Integer_Type_Definition
+   --Iir_Kind_Enumeration_Type_Definition
+   --Iir_Kind_Floating_Type_Definition
+     Iir_Kind_Physical_Type_Definition;
+
+   subtype Iir_Kinds_Discrete_Type_Definition is Iir_Kind range
+     Iir_Kind_Integer_Subtype_Definition ..
+   --Iir_Kind_Enumeration_Subtype_Definition
+   --Iir_Kind_Integer_Type_Definition
+     Iir_Kind_Enumeration_Type_Definition;
+
+   subtype Iir_Kinds_Composite_Type_Definition is Iir_Kind range
+     Iir_Kind_Record_Type_Definition ..
+   --Iir_Kind_Array_Type_Definition
+   --Iir_Kind_Unconstrained_Array_Subtype_Definition
+   --Iir_Kind_Array_Subtype_Definition
+     Iir_Kind_Record_Subtype_Definition;
+
+   subtype Iir_Kinds_Unconstrained_Array_Type_Definition is Iir_Kind range
+     Iir_Kind_Array_Type_Definition ..
+     Iir_Kind_Unconstrained_Array_Subtype_Definition;
+
+   subtype Iir_Kinds_Array_Subtype_Definition is Iir_Kind range
+     Iir_Kind_Unconstrained_Array_Subtype_Definition ..
+     Iir_Kind_Array_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;
+
+   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_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_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_Process_Statement is Iir_Kind range
+     Iir_Kind_Sensitized_Process_Statement ..
+     Iir_Kind_Process_Statement;
+
+   subtype Iir_Kinds_Interface_Declaration is Iir_Kind range
+     Iir_Kind_Constant_Interface_Declaration ..
+   --Iir_Kind_Variable_Interface_Declaration
+   --Iir_Kind_Signal_Interface_Declaration
+     Iir_Kind_File_Interface_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_Constant_Interface_Declaration
+   --Iir_Kind_Variable_Interface_Declaration
+   --Iir_Kind_Signal_Interface_Declaration
+     Iir_Kind_File_Interface_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_Constant_Interface_Declaration
+   --Iir_Kind_Variable_Interface_Declaration
+   --Iir_Kind_Signal_Interface_Declaration
+     Iir_Kind_File_Interface_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_Name is Iir_Kind range
+     Iir_Kind_Simple_Name ..
+   --Iir_Kind_Slice_Name
+   --Iir_Kind_Indexed_Name
+   --Iir_Kind_Selected_Name
+   --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_Left_Array_Attribute
+   --Iir_Kind_Right_Array_Attribute
+   --Iir_Kind_High_Array_Attribute
+   --Iir_Kind_Low_Array_Attribute
+   --Iir_Kind_Range_Array_Attribute
+   --Iir_Kind_Reverse_Range_Array_Attribute
+   --Iir_Kind_Length_Array_Attribute
+   --Iir_Kind_Ascending_Array_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;
+
+   subtype Iir_Kinds_Attribute is Iir_Kind range
+     Iir_Kind_Base_Attribute ..
+     Iir_Kind_Path_Name_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_Range_Array_Attribute
+   --Iir_Kind_Reverse_Range_Array_Attribute
+   --Iir_Kind_Length_Array_Attribute
+     Iir_Kind_Ascending_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_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_Configuration_Declaration
+   --Iir_Kind_Entity_Declaration
+   --Iir_Kind_Package_Declaration
+   --Iir_Kind_Package_Body
+   --Iir_Kind_Architecture_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_Element_Declaration
+   --Iir_Kind_Non_Object_Alias_Declaration
+   --Iir_Kind_Function_Body
+   --Iir_Kind_Function_Declaration
+   --Iir_Kind_Implicit_Function_Declaration
+   --Iir_Kind_Implicit_Procedure_Declaration
+   --Iir_Kind_Procedure_Declaration
+   --Iir_Kind_Procedure_Body
+   --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_Constant_Interface_Declaration
+   --Iir_Kind_Variable_Interface_Declaration
+   --Iir_Kind_Signal_Interface_Declaration
+     Iir_Kind_File_Interface_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_Unconstrained_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;
+
+   -- Tuples.
+   subtype Iir_Proxy 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_Driver_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_Signal_Interface_Declaration is Iir;
+
+   subtype Iir_Architecture_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_Constant_Interface_Declaration is Iir;
+
+   subtype Iir_Variable_Interface_Declaration is Iir;
+
+   subtype Iir_File_Interface_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
+   function Get_First_Design_Unit (Design : Iir) return Iir;
+   procedure Set_First_Design_Unit (Design : Iir; Chain : Iir);
+
+   --  Field: Field6
+   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
+   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
+   function Get_Design_File (Unit : Iir_Design_Unit) return Iir_Design_File;
+   procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir_Design_File);
+
+   --  Design files of a library.
+   --  Field: Field1
+   function Get_Design_File_Chain (Library : Iir) return Iir_Design_File;
+   procedure Set_Design_File_Chain (Library : Iir; Chain : Iir_Design_File);
+
+   --  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
+   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.
+   --  Field: Field8 (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: State4 (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
+   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: Field1
+   -- Field: Field6
+   -- Field: Field7
+   procedure Set_Pos_Line_Off (Design_Unit: Iir_Design_Unit;
+                               Pos : Source_Ptr; Line, Off: Natural);
+   procedure Get_Pos_Line_Off (Design_Unit: Iir_Design_Unit;
+                               Pos : out Source_Ptr; Line, Off: out Natural);
+
+
+   --  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
+   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: Field11 (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: Field4
+   function Get_Bit_String_0 (Lit : Iir) return Iir_Enumeration_Literal;
+   procedure Set_Bit_String_0 (Lit : Iir; El : Iir_Enumeration_Literal);
+
+   --  Field: Field5
+   function Get_Bit_String_1 (Lit : Iir) return Iir_Enumeration_Literal;
+   procedure Set_Bit_String_1 (Lit : Iir; El : Iir_Enumeration_Literal);
+
+   --  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);
+
+   --  tuples.
+
+   function Create_Proxy (Proxy: Iir) return Iir_Proxy;
+
+   --  Field: Field1
+   function Get_Proxy (Target : Iir_Proxy) return Iir;
+   procedure Set_Proxy (Target : Iir_Proxy; Proxy : 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
+   function Get_Attribute_Specification (Val : Iir) return Iir;
+   procedure Set_Attribute_Specification (Val : Iir; Attr : Iir);
+
+   --  Field: Field4 (uc)
+   function Get_Signal_List (Target : Iir) return Iir_List;
+   procedure Set_Signal_List (Target : Iir; List : Iir_List);
+
+   --  Field: Field3
+   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);
+
+   --  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: Field1
+   function Get_Associated (Target : Iir) return Iir;
+   procedure Set_Associated (Target : Iir; Associated : 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: Field2
+   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
+   function Get_Prev_Block_Configuration (Target : Iir) return Iir;
+   procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir);
+
+   --  Field: Field3
+   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
+   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);
+
+   --  Field: Field4
+   function Get_Entity (Decl : Iir) return Iir;
+   procedure Set_Entity (Decl : Iir; Entity : Iir);
+
+   --  The package declaration corresponding to the body.
+   --  Field: Field4
+   function Get_Package (Package_Body : Iir) return Iir_Package_Declaration;
+   procedure Set_Package (Package_Body : Iir; Decl : Iir_Package_Declaration);
+
+   --  The package body corresponding to the package declaration.
+   --  Field: Field4
+   function Get_Package_Body (Pkg : Iir) return Iir_Package_Body;
+   procedure Set_Package_Body (Pkg : Iir; Decl : Iir_Package_Body);
+
+   --  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
+   function Get_Concurrent_Statement_Chain (Target : Iir) return Iir;
+   procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir);
+
+   --  Field: Field2
+   function Get_Chain (Target : Iir) return Iir;
+   procedure Set_Chain (Target : Iir; Chain : Iir);
+   pragma Inline (Get_Chain);
+
+   --  Field: Field7
+   function Get_Port_Chain (Target : Iir) return Iir;
+   procedure Set_Port_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field6
+   function Get_Generic_Chain (Target : Iir) return Iir;
+   procedure Set_Generic_Chain (Target : Iir; Generics : Iir);
+
+   --  Field: Field1
+   function Get_Type (Target : Iir) return Iir;
+   procedure Set_Type (Target : Iir; Atype : Iir);
+   pragma Inline (Get_Type);
+
+   --  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);
+
+   --  Mode of interfaces or file (v87).
+   --  Field: Odigit2 (pos)
+   function Get_Mode (Target : Iir) return Iir_Mode;
+   procedure Set_Mode (Target : Iir; Mode : Iir_Mode);
+
+   --  Field: State4 (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
+   function Get_Base_Name (Target : Iir) return Iir;
+   procedure Set_Base_Name (Target : Iir; Name : Iir);
+   pragma Inline (Get_Base_Name);
+
+   --  Field: Field5
+   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
+   function Get_Subprogram_Specification (Target : Iir) return Iir;
+   procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir);
+
+   --  Field: Field5
+   function Get_Sequential_Statement_Chain (Target : Iir) return Iir;
+   procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field6
+   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: Field9 (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);
+
+   --  Index for extra infos.
+   --  Subprograms and processes need a lot of field in their nodes.
+   --  Unfortunatly, the size of the nodes is limited and these infos are
+   --  only used for optimization.
+   --  This is an index into a separate table.
+   --  Field: Field12 (pos)
+   function Get_Extra_Info (Target : Iir) return Iir_Int32;
+   procedure Set_Extra_Info (Target : Iir; Info : Iir_Int32);
+
+   --  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
+   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: Field6 (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: Field8
+   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.
+   --  Field: Field6
+   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_Design_Unit;
+   procedure Set_Design_Unit (Target : Iir; Unit : Iir_Design_Unit);
+
+   --  Field: Field7
+   function Get_Block_Statement (Target : Iir) return Iir_Block_Statement;
+   procedure Set_Block_Statement (Target : Iir; Block : Iir_Block_Statement);
+
+   --  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
+   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_Selected_Element (Target : Iir) return Iir;
+   procedure Set_Selected_Element (Target : Iir; El : Iir);
+
+   --  Field: Field2 (uc)
+   function Get_Suffix_Identifier (Target : Iir) return Name_Id;
+   procedure Set_Suffix_Identifier (Target : Iir; Ident : Name_Id);
+
+   --  Field: Field2 (uc)
+   function Get_Attribute_Identifier (Target : Iir) return Name_Id;
+   procedure Set_Attribute_Identifier (Target : Iir; Ident : Name_Id);
+
+   --  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 TARGET.
+   --  Field: Field3
+   function Get_Type_Declarator (Target : Iir) return Iir;
+   procedure Set_Type_Declarator (Target : 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
+   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
+   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
+   function Get_Primary_Unit (Target : Iir) return 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
+   function Get_Base_Type (Decl : Iir) return Iir;
+   procedure Set_Base_Type (Decl : Iir; Base_Type : Iir);
+   pragma Inline (Get_Base_Type);
+
+   --  Field: Field5
+   function Get_Resolution_Function (Decl : Iir) return Iir;
+   procedure Set_Resolution_Function (Decl : Iir; Func : Iir);
+
+   --  Field: Flag3
+   function Get_Text_File_Flag (Target : Iir) return Boolean;
+   procedure Set_Text_File_Flag (Target : Iir; Flag : Boolean);
+
+   --  Field: State1 (pos)
+   function Get_Type_Staticness (Target : Iir) return Iir_Staticness;
+   procedure Set_Type_Staticness (Target : Iir; Static : Iir_Staticness);
+
+   --  Field: Field6 (uc)
+   function Get_Index_Subtype_List (Decl : Iir) return Iir_List;
+   procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List);
+
+   --  Field: Field2 (uc)
+   function Get_Index_List (Decl : Iir) return Iir_List;
+   procedure Set_Index_List (Decl : Iir; List : Iir_List);
+
+   --  Field: Field1
+   function Get_Element_Subtype (Decl : Iir) return Iir;
+   procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir);
+
+   --  Chains of elements of a record.
+   --  Field: Field2
+   function Get_Element_Declaration_Chain (Decl : Iir) return Iir;
+   procedure Set_Element_Declaration_Chain (Decl : Iir; Chain : Iir);
+
+   --  Number of elements in the record.
+   --  Field: Field1 (uc)
+   function Get_Number_Element_Declaration (Decl : Iir) return Iir_Index32;
+   procedure Set_Number_Element_Declaration (Decl : Iir; Val : Iir_Index32);
+
+   --  Field: Field2
+   function Get_Designated_Type (Target : Iir) return Iir;
+   procedure Set_Designated_Type (Target : Iir; Dtype : Iir);
+
+   --  Field: Field1
+   function Get_Target (Target : Iir) return Iir;
+   procedure Set_Target (Target : Iir; Atarget : Iir);
+
+   --  Field: Field5
+   function Get_Waveform_Chain (Target : Iir) return Iir_Waveform_Element;
+   procedure Set_Waveform_Chain (Target : Iir; Chain : Iir_Waveform_Element);
+
+   --  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: 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 a list of signal or ports which are assigned in the current
+   --  subprogram or process.
+   --  Can return null_iir if there is no such assignment.
+   --  Field: Field8 (uc)
+   function Get_Driver_List (Stmt : Iir) return Iir_List;
+   procedure Set_Driver_List (Stmt : Iir; List : Iir_List);
+
+   --  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 (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);
+
+   --  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 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_function_name 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);
+
+   --  Get/Set the purity status of a subprogram.
+   --  Field: State3 (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);
+
+   --  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
+   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
+   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 (Target : Iir) return Iir;
+   procedure Set_Configuration (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);
+
+   --  Field: Field7
+   function Get_Selected_Waveform_Chain (Target : Iir) return Iir;
+   procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field7
+   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: Field7
+   function Get_Block_Header (Target : Iir) return Iir;
+   procedure Set_Block_Header (Target : Iir; Header : 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_Elsif;
+   procedure Set_Else_Clause (Target : Iir; Clause : Iir_Elsif);
+
+   --  Iterator of a for_loop_statement.
+   --  Field: Field1
+   function Get_Iterator_Scheme (Target : Iir) return Iir;
+   procedure Set_Iterator_Scheme (Target : Iir; Iterator : Iir);
+
+   --  Get/Set the statement in which TARGET appears.  This is used to check
+   --  if next/exit is in a loop.
+   --  Field: Field0
+   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 (Target : Iir) return Iir;
+   procedure Set_Loop (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
+   function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir;
+   procedure Set_Default_Generic_Map_Aspect_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field7
+   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
+   function Get_Named_Entity (Target : Iir) return Iir;
+   procedure Set_Named_Entity (Target : 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: Field3
+   function Get_Prefix (Target : Iir) return Iir;
+   procedure Set_Prefix (Target : Iir; Prefix : Iir);
+
+   --  Suffix of a slice or attribute.
+   --  Field: Field2
+   function Get_Suffix (Target : Iir) return Iir;
+   procedure Set_Suffix (Target : Iir; Suffix : 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);
+
+   --  List of individual associations for association_element_by_individual.
+   --  Associations for parenthesis_name.
+   --  Field: Field2
+   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
+   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_Aggregate_Info;
+   procedure Set_Aggregate_Info (Target : Iir; Info : Iir_Aggregate_Info);
+
+   --  Get/Set the info node for the next dimension.
+   --  Field: Field1
+   function Get_Sub_Aggregate_Info (Target : Iir) return Iir_Aggregate_Info;
+   procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir_Aggregate_Info);
+
+   --  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 maximum 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_Max_Length (Info : Iir_Aggregate_Info) return Iir_Int32;
+   procedure Set_Aggr_Max_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
+   function Get_Association_Choices_Chain (Target : Iir) return Iir;
+   procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir);
+
+   --  Chain of choices.
+   --  Field: Field1
+   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.
+   --  Field: Field3
+   function Get_Implementation (Target : Iir) return Iir;
+   procedure Set_Implementation (Target : Iir; Decl : Iir);
+
+   --  Paramater associations for procedure and function call.
+   --  Field: Field2
+   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.
+   --  May be null_iir if there is no type mark (as in an iterator).
+   --  May differ from base_type, if the type_mark is a subtype_name.
+   --  Field: Field2
+   function Get_Type_Mark (Target : Iir) return Iir;
+   procedure Set_Type_Mark (Target : Iir; Mark : Iir);
+
+   --  Get/set the lexical layout of an interface.
+   --  Field: Odigit1 (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: Field5
+   function Get_Signature (Target : Iir) return Iir;
+   procedure Set_Signature (Target : Iir; Value : Iir);
+
+   --  Field: Field1 (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: Field2 (uc)
+   function Get_Simple_Name_Identifier (Target : Iir) return Name_Id;
+   procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id);
+
+   --  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: Field0 (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);
+end Iirs;
diff --git a/iirs_utils.adb b/iirs_utils.adb
new file mode 100644
index 000000000..b5b63d2d9
--- /dev/null
+++ b/iirs_utils.adb
@@ -0,0 +1,813 @@
+--  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 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 Scan; use Scan;
+with Tokens; use Tokens;
+with Errorout; use Errorout;
+with Name_Table;
+with Str_Table;
+with Std_Names; use Std_Names;
+with Flags;
+
+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 Get_Operator_Name (Op : Iir) return Name_Id is
+   begin
+      case Get_Kind (Op) is
+         when Iir_Kind_And_Operator =>
+            return Name_And;
+         when Iir_Kind_Or_Operator =>
+            return Name_Or;
+         when Iir_Kind_Nand_Operator =>
+            return Name_Nand;
+         when Iir_Kind_Nor_Operator =>
+            return Name_Nor;
+         when Iir_Kind_Xor_Operator =>
+            return Name_Xor;
+         when Iir_Kind_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_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 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_Variable_Interface_Declaration =>
+               return Adecl;
+            when Iir_Kind_Constant_Declaration
+              | Iir_Kind_Constant_Interface_Declaration =>
+               return Adecl;
+            when Iir_Kind_Signal_Declaration
+              | Iir_Kind_Guard_Signal_Declaration
+              | Iir_Kind_Signal_Interface_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 (Decl: Iir) return Iir is
+      Adecl: Iir;
+   begin
+      Adecl := Decl;
+      loop
+         case Get_Kind (Adecl) is
+            when Iir_Kind_Variable_Declaration
+              | Iir_Kind_Variable_Interface_Declaration
+              | Iir_Kind_Constant_Declaration
+              | Iir_Kind_Constant_Interface_Declaration
+              | Iir_Kind_Signal_Declaration
+              | Iir_Kind_Guard_Signal_Declaration
+              | Iir_Kind_Signal_Interface_Declaration
+              | Iir_Kind_File_Declaration
+              | Iir_Kind_File_Interface_Declaration
+              | Iir_Kind_Iterator_Declaration =>
+               return Adecl;
+            when Iir_Kind_Object_Alias_Declaration =>
+               Adecl := Get_Name (Adecl);
+            when Iir_Kind_Indexed_Name
+              | Iir_Kind_Slice_Name
+              | Iir_Kind_Selected_Element
+              | Iir_Kind_Selected_By_All_Name =>
+               Adecl := Get_Prefix (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 =>
+               return Adecl;
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Selected_Name =>
+               Adecl := Get_Named_Entity (Adecl);
+            when others =>
+               Error_Kind ("get_object_prefix", Adecl);
+         end case;
+      end loop;
+   end Get_Object_Prefix;
+
+   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
+      if Unit = Target then
+         return;
+      end if;
+      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;
+
+   function Get_String_Length (Str : Iir) return Natural is
+   begin
+      return Natural (Nat32'(Get_String_Length (Str)));
+   end Get_String_Length;
+
+   --  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 : Natural;
+   begin
+      Ptr := Get_String_Fat_Acc (Str);
+      Len := Get_String_Length (Str);
+      return Ptr (1 .. Len);
+   end Image_String_Lit;
+
+   procedure Create_Range_Constraint_For_Enumeration_Type
+     (Def : Iir_Enumeration_Type_Definition)
+   is
+      Range_Expr : Iir_Range_Expression;
+      Literal_List: Iir_List;
+   begin
+      Literal_List := Get_Enumeration_Literal_List (Def);
+
+      --  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, Get_First_Element (Literal_List));
+      Set_Right_Limit (Range_Expr, 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_Old_Iir (Node: in Iir)
+   is
+      N : Iir;
+   begin
+      N := Node;
+      Free_Iir (N);
+   end Free_Old_Iir;
+
+   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_Declaration
+           | 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_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_Declaration =>
+            Free_Recursive (Get_Entity (N));
+         when Iir_Kind_Proxy =>
+            null;
+         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 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 (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_Unconstrained_Type_Definition (Def : Iir) return Boolean is
+   begin
+      return Get_Kind (Def) in Iir_Kinds_Unconstrained_Array_Type_Definition;
+   end Is_Unconstrained_Type_Definition;
+
+   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_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_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_Declaration then
+               raise Internal_Error;
+            end if;
+            return Res;
+         when Iir_Kind_Block_Statement
+           | Iir_Kind_Architecture_Declaration
+           | Iir_Kind_Generate_Statement =>
+            return Block_Spec;
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Slice_Name =>
+            return Get_Prefix (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_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_Unidim_Array_Type (A_Type : Iir) return Boolean
+   is
+      Base_Type : 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_Unidim_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_Attribute_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;
+   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_Type_Definition then
+         Set_Resolution_Function (Res, Get_Resolution_Function (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));
+      Set_Index_Subtype_List (Res, Create_Iir_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, Locally);
+      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;
+
+   function Get_Associated_Formal (Assoc : Iir) return Iir
+   is
+      Formal : Iir;
+   begin
+      Formal := Get_Formal (Assoc);
+      case Get_Kind (Formal) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            Formal := Get_Named_Entity (Formal);
+         when others =>
+            null;
+      end case;
+      return Get_Base_Name (Formal);
+   end Get_Associated_Formal;
+
+   --  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_Kind_Component_Declaration =>
+            return Aspect;
+         when Iir_Kind_Entity_Aspect_Entity =>
+            return Get_Library_Unit (Get_Entity (Aspect));
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Inst := Get_Library_Unit (Get_Configuration (Aspect));
+            return Get_Library_Unit (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 Get_Physical_Literal_Value (Lit : Iir) return Iir_Int64
+   is
+   begin
+      case Get_Kind (Lit) is
+         when Iir_Kind_Physical_Int_Literal =>
+            return Get_Value (Lit)
+              * Get_Value (Get_Physical_Unit_Value (Get_Unit_Name (Lit)));
+         when Iir_Kind_Unit_Declaration =>
+            return Get_Value (Get_Physical_Unit_Value (Lit));
+         when Iir_Kind_Physical_Fp_Literal =>
+            return Iir_Int64
+              (Get_Fp_Value (Lit)
+               * Iir_Fp64 (Get_Value (Get_Physical_Unit_Value
+                                      (Get_Unit_Name (Lit)))));
+         when others =>
+            Error_Kind ("get_physical_literal_value", Lit);
+      end case;
+   end Get_Physical_Literal_Value;
+
+end Iirs_Utils;
diff --git a/iirs_utils.ads b/iirs_utils.ads
new file mode 100644
index 000000000..f567d10b8
--- /dev/null
+++ b/iirs_utils.ads
@@ -0,0 +1,156 @@
+--  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 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 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;
+   function Get_String_Length (Str : Iir) return Natural;
+   pragma Inline (Get_String_Fat_Acc);
+   pragma Inline (Get_String_Length);
+
+   --  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 DECL, ie:
+   -- {signal, variable, constant}{interface_declaration, declaration}, or
+   -- DECL itself, if it is not an object.
+   function Get_Object_Prefix (Decl: 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);
+
+   --  Free NODE.
+   procedure Free_Old_Iir (Node: in Iir);
+
+   --  Name of FUNC.
+   function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions)
+     return String;
+
+   --  Create the range_constraint node for an enumeration type.
+   procedure Create_Range_Constraint_For_Enumeration_Type
+     (Def : Iir_Enumeration_Type_Definition);
+
+   --  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 an unconstrained type (or subtype) definition.
+   function Is_Unconstrained_Type_Definition (Def : Iir) return Boolean;
+
+   --  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;
+
+   --  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_Unidim_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 unconstrained_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;
+
+   --  Get the base name of the formal of an association.
+   function Get_Associated_Formal (Assoc : 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;
+
+
+   --  Get the value of any physical literals.
+   --  A physical literal can be either an int_literal, and fp_literal or
+   --  a unit_declaration.
+   --  See also Evaluation.Get_Physical_Value.
+   function Get_Physical_Literal_Value (Lit : Iir) return Iir_Int64;
+end Iirs_Utils;
+
diff --git a/libraries.adb b/libraries.adb
new file mode 100644
index 000000000..5eee733f7
--- /dev/null
+++ b/libraries.adb
@@ -0,0 +1,1634 @@
+--  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 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 GNAT.Table;
+with GNAT.OS_Lib;
+with Errorout; use Errorout;
+with Scan;
+with 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_Names;
+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.
+   Name_Nil : Name_Id;
+   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;
+      Pathes.Increment_Last;
+      Pathes.Table (Pathes.Last) := 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 : 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;
+      Scan.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 =>
+            Id := Get_Identifier (Lib_Unit);
+         when Iir_Kind_Architecture_Declaration =>
+            --  Architectures are put with the entity identifier.
+            Id := Get_Identifier (Get_Entity (Lib_Unit));
+         when others =>
+            Error_Kind ("get_id_for_unit_hash", 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 Scan;
+      use Tokens;
+      use Iirs_Utils;
+
+      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.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 : Natural;
+         Ptr : String_Fat_Acc;
+      begin
+         Len := Natural (Current_String_Length);
+         Ptr := Str_Table.Get_String_Fat_Acc (Current_String_Id);
+         for I in 1 .. Len loop
+            Name_Table.Name_Buffer (I) := Ptr (I);
+         end loop;
+         Name_Table.Name_Length := 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.Scan;
+               if Current_Token = Tok_Left_Paren then
+                  --  This is an architecture.
+                  Scan_Expect (Tok_Identifier);
+                  Scan_Expect (Tok_Right_Paren);
+                  Scan.Scan;
+               end if;
+               exit when Current_Token /= Tok_Comma;
+               Scan.Scan;
+            end loop;
+            Scan.Scan;
+         end if;
+         return Null_Iir_List;
+      end Scan_Unit_List;
+
+      Design_File: Iir_Design_File;
+      Library_Unit: Iir;
+      Line, Col: Natural;
+      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 : 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.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.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.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.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.Scan;
+               when Tok_Architecture =>
+                  Library_Unit :=
+                    Create_Iir (Iir_Kind_Architecture_Declaration);
+                  Scan.Scan;
+               when Tok_Configuration =>
+                  Library_Unit :=
+                    Create_Iir (Iir_Kind_Configuration_Declaration);
+                  Scan.Scan;
+               when Tok_Package =>
+                  Scan.Scan;
+                  if Current_Token = Tok_Body then
+                     Library_Unit := Create_Iir (Iir_Kind_Package_Body);
+                     Scan.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_Declaration
+                  then
+                     Put_Line ("load_library: invalid use of 'with'");
+                     raise Internal_Error;
+                  end if;
+                  Scan_Expect (Tok_Configuration);
+                  Scan_Expect (Tok_Colon);
+                  Scan.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);
+            Set_Visible_Flag (Design_Unit, True);
+
+            if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Declaration then
+               Scan_Expect (Tok_Of);
+               Scan_Expect (Tok_Identifier);
+               Set_Entity (Library_Unit, Current_Text);
+            end if;
+
+            -- Scan position.
+            Scan_Expect (Tok_Identifier); -- at
+            Scan_Expect (Tok_Integer);
+            Line := Natural (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 := Natural (Current_Iir_Int64);
+            Scan_Expect (Tok_On);
+            Scan_Expect (Tok_Integer);
+            Date := Date_Type (Current_Iir_Int64);
+
+            Scan.Scan;
+            if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration
+              and then Current_Token = Tok_Body
+            then
+               Set_Need_Body (Library_Unit, True);
+               Scan.Scan;
+            end if;
+            if Current_Token /= Tok_Semi_Colon then
+               raise Internal_Error;
+            end if;
+            Scan.Scan;
+
+            if False then
+               Put_Line ("line:" & Natural'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_Pos_Line_Off (Design_Unit, Pos, Line, 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;
+      use Name_Table;
+      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;
+
+--    procedure Unload_Library (Library : Iir_Library_Declaration)
+--    is
+--       File : Iir_Design_File;
+--       Unit : Iir_Design_Unit;
+--    begin
+--       loop
+--          File := Get_Design_File_Chain (Library);
+--          exit when File = Null_Iir;
+--          Set_Design_File_Chain (Library, Get_Chain (File));
+
+--          loop
+--             Unit := Get_Design_Unit_Chain (File);
+--             exit when Unit = Null_Iir;
+--             Set_Design_Unit_Chain (File, Get_Chain (Unit));
+
+--             --  Units should not be loaded.
+--             if Get_Loaded_Flag (Unit) then
+--                raise Internal_Error;
+--             end if;
+
+--             --  Free dependences list.
+--          end loop;
+--       end loop;
+--    end Unload_Library;
+
+--    procedure Unload_All_Libraries
+--    is
+--       Library : Iir_Library_Declaration;
+--    begin
+--       if Get_Identifier (Std_Library) /= Name_Std then
+--          raise Internal_Error;
+--       end if;
+--       if Std_Library /= Libraries_Chain then
+--          raise Internal_Error;
+--       end if;
+--       loop
+--          Library := Get_Chain (Libraries_Chain);
+--          exit when Library = Null_Iir;
+--          Set_Chain (Libraries_Chain, Get_Chain (Libraries_Chain));
+--          Unload_Library (Library);
+--       end loop;
+--    end Unload_All_Libraries;
+
+   -- 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, Scan.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_Declaration
+        and then Library_Unit_Kind = Iir_Kind_Architecture_Declaration
+      then
+         Entity_Name1 := Get_Identifier (Get_Entity (Unit));
+         Entity_Name2 := Get_Identifier (Get_Entity (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_Declaration
+          and then Library_Unit_Kind /= Iir_Kind_Architecture_Declaration)
+        or else
+        (Unit_Kind /= Iir_Kind_Architecture_Declaration
+         and then Library_Unit_Kind = Iir_Kind_Architecture_Declaration)
+      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;
+
+   procedure Free_Design_Unit (Design_Unit : Iir_Design_Unit)
+   is
+      Lib : Iir;
+      Unit : Iir_Design_Unit;
+      Dep_List : Iir_List;
+   begin
+      Dep_List := Get_Dependence_List (Design_Unit);
+      Destroy_Iir_List (Dep_List);
+      Lib := Get_Library_Unit (Design_Unit);
+      if Lib /= Null_Iir
+        and then Get_Kind (Lib) = Iir_Kind_Architecture_Declaration
+      then
+         Unit := Get_Default_Configuration_Declaration (Lib);
+         if Unit /= Null_Iir then
+            Free_Design_Unit (Unit);
+         end if;
+      end if;
+      Iirs_Utils.Free_Old_Iir (Lib);
+   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 : Iir_Design_Unit)
+   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
+      pragma Assert (Get_Chain (Unit) = Null_Iir);
+
+      if Get_Date_State (Unit) /= Date_Extern then
+         raise Internal_Error;
+      end if;
+
+      --  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 Files_Map.Is_Absolute_Pathname (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.
+               Remove_Unit_From_File (Design_Unit, Design_File);
+            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.
+                  Free_Design_Unit (Design_Unit);
+               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;
+         end if;
+         Prev_Design_Unit := Design_Unit;
+         Design_Unit := Get_Hash_Chain (Design_Unit);
+      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;
+      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;
+            Design_Unit := Get_Chain (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);
+         Unit := Next_Unit;
+      end loop;
+      if First_Unit /= Null_Iir then
+         File := Get_Design_File (Unit);
+      end if;
+   end Add_Design_File_Into_Library;
+
+   -- Save the file map of library LIBRARY.
+   procedure Save_Library (Library: Iir_Library_Declaration) is
+      File: File_Type;
+
+      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
+      -- FIXME: directory
+      declare
+         use Files_Map;
+         File_Name: String := Image (Work_Directory)
+           & Back_End.Library_To_File_Name (Library);
+      begin
+         Create (File, Out_File, File_Name);
+      exception
+         when Use_Error =>
+            Open (File, Out_File, File_Name);
+         when Name_Error =>
+            Error_Msg ("cannot create library file """ & File_Name & """");
+            raise Option_Error;
+      end;
+
+      --  Header: version.
+      Put_Line (File, "v 3");
+
+      Design_File := Get_Design_File_Chain (Library);
+      while Design_File /= Null_Iir loop
+         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
+            Put (File, "file ");
+            Dir := Get_Design_File_Directory (Design_File);
+            if Dir = Null_Identifier then
+               --  Absolute filenames.
+               Put (File, "/");
+            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.
+               Put (File, ".");
+            else
+               Image (Dir);
+               Put (File, """");
+               Put (File, Name_Buffer (1 .. Name_Length));
+               Put (File, """");
+            end if;
+            Put (File, " """);
+            Image (Get_Design_File_Filename (Design_File));
+            Put (File, Name_Buffer (1 .. Name_Length));
+            Put (File, """ """);
+            Put (File, Files_Map.Get_Time_Stamp_String
+                 (Get_File_Time_Stamp (Design_File)));
+            Put (File, """ """);
+            Put (File, Files_Map.Get_Time_Stamp_String
+                 (Get_Analysis_Time_Stamp (Design_File)));
+            Put_Line (File, """:");
+         end if;
+
+         while Design_Unit /= Null_Iir loop
+            Library_Unit := Get_Library_Unit (Design_Unit);
+
+            Put (File, "  ");
+            case Get_Kind (Library_Unit) is
+               when Iir_Kind_Entity_Declaration =>
+                  Put (File, "entity ");
+                  Put (File, Iirs_Utils.Image_Identifier (Library_Unit));
+               when Iir_Kind_Architecture_Declaration =>
+                  Put (File, "architecture ");
+                  Put (File, Iirs_Utils.Image_Identifier (Library_Unit));
+                  Put (File, " of ");
+                  Put (File, Iirs_Utils.Image_Identifier
+                       (Get_Entity (Library_Unit)));
+               when Iir_Kind_Package_Declaration =>
+                  Put (File, "package ");
+                  Put (File, Iirs_Utils.Image_Identifier (Library_Unit));
+               when Iir_Kind_Package_Body =>
+                  Put (File, "package body ");
+                  Put (File, Iirs_Utils.Image_Identifier (Library_Unit));
+               when Iir_Kind_Configuration_Declaration =>
+                  Put (File, "configuration ");
+                  Put (File, Iirs_Utils.Image_Identifier (Library_Unit));
+               when others =>
+                  Error_Kind ("save_library", Library_Unit);
+            end case;
+
+            if Get_Date_State (Design_Unit) = Date_Disk then
+               Get_Pos_Line_Off (Design_Unit, Pos, Line, Off);
+            else
+               Files_Map.Location_To_Coord (Get_Location (Design_Unit),
+                                            Source_File, Pos, Line, Off);
+            end if;
+
+            Put (File, " at");
+            Put (File, Natural'Image (Line));
+            Put (File, "(");
+            Put (File, Source_Ptr'Image (Pos));
+            Put (File, ") +");
+            Put (File, Natural'Image (Off));
+            Put (File, " on");
+            case Get_Date (Design_Unit) is
+               when Date_Valid
+                 | Date_Analyzed
+                 | Date_Parsed =>
+                  Put (File, Date_Type'Image (Get_Date (Design_Unit)));
+               when others =>
+                  Put_Line (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
+               Put (File, " body");
+            end if;
+            Put_Line (File, ";");
+
+            Design_Unit := Get_Chain (Design_Unit);
+         end loop;
+         << Continue >> null;
+         Design_File := Get_Chain (Design_File);
+      end loop;
+
+      Close (File);
+   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_Declaration
+   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_Declaration
+              and then Get_Identifier (Get_Entity (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
+      Scan.Set_File (File);
+      Res := Parse.Parse_Design_File;
+      Scan.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_Suffix_Identifier (Unit));
+            end;
+         when Iir_Kind_Entity_Aspect_Entity =>
+            declare
+               Prim : Iir_Design_Unit;
+            begin
+               Prim := Find_Design_Unit (Get_Entity (Unit));
+               if Prim = Null_Iir then
+                  return Null_Iir;
+               end if;
+               return Find_Secondary_Unit
+                 (Prim, Get_Identifier (Get_Architecture (Unit)));
+            end;
+         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 Scan;
+      Line, Off: Natural;
+      Pos: Source_Ptr;
+      Res: Iir;
+      Library : Iir_Library_Declaration;
+      Design_File : Iir_Design_File;
+      Fe : Source_File_Entry;
+   begin
+      if Get_Date_State (Design_Unit) /= Date_Disk then
+         raise Internal_Error;
+      end if;
+
+      --  Load and parse the unit.
+      Design_File := Get_Design_File (Design_Unit);
+      Library := Get_Library (Design_File);
+      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;
+      Get_Pos_Line_Off (Design_Unit, Pos, Line, Off);
+      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_Entity_Declaration
+                 | Iir_Kind_Configuration_Declaration =>
+                  --  Only return a primary unit.
+                  return Unit;
+               when others =>
+                  null;
+            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;
+      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_Declaration =>
+                  -- The entity field can be either an identifier (if the
+                  -- library unit was not loaded) or an access to the entity
+                  -- unit.
+                  Ident := Get_Identifier (Get_Entity (Library_Unit));
+                  if Ident = 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;
+
+end Libraries;
diff --git a/libraries.ads b/libraries.ads
new file mode 100644
index 000000000..cb988d655
--- /dev/null
+++ b/libraries.ads
@@ -0,0 +1,167 @@
+--  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 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 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;
+
+   --  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.
+   procedure Add_Design_Unit_Into_Library (Unit : in Iir_Design_Unit);
+
+   --  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_Declaration;
+
+   --  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;
+end Libraries;
diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc
new file mode 100644
index 000000000..e1557c603
--- /dev/null
+++ b/libraries/Makefile.inc
@@ -0,0 +1,169 @@
+#  -*- Makefile -*- for the VHDL libraries.
+#  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:
+# LIB93_DIR
+# LIB87_DIR
+# REL_DIR
+# LIBSRC_DIR
+# ANALYZE
+# LN
+# CP
+#
+# Note: the source files are analyzed in the LIBxx_DIR.  So LIBSRC_DIR must be
+# relative to the target directory.
+
+STD_SRCS := std/textio.vhdl std/textio_body.vhdl
+IEEE_SRCS := ieee/std_logic_1164.vhdl ieee/std_logic_1164_body.vhdl \
+  ieee/numeric_bit.vhdl ieee/numeric_bit-body.vhdl \
+  ieee/numeric_std.vhdl ieee/numeric_std-body.vhdl
+MATH_SRCS := ieee/math_real.vhdl ieee/math_real-body.vhdl \
+  ieee/math_complex.vhdl ieee/math_complex-body.vhdl
+VITAL95_BSRCS := vital95/vital_timing.vhdl vital95/vital_timing_body.vhdl \
+  vital95/vital_primitives.vhdl vital95/vital_primitives_body.vhdl
+VITAL2000_BSRCS := vital2000/timing_p.vhdl vital2000/timing_b.vhdl \
+  vital2000/prmtvs_p.vhdl vital2000/prmtvs_b.vhdl \
+  vital2000/memory_p.vhdl vital2000/memory_b.vhdl
+SYNOPSYS_BSRCS := synopsys/std_logic_arith.vhdl \
+  synopsys/std_logic_textio.vhdl synopsys/std_logic_unsigned.vhdl \
+  synopsys/std_logic_signed.vhdl \
+  synopsys/std_logic_misc.vhdl synopsys/std_logic_misc-body.vhdl 
+MENTOR_BSRCS := mentor/std_logic_arith.vhdl mentor/std_logic_arith_body.vhdl
+
+STD87_BSRCS := $(STD_SRCS:.vhdl=.v87)
+STD93_BSRCS := $(STD_SRCS:.vhdl=.v93)
+IEEE87_BSRCS := $(IEEE_SRCS:.vhdl=.v87)
+IEEE93_BSRCS := $(IEEE_SRCS:.vhdl=.v93) $(MATH_SRCS)
+SYNOPSYS87_BSRCS := $(SYNOPSYS_BSRCS)
+SYNOPSYS93_BSRCS := $(SYNOPSYS_BSRCS)
+MENTOR93_BSRCS := $(MENTOR_BSRCS)
+
+.PREFIXES: .vhdl .v93 .v87
+
+%.v93: %.vhdl
+	sed -e '/--V87/s/^/  --/' < $< > $@
+
+%.v87: %.vhdl
+	sed -e '/--V93/s/^/  --/' -e '/--START-V93/,/--END-V93/s/^/--/' \
+	  < $< > $@
+
+STD93_DIR:=$(LIB93_DIR)/std
+IEEE93_DIR:=$(LIB93_DIR)/ieee
+SYN93_DIR:=$(LIB93_DIR)/synopsys
+MENTOR93_DIR:=$(LIB93_DIR)/mentor
+
+STD87_DIR:=$(LIB87_DIR)/std
+IEEE87_DIR:=$(LIB87_DIR)/ieee
+SYN87_DIR:=$(LIB87_DIR)/synopsys
+
+ANALYZE93:=$(ANALYZE) --std=93
+ANALYZE87:=$(ANALYZE) --std=87
+
+STD87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD87_BSRCS))
+STD93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD93_BSRCS))
+IEEE93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE93_BSRCS))
+IEEE87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE87_BSRCS))
+SYNOPSYS_SRCS=$(addprefix $(LIBSRC_DIR)/,$(SYNOPSYS_BSRCS))
+MENTOR93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(MENTOR93_BSRCS))
+VITAL95_SRCS=$(addprefix $(LIBSRC_DIR)/,$(VITAL95_BSRCS))
+VITAL2000_SRCS=$(addprefix $(LIBSRC_DIR)/,$(VITAL2000_BSRCS))
+
+std.v93: $(LIB93_DIR) $(STD93_SRCS) force
+	$(RM) -rf $(STD93_DIR)
+	mkdir $(STD93_DIR)
+	prev=`pwd`; cd $(STD93_DIR); \
+	for i in $(STD93_SRCS); do \
+	  echo $$i; \
+	  $(ANALYZE93) --bootstrap --work=std $(REL_DIR)/$$i || exit 1; \
+	done; \
+	cd $$prev
+
+ANALYZE_IEEE93=$(ANALYZE93) -P../std --work=ieee
+
+ieee.v93: $(LIB93_DIR) $(IEEE93_SRCS) force
+	$(RM) -rf $(IEEE93_DIR)
+	mkdir $(IEEE93_DIR)
+	prev=`pwd`; cd $(IEEE93_DIR); \
+	for i in $(IEEE93_BSRCS) $(VITAL2000_BSRCS); do \
+          cmd="$(ANALYZE_IEEE93) $(REL_DIR)/$(LIBSRC_DIR)/$$i"; \
+	  echo $$cmd; eval $$cmd || exit 1; \
+	done; \
+	cd $$prev
+
+synopsys.v93: $(LIB93_DIR) $(SYNOPSYS_SRCS) force
+	$(RM) -rf $(SYN93_DIR)
+	mkdir $(SYN93_DIR)
+	prev=`pwd`; cd $(SYN93_DIR); \
+	$(CP) ../ieee/ieee-obj93.cf .; \
+	for i in $(IEEE_SRCS) $(VITAL2000_SRCS); do \
+	  b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \
+	done; \
+	for i in $(SYNOPSYS93_BSRCS); do \
+          cmd="$(ANALYZE_IEEE93) $(REL_DIR)/$(LIBSRC_DIR)/$$i"; \
+	  echo $$cmd; eval $$cmd || exit 1; \
+	done; \
+	cd $$prev
+
+mentor.v93: $(LIB93_DIR) $(MENTOR93_SRCS) force
+	$(RM) -rf $(MENTOR93_DIR)
+	mkdir $(MENTOR93_DIR)
+	prev=`pwd`; cd $(MENTOR93_DIR); \
+	$(CP) ../ieee/ieee-obj93.cf . ;\
+	for i in $(IEEE_SRCS) $(VITAL2000_SRCS); do \
+	  b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \
+	done ; \
+	for i in $(MENTOR93_BSRCS); do \
+          cmd="$(ANALYZE_IEEE93) $(REL_DIR)/$(LIBSRC_DIR)/$$i";\
+	  echo $$cmd; eval $$cmd || exit 1; \
+	done
+
+std.v87: $(LIB87_DIR) $(STD87_SRCS) force
+	$(RM) -rf $(STD87_DIR)
+	mkdir $(STD87_DIR)
+	prev=`pwd`; cd $(STD87_DIR); \
+	for i in $(STD87_SRCS); do \
+	  echo $$i; \
+	  $(ANALYZE87) --bootstrap --work=std $(REL_DIR)/$$i || exit 1; \
+	done; \
+	cd $$prev
+
+ANALYZE_IEEE87=$(ANALYZE87) -P../std --work=ieee
+
+ieee.v87: $(LIB87_DIR) $(IEEE87_SRCS) force
+	$(RM) -rf $(IEEE87_DIR)
+	mkdir $(IEEE87_DIR)
+	prev=`pwd`; cd $(IEEE87_DIR); \
+	for i in $(IEEE87_BSRCS) $(VITAL95_BSRCS); do \
+          cmd="$(ANALYZE_IEEE87) $(REL_DIR)/$(LIBSRC_DIR)/$$i";\
+	  echo $$cmd; eval $$cmd || exit 1; \
+	done; \
+	cd $$prev
+
+synopsys.v87: $(LIB87_DIR) $(SYNOPSYS_SRCS) force
+	$(RM) -rf $(SYN87_DIR)
+	mkdir $(SYN87_DIR)
+	prev=`pwd`; cd $(SYN87_DIR); \
+	$(CP) ../ieee/ieee-obj87.cf . ; \
+	for i in $(IEEE_SRCS) $(VITAL95_SRCS); do \
+	  b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \
+	done; \
+	for i in $(SYNOPSYS87_BSRCS); do \
+          cmd="$(ANALYZE_IEEE87) $(REL_DIR)/$(LIBSRC_DIR)/$$i";\
+	  echo $$cmd; eval $$cmd || exit 1; \
+	done; \
+	cd $$prev
diff --git a/libraries/README b/libraries/README
new file mode 100644
index 000000000..d569a25a1
--- /dev/null
+++ b/libraries/README
@@ -0,0 +1,27 @@
+VHDL libraries.
+---------------
+
+* Filename convention:
+
+For a package XXXX, the file containing the declaration must be named XXXX.vhdl
+and the file containing the body must be named XXXX-body.vhdl
+
+Note: this is not completly followed!
+
+
+* Using Vhdl-87 or Vhdl-93:
+
+Lines that must be compiled only for vhdl-87 must have a --V87 comment at the
+end, lines for vhdl-93 must a a --V93 comment.
+Example:
+  procedure readline (variable f: in text; l: out line) --V87
+  procedure readline (file f: text; l: out line) --V93
+For group of lines that must be compiled only for vhdl-93 (such as xnor
+functions), use this:
+  --START-V93
+    ...[lines to compile only with vhdl-93]...
+  --END-V93
+Makefile rules create .v87 and .v93 files from .vhdl files, and compile them
+with the correct version.
+
+#  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
diff --git a/libraries/ieee/math_complex-body.vhdl b/libraries/ieee/math_complex-body.vhdl
new file mode 100644
index 000000000..9b8b75ad4
--- /dev/null
+++ b/libraries/ieee/math_complex-body.vhdl
@@ -0,0 +1,394 @@
+--------------------------------------------------------------- 
+--
+-- This source file may be used and distributed without restriction.
+-- No declarations or definitions shall be included in this package.
+-- This package cannot be sold or distributed for profit. 
+--
+--   ****************************************************************
+--   *                                                              *
+--   *                      W A R N I N G		 	    *
+--   *								    *
+--   *   This DRAFT version IS NOT endorsed or approved by IEEE     *
+--   *								    *
+--   ****************************************************************
+--
+-- Title:    PACKAGE BODY MATH_COMPLEX
+--
+-- Purpose:  VHDL declarations for mathematical package MATH_COMPLEX
+--	     which contains common complex constants and basic complex
+--	     functions and operations.
+--
+-- Author:   IEEE VHDL Math Package Study Group 
+--
+-- Notes:     
+--	The package body uses package IEEE.MATH_REAL
+--
+-- 	The package body shall be considered the formal definition of 
+-- 	the semantics of this package. Tool developers may choose to implement 
+-- 	the package body in the most efficient manner available to them.
+--
+--   Source code for this package body comes from the following
+--	following sources: 
+--		IEEE VHDL Math Package Study Group participants,
+--		U. of Mississippi, Mentor Graphics, Synopsys,
+--		Viewlogic/Vantage, Communications of the ACM (June 1988, Vol
+--		31, Number 6, pp. 747, Pierre L'Ecuyer, Efficient and Portable
+--		Random Number Generators, Handbook of Mathematical Functions
+--	        by Milton Abramowitz and Irene A. Stegun (Dover).
+--
+-- History:
+-- 	Version	0.1	Jose A. Torres	4/23/93	First draft
+-- 	Version	0.2	Jose A. Torres	5/28/93	Fixed potentially illegal code
+--
+-------------------------------------------------------------
+Library IEEE;
+
+Use IEEE.MATH_REAL.all;		-- real trascendental operations
+
+Package body MATH_COMPLEX is
+
+    function CABS(Z: in complex ) return real is
+    	-- returns absolute value (magnitude) of Z
+	variable ztemp : complex_polar;
+    begin
+		ztemp := COMPLEX_TO_POLAR(Z);
+		return ztemp.mag;
+    end CABS;
+
+    function CARG(Z: in complex ) return real is
+    	-- returns argument (angle) in radians of a complex number
+     variable ztemp : complex_polar;
+    begin
+    		ztemp := COMPLEX_TO_POLAR(Z);
+		return ztemp.arg;
+    end CARG;
+
+    function CMPLX(X: in real;  Y: in real := 0.0 ) return complex is
+    	-- returns complex number X + iY
+    begin
+		return COMPLEX'(X, Y);
+    end CMPLX;
+
+    function "-" (Z: in complex ) return complex is
+    	-- unary minus; returns -x -jy for z= x + jy
+    begin
+    		return COMPLEX'(-z.Re, -z.Im);
+    end "-";
+
+    function "-" (Z: in complex_polar ) return complex_polar is
+    	-- unary minus; returns (z.mag, z.arg + MATH_PI)
+    begin
+    		return COMPLEX_POLAR'(z.mag, z.arg + MATH_PI);
+    end "-";
+
+    function CONJ (Z: in complex) return complex is
+    	-- returns complex conjugate (x-jy for z = x+ jy)
+    begin
+    		return COMPLEX'(z.Re, -z.Im);
+    end CONJ;
+
+    function CONJ (Z: in complex_polar) return complex_polar is
+    	-- returns complex conjugate (z.mag, -z.arg)
+    begin
+    		return COMPLEX_POLAR'(z.mag, -z.arg);
+    end CONJ;
+
+    function CSQRT(Z: in complex ) return complex_vector is
+    	-- returns square root of Z; 2 values
+		variable ztemp : complex_polar;
+		variable zout : complex_vector (0 to 1);
+		variable temp : real;
+    begin
+		ztemp := COMPLEX_TO_POLAR(Z);
+		temp := SQRT(ztemp.mag);
+		zout(0).re := temp*COS(ztemp.arg/2.0);
+		zout(0).im := temp*SIN(ztemp.arg/2.0); 
+    		
+		zout(1).re := temp*COS(ztemp.arg/2.0 + MATH_PI);
+		zout(1).im := temp*SIN(ztemp.arg/2.0 + MATH_PI);
+		
+		return zout;
+    end CSQRT;
+
+    function CEXP(Z: in complex ) return complex is
+    	-- returns e**Z
+    begin
+		return COMPLEX'(EXP(Z.re)*COS(Z.im), EXP(Z.re)*SIN(Z.im));
+    end CEXP;
+
+    function COMPLEX_TO_POLAR(Z: in complex ) return complex_polar is
+    	-- converts complex to complex_polar
+    begin
+    		return COMPLEX_POLAR'(sqrt(z.re**2 + z.im**2),atan2(z.re,z.im));
+    end COMPLEX_TO_POLAR;
+
+    function POLAR_TO_COMPLEX(Z: in complex_polar ) return complex is
+    	-- converts complex_polar to complex
+    begin
+    		return COMPLEX'( z.mag*cos(z.arg), z.mag*sin(z.arg) ); 
+    end POLAR_TO_COMPLEX;
+
+    		
+    --
+    -- arithmetic operators
+    --
+
+    function "+" ( L: in complex;  R: in complex ) return complex is
+    begin
+    		return COMPLEX'(L.Re + R.Re, L.Im + R.Im);
+    end "+";
+
+    function "+" (L: in complex_polar; R: in complex_polar) return complex is
+		variable zL, zR : complex;
+    begin
+		zL := POLAR_TO_COMPLEX( L );
+		zR := POLAR_TO_COMPLEX( R );
+		return COMPLEX'(zL.Re + zR.Re, zL.Im + zR.Im);
+    end "+";
+
+    function "+" ( L: in complex_polar; R: in complex ) return complex is
+    		variable zL : complex;
+    begin
+    		zL := POLAR_TO_COMPLEX( L );
+		return COMPLEX'(zL.Re + R.Re, zL.Im + R.Im);
+    end "+";
+
+    function "+" ( L: in complex;  R: in complex_polar) return complex is
+    		variable zR : complex;
+    begin
+    		zR := POLAR_TO_COMPLEX( R );
+		return COMPLEX'(L.Re + zR.Re, L.Im + zR.Im);
+    end "+";
+
+    function "+" ( L: in real;     R: in complex ) return complex is
+    begin
+    		return COMPLEX'(L + R.Re, R.Im);
+    end "+";
+
+    function "+" ( L: in complex;  R: in real )    return complex is
+    begin
+    		return COMPLEX'(L.Re + R, L.Im);
+    end "+";
+
+    function "+" ( L: in real;  R: in complex_polar) return complex is
+    		variable zR : complex;
+    begin
+    		zR := POLAR_TO_COMPLEX( R );
+		return COMPLEX'(L + zR.Re, zR.Im);
+    end "+";
+
+    function "+" ( L: in complex_polar;  R: in real) return complex is
+    		variable zL : complex;
+    begin
+    		zL := POLAR_TO_COMPLEX( L );
+		return COMPLEX'(zL.Re + R, zL.Im);
+    end "+";
+
+    function "-" ( L: in complex;  R: in complex ) return complex is
+    begin
+    		return COMPLEX'(L.Re - R.Re, L.Im - R.Im);
+    end "-";
+
+    function "-" ( L: in complex_polar; R: in complex_polar) return complex is
+    		variable zL, zR : complex;
+    begin
+    		zL := POLAR_TO_COMPLEX( L );
+		zR := POLAR_TO_COMPLEX( R );
+		return COMPLEX'(zL.Re - zR.Re, zL.Im - zR.Im);
+    end "-";
+
+    function "-" ( L: in complex_polar; R: in complex ) return complex is
+    		variable zL : complex;
+    begin
+    		zL := POLAR_TO_COMPLEX( L );
+		return COMPLEX'(zL.Re - R.Re, zL.Im - R.Im);
+    end "-";
+
+    function "-" ( L: in complex;  R: in complex_polar) return complex is
+    		variable zR : complex;
+    begin
+    		zR := POLAR_TO_COMPLEX( R );
+		return COMPLEX'(L.Re - zR.Re, L.Im - zR.Im);
+    end "-";
+
+    function "-" ( L: in real;     R: in complex ) return complex is
+    begin
+    		return COMPLEX'(L - R.Re, -1.0 * R.Im);
+    end "-";
+
+    function "-" ( L: in complex;  R: in real )    return complex is
+    begin
+    		return COMPLEX'(L.Re - R, L.Im);
+    end "-";
+
+    function "-" ( L: in real;  R: in complex_polar) return complex is
+    		variable zR : complex;
+    begin
+    		zR := POLAR_TO_COMPLEX( R );
+		return COMPLEX'(L - zR.Re, -1.0*zR.Im);
+    end "-";
+
+    function "-" ( L: in complex_polar;  R: in real) return complex is
+    		variable zL : complex;
+    begin
+    		zL := POLAR_TO_COMPLEX( L );
+		return COMPLEX'(zL.Re - R, zL.Im);
+    end "-";
+
+    function "*" ( L: in complex;  R: in complex ) return complex is
+    begin
+        return COMPLEX'(L.Re * R.Re - L.Im * R.Im, L.Re * R.Im + L.Im * R.Re);
+    end "*";
+
+    function "*" ( L: in complex_polar; R: in complex_polar) return complex is
+		variable zout : complex_polar;
+    begin
+		zout.mag := L.mag * R.mag;
+		zout.arg := L.arg + R.arg;
+		return POLAR_TO_COMPLEX(zout);
+    end "*";
+
+    function "*" ( L: in complex_polar; R: in complex ) return complex is
+		variable zL : complex;
+    begin
+	zL := POLAR_TO_COMPLEX( L );
+	return COMPLEX'(zL.Re*R.Re - zL.Im * R.Im, zL.Re * R.Im + zL.Im*R.Re);
+    end "*";
+
+    function "*" ( L: in complex;  R: in complex_polar) return complex is
+    		variable zR : complex;
+    begin
+    	zR := POLAR_TO_COMPLEX( R );
+	return COMPLEX'(L.Re*zR.Re - L.Im * zR.Im, L.Re * zR.Im + L.Im*zR.Re);
+    end "*";
+
+    function "*" ( L: in real;     R: in complex ) return complex is
+    begin
+    		return COMPLEX'(L * R.Re, L * R.Im);
+    end "*";
+
+    function "*" ( L: in complex;  R: in real )    return complex is
+    begin
+    		return COMPLEX'(L.Re * R, L.Im * R);
+    end "*";
+
+    function "*" ( L: in real;  R: in complex_polar) return complex is
+    		variable zR : complex;
+    begin
+    		zR := POLAR_TO_COMPLEX( R );
+    		return COMPLEX'(L * zR.Re, L * zR.Im);
+    end "*";
+
+    function "*" ( L: in complex_polar;  R: in real) return complex is
+    		variable zL : complex;
+    begin
+    		zL := POLAR_TO_COMPLEX( L );
+    		return COMPLEX'(zL.Re * R, zL.Im * R);
+    end "*";
+
+    function "/" ( L: in complex;  R: in complex ) return complex is
+    		variable magrsq : REAL := R.Re ** 2 + R.Im ** 2;
+   begin 
+      if (magrsq = 0.0) then
+         assert FALSE report "Attempt to divide by (0,0)"
+         	severity ERROR;
+         return COMPLEX'(REAL'RIGHT, REAL'RIGHT);
+      else 
+         return COMPLEX'( (L.Re * R.Re + L.Im * R.Im) / magrsq,
+                    (L.Im * R.Re - L.Re * R.Im) / magrsq);
+      end if;
+    end "/";
+
+    function "/" ( L: in complex_polar; R: in complex_polar) return complex is
+		variable zout : complex_polar;
+    begin
+    	if (R.mag = 0.0) then
+         	assert FALSE report "Attempt to divide by (0,0)"
+         		severity ERROR;
+         	return COMPLEX'(REAL'RIGHT, REAL'RIGHT);
+      	else 
+         	zout.mag := L.mag/R.mag;
+		zout.arg := L.arg - R.arg;
+		return POLAR_TO_COMPLEX(zout);
+      	end if;
+    end "/";
+
+    function "/" ( L: in complex_polar; R: in complex ) return complex is
+		variable zL : complex;
+		variable temp : REAL := R.Re ** 2 + R.Im ** 2;
+    begin
+    	if (temp = 0.0) then
+         	assert FALSE report "Attempt to divide by (0.0,0.0)"
+         		severity ERROR;
+         	return COMPLEX'(REAL'RIGHT, REAL'RIGHT);
+      	else 
+         	zL := POLAR_TO_COMPLEX( L );
+         	return COMPLEX'( (zL.Re * R.Re + zL.Im * R.Im) / temp,
+                    (zL.Im * R.Re - zL.Re * R.Im) / temp);
+      	end if; 
+    end "/";
+
+    function "/" ( L: in complex;  R: in complex_polar) return complex is
+    		variable zR : complex := POLAR_TO_COMPLEX( R );
+		variable temp : REAL := zR.Re ** 2 + zR.Im ** 2;
+    begin
+    	if (R.mag = 0.0) or (temp = 0.0) then
+         	assert FALSE report "Attempt to divide by (0.0,0.0)"
+         		severity ERROR;
+         	return COMPLEX'(REAL'RIGHT, REAL'RIGHT);
+      	else 
+         	return COMPLEX'( (L.Re * zR.Re + L.Im * zR.Im) / temp,
+                    (L.Im * zR.Re - L.Re * zR.Im) / temp);
+      	end if; 
+    end "/";
+
+    function "/" ( L: in real;     R: in complex ) return complex is
+    		variable temp : REAL := R.Re ** 2 + R.Im ** 2;
+    begin 
+      	if (temp = 0.0) then
+         	assert FALSE report "Attempt to divide by (0.0,0.0)"
+         		severity ERROR;
+         	return COMPLEX'(REAL'RIGHT, REAL'RIGHT);
+      	else 
+         	temp := L / temp;
+         	return  COMPLEX'( temp * R.Re, -temp * R.Im );
+      	end if; 
+    end "/";
+
+    function "/" ( L: in complex;  R: in real )    return complex is
+    begin
+    	if (R = 0.0) then
+         	assert FALSE report "Attempt to divide by (0.0,0.0)"
+         		severity ERROR;
+         	return COMPLEX'(REAL'RIGHT, REAL'RIGHT);
+      	else 
+         	return COMPLEX'(L.Re / R, L.Im / R);
+      	end if; 
+    end "/";
+
+    function "/" ( L: in real;  R: in complex_polar) return complex is
+    		variable zR : complex := POLAR_TO_COMPLEX( R );
+		variable temp : REAL := zR.Re ** 2 + zR.Im ** 2;
+    begin
+    	if (R.mag = 0.0) or (temp = 0.0) then
+         	assert FALSE report "Attempt to divide by (0.0,0.0)"
+         		severity ERROR;
+         	return COMPLEX'(REAL'RIGHT, REAL'RIGHT);
+      	else 
+         	temp := L / temp;
+         	return  COMPLEX'( temp * zR.Re, -temp * zR.Im );
+      	end if; 
+    end "/";
+
+    function "/" ( L: in complex_polar;  R: in real) return complex is
+    		variable zL : complex := POLAR_TO_COMPLEX( L );
+    begin
+    	if (R = 0.0) then
+         	assert FALSE report "Attempt to divide by (0.0,0.0)"
+         		severity ERROR;
+         	return COMPLEX'(REAL'RIGHT, REAL'RIGHT);
+      	else 
+         	return COMPLEX'(zL.Re / R, zL.Im / R);
+      	end if; 
+    end "/";
+end  MATH_COMPLEX;
diff --git a/libraries/ieee/math_complex.vhdl b/libraries/ieee/math_complex.vhdl
new file mode 100644
index 000000000..2f9376bfb
--- /dev/null
+++ b/libraries/ieee/math_complex.vhdl
@@ -0,0 +1,126 @@
+--------------------------------------------------------------- 
+--
+-- This source file may be used and distributed without restriction.
+-- No declarations or definitions shall be included in this package.
+-- This package cannot be sold or distributed for profit. 
+--
+--   ****************************************************************
+--   *                                                              *
+--   *                      W A R N I N G		 	    *
+--   *								    *
+--   *   This DRAFT version IS NOT endorsed or approved by IEEE     *
+--   *								    *
+--   ****************************************************************
+--
+-- Title:    PACKAGE MATH_COMPLEX
+--
+-- Purpose:  VHDL declarations for mathematical package MATH_COMPLEX
+--	     which contains common complex constants and basic complex
+--	     functions and operations.
+--
+-- Author:   IEEE VHDL Math Package Study Group 
+--
+-- Notes:     
+--	The package body uses package IEEE.MATH_REAL
+--
+-- 	The package body shall be considered the formal definition of 
+-- 	the semantics of this package. Tool developers may choose to implement 
+-- 	the package body in the most efficient manner available to them.
+--
+-- History:
+-- 	Version	0.1  (Strawman) Jose A. Torres	6/22/92
+-- 	Version	0.2		Jose A. Torres	1/15/93
+-- 	Version	0.3		Jose A. Torres	4/13/93
+-- 	Version	0.4		Jose A. Torres 	4/19/93
+-- 	Version	0.5		Jose A. Torres 	4/20/93
+--	Version 0.6		Jose A. Torres  4/23/93  Added unary minus
+--							 and CONJ for polar
+--	Version 0.7		Jose A. Torres	5/28/93 Rev up for compatibility
+--							with package body.
+-------------------------------------------------------------
+Library IEEE;
+
+Package MATH_COMPLEX is
+
+
+    type COMPLEX        is record RE, IM: real; end record;
+    type COMPLEX_VECTOR is array (integer range <>) of COMPLEX;
+    type COMPLEX_POLAR  is record MAG: real; ARG: real; end record;
+
+    constant  CBASE_1: complex := COMPLEX'(1.0, 0.0);
+    constant  CBASE_j: complex := COMPLEX'(0.0, 1.0);
+    constant  CZERO: complex := COMPLEX'(0.0, 0.0);
+
+    function CABS(Z: in complex ) return real;
+    	-- returns absolute value (magnitude) of Z
+
+    function CARG(Z: in complex ) return real;
+    	-- returns argument (angle) in radians of a complex number
+
+    function CMPLX(X: in real;  Y: in real:= 0.0 ) return complex;
+    	-- returns complex number X + iY
+
+    function "-" (Z: in complex ) return complex;
+    	-- unary minus
+
+    function "-" (Z: in complex_polar ) return complex_polar;
+    	-- unary minus
+
+    function CONJ (Z: in complex) return complex;
+    	-- returns complex conjugate
+
+    function CONJ (Z: in complex_polar) return complex_polar;
+    	-- returns complex conjugate
+
+    function CSQRT(Z: in complex ) return complex_vector;
+    	-- returns square root of Z; 2 values
+
+    function CEXP(Z: in complex ) return complex;
+    	-- returns e**Z
+
+    function COMPLEX_TO_POLAR(Z: in complex ) return complex_polar;
+    	-- converts complex to complex_polar
+
+    function POLAR_TO_COMPLEX(Z: in complex_polar ) return complex;
+    	-- converts complex_polar to complex
+
+    		
+    -- arithmetic operators
+
+    function "+" ( L: in complex;  R: in complex ) return complex;
+    function "+" ( L: in complex_polar; R: in complex_polar) return complex;
+    function "+" ( L: in complex_polar; R: in complex ) return complex;
+    function "+" ( L: in complex;  R: in complex_polar) return complex;
+    function "+" ( L: in real;     R: in complex ) return complex;
+    function "+" ( L: in complex;  R: in real )    return complex;
+    function "+" ( L: in real;  R: in complex_polar) return complex;
+    function "+" ( L: in complex_polar;  R: in real) return complex;
+
+    function "-" ( L: in complex;  R: in complex ) return complex;
+    function "-" ( L: in complex_polar; R: in complex_polar) return complex;
+    function "-" ( L: in complex_polar; R: in complex ) return complex;
+    function "-" ( L: in complex;  R: in complex_polar) return complex;
+    function "-" ( L: in real;     R: in complex ) return complex;
+    function "-" ( L: in complex;  R: in real )    return complex;
+    function "-" ( L: in real;  R: in complex_polar) return complex;
+    function "-" ( L: in complex_polar;  R: in real) return complex;
+
+    function "*" ( L: in complex;  R: in complex ) return complex;
+    function "*" ( L: in complex_polar; R: in complex_polar) return complex;
+    function "*" ( L: in complex_polar; R: in complex ) return complex;
+    function "*" ( L: in complex;  R: in complex_polar) return complex;
+    function "*" ( L: in real;     R: in complex ) return complex;
+    function "*" ( L: in complex;  R: in real )    return complex;
+    function "*" ( L: in real;  R: in complex_polar) return complex;
+    function "*" ( L: in complex_polar;  R: in real) return complex;
+
+
+    function "/" ( L: in complex;  R: in complex ) return complex;
+    function "/" ( L: in complex_polar; R: in complex_polar) return complex;
+    function "/" ( L: in complex_polar; R: in complex ) return complex;
+    function "/" ( L: in complex;  R: in complex_polar) return complex;
+    function "/" ( L: in real;     R: in complex ) return complex;
+    function "/" ( L: in complex;  R: in real )    return complex;
+    function "/" ( L: in real;  R: in complex_polar) return complex;
+    function "/" ( L: in complex_polar;  R: in real) return complex;
+end  MATH_COMPLEX;
diff --git a/libraries/ieee/math_real-body.vhdl b/libraries/ieee/math_real-body.vhdl
new file mode 100644
index 000000000..1473f6787
--- /dev/null
+++ b/libraries/ieee/math_real-body.vhdl
@@ -0,0 +1,410 @@
+--------------------------------------------------------------- 
+--
+-- This source file may be used and distributed without restriction.
+-- No declarations or definitions shall be added to this package.
+-- This package cannot be sold or distributed for profit. 
+--
+--   ****************************************************************
+--   *                                                              *
+--   *                      W A R N I N G		 	    *
+--   *								    *
+--   *   This DRAFT version IS NOT endorsed or approved by IEEE     *
+--   *							            *
+--   ****************************************************************
+--
+-- Title:    PACKAGE BODY MATH_REAL
+--
+-- Library:  This package shall be compiled into a library 
+--           symbolically named IEEE.
+--
+-- Purpose:  VHDL declarations for mathematical package MATH_REAL
+--	     which contains common real constants, common real
+--	     functions, and real trascendental functions.
+--
+-- Author:   IEEE VHDL Math Package Study Group 
+--
+-- Notes:
+-- 	The package body shall be considered the formal definition of 
+-- 	the semantics of this package. Tool developers may choose to implement 
+-- 	the package body in the most efficient manner available to them.
+--
+--      Source code and algorithms for this package body comes from the 
+--	following sources: 
+--		IEEE VHDL Math Package Study Group participants,
+--		U. of Mississippi, Mentor Graphics, Synopsys,
+--		Viewlogic/Vantage, Communications of the ACM (June 1988, Vol
+--		31, Number 6, pp. 747, Pierre L'Ecuyer, Efficient and Portable
+--		Random Number Generators), Handbook of Mathematical Functions
+--	        by Milton Abramowitz and Irene A. Stegun (Dover).
+--
+-- History:
+-- 	Version 0.1	Jose A. Torres	4/23/93	First draft
+-- 	Version 0.2	Jose A. Torres	5/28/93	Fixed potentially illegal code
+--
+-- GHDL history
+--  2005-04-07  Initial version.
+-------------------------------------------------------------
+Library IEEE;
+
+Package body MATH_REAL is
+    --
+    -- non-trascendental functions
+    --
+    function SIGN (X: real ) return real is
+    	-- returns 1.0 if X > 0.0; 0.0 if X == 0.0; -1.0 if X < 0.0
+    begin
+        assert false severity failure;
+    end SIGN; 
+
+    function CEIL (X : real ) return real is
+    begin
+        assert false severity failure;
+    end CEIL; 
+
+    function FLOOR (X : real ) return real is
+    begin
+        assert false severity failure;
+    end FLOOR;
+
+    function ROUND (X : real ) return real is
+    begin
+        assert false severity failure;
+    end ROUND;
+    
+    function FMAX (X, Y : real ) return real is
+    begin
+        assert false severity failure;
+    end FMAX;
+
+    function FMIN (X, Y : real ) return real is
+    begin
+        assert false severity failure;
+    end FMIN;
+
+    --
+    -- Pseudo-random number generators
+    --
+
+    procedure UNIFORM(variable Seed1,Seed2:inout integer;variable X:out real) is
+	-- returns a pseudo-random number with uniform distribution in the 
+	-- interval (0.0, 1.0).
+	-- Before the first call to UNIFORM, the seed values (Seed1, Seed2) must
+	-- be initialized to values in the range [1, 2147483562] and 
+	-- [1, 2147483398] respectively.  The seed values are modified after 
+	-- each call to UNIFORM.
+	-- This random number generator is portable for 32-bit computers, and
+	-- it has period ~2.30584*(10**18) for each set of seed values.
+	--
+	-- For VHDL-1992, the seeds will be global variables, functions to 
+	-- initialize their values (INIT_SEED) will be provided, and the UNIFORM
+	-- procedure call will be modified accordingly.  
+	
+	variable z, k: integer;
+	begin
+        k := Seed1/53668;
+        Seed1 := 40014 * (Seed1 - k * 53668) - k * 12211;
+        
+        if Seed1 < 0  then
+            Seed1 := Seed1 + 2147483563;
+        end if;
+
+
+        k := Seed2/52774;
+        Seed2 := 40692 * (Seed2 - k * 52774) - k * 3791;
+        
+        if Seed2 < 0  then
+            Seed2 := Seed2 + 2147483399;
+        end if;
+
+        z := Seed1 - Seed2;
+        if z < 1 then
+            z := z + 2147483562;
+        end if;
+
+        X :=  REAL(Z)*4.656613e-10;
+    end UNIFORM;
+
+
+    function SRAND (seed: in integer ) return integer is
+    begin
+        assert false severity failure;
+    end SRAND;
+
+    function RAND return integer is
+    begin
+        assert false severity failure;
+    end RAND;
+
+    function GET_RAND_MAX  return integer is
+        -- The value this function returns should be the same as
+        -- RAND_MAX in /usr/include/stdlib.h
+    begin
+        assert false
+            report "Be sure to update GET_RAND_MAX in mathpack.vhd"
+            severity note;
+        return 2147483647;  -- i386 linux
+    end GET_RAND_MAX;
+
+    --
+    -- trascendental and trigonometric functions
+    --
+    function c_sqrt (x : real ) return real;
+    attribute foreign of c_sqrt : function is "VHPIDIRECT sqrt";
+    
+    function c_sqrt (x : real ) return real is
+    begin
+        assert false severity failure;
+    end c_sqrt;
+
+    function SQRT (X : real ) return real is
+    begin
+        -- check validity of argument
+        if ( X < 0.0 ) then
+            assert false report "X < 0 in SQRT(X)" 
+                severity ERROR;
+            return (0.0);
+        end if;
+        return c_sqrt(X);
+    end SQRT;
+
+    function CBRT (X : real ) return real is
+    begin
+        assert false severity failure;
+    end CBRT;
+
+    function "**" (X : integer; Y : real) return real is
+    	-- returns Y power of X ==>  X**Y;
+    	-- error if X = 0 and Y <= 0.0
+    	-- error if X < 0 and Y does not have an integer value
+    begin
+        -- check validity of argument
+        if ( X = 0  ) and ( Y <= 0.0 ) then
+            assert false report "X = 0 and Y <= 0.0 in X**Y" 
+                severity ERROR;
+            return (0.0);
+        end if;
+
+        if ( X < 0  ) and ( Y /= REAL(INTEGER(Y)) ) then
+            assert false 
+                report "X < 0 and Y \= integer in X**Y" 
+                severity ERROR;
+            return (0.0);
+        end if;
+
+        -- compute the result
+        return EXP (Y * LOG (REAL(X)));
+    end "**";
+
+    function "**" (X : real; Y : real) return real is
+    	-- returns Y power of X ==>  X**Y;
+    	-- error if X = 0.0 and Y <= 0.0
+    	-- error if X < 0.0 and Y does not have an integer value
+    begin
+        -- check validity of argument
+        if ( X = 0.0  ) and ( Y <= 0.0 ) then
+            assert false report "X = 0.0 and Y <= 0.0 in X**Y" 
+                severity ERROR;
+            return (0.0);
+        end if;
+
+        if ( X < 0.0  ) and ( Y /= REAL(INTEGER(Y)) ) then
+            assert false report "X < 0.0 and Y \= integer in X**Y" 
+                severity ERROR;
+            return (0.0);
+        end if;
+
+        -- compute the result
+        return EXP (Y * LOG (X));
+    end "**";
+
+    function EXP  (X : real ) return real is
+    begin
+        assert false severity failure;
+    end EXP;
+
+    function c_log (x : real ) return real;
+    attribute foreign of c_log : function is "VHPIDIRECT log"; 
+
+    function c_log (x : real ) return real is
+    begin
+        assert false severity failure;
+    end c_log; 
+
+    function LOG (X : real ) return real is
+    	-- returns natural logarithm of X; X > 0
+        --
+        -- This function computes the exponential using the following series:
+        --    log(x) = 2[ (x-1)/(x+1) + (((x-1)/(x+1))**3)/3.0 + ...] ; x > 0
+        -- 
+    begin
+    	-- check validity of argument
+    	if ( x <= 0.0 ) then
+       	  assert false report "X <= 0 in LOG(X)" 
+			severity ERROR;
+            return(REAL'LOW);
+    	end if;
+    	return c_log(x); 
+    end LOG;
+
+    function LOG (BASE: positive; X : real) return real is
+    	-- returns logarithm base BASE of X; X > 0
+    begin
+    	-- check validity of argument
+    	if ( BASE <= 0 ) or ( x <= 0.0 ) then
+       	  assert false report "BASE <= 0 or X <= 0.0 in LOG(BASE, X)" 
+				severity ERROR;
+            return(REAL'LOW);
+    	end if; 
+        -- compute the value
+        return (LOG(X)/LOG(REAL(BASE)));
+    end LOG;
+
+    function  SIN (X : real ) return real is
+    begin 
+        assert false severity failure;
+    end SIN;
+
+   
+    function COS (x : REAL) return REAL is 
+    begin 
+        assert false severity failure;
+    end COS;
+   
+    function TAN (x : REAL) return REAL is 
+    begin
+        assert false severity failure;
+    end TAN; 
+    
+    function c_asin (x : real ) return real;
+    attribute foreign of c_asin : function is "VHPIDIRECT asin"; 
+
+    function c_asin (x : real ) return real is
+    begin
+        assert false severity failure;
+    end c_asin; 
+
+    function ASIN (x : real ) return real is
+        -- returns  -PI/2 < asin X < PI/2; | X | <= 1
+    begin   
+        if abs x > 1.0 then 
+            assert false
+                report "Out of range parameter passed to ASIN" 
+                severity ERROR;
+            return x;
+        else
+            return c_asin(x);
+        end if; 
+    end ASIN; 
+   
+    function c_acos (x : real ) return real;
+    attribute foreign of c_acos : function is "VHPIDIRECT acos"; 
+
+    function c_acos (x : real ) return real is
+    begin
+        assert false severity failure;
+    end c_acos; 
+
+    function ACOS (x : REAL) return REAL is
+    	-- returns  0 < acos X < PI; | X | <= 1
+    begin  
+      if abs x > 1.0 then 
+         assert false 
+            report "Out of range parameter passed to ACOS" 
+			severity ERROR; 
+         return x;
+      else
+         return c_acos(x);
+      end if;
+    end ACOS; 
+   
+   function ATAN (x : REAL) return REAL is
+    	-- returns  -PI/2 < atan X < PI/2
+   begin
+        assert false severity failure;
+   end ATAN; 
+
+    function c_atan2 (x : real; y : real) return real;
+    attribute foreign of c_atan2 : function is "VHPIDIRECT atan2"; 
+
+    function c_atan2 (x : real; y: real) return real is
+    begin
+        assert false severity failure;
+    end c_atan2; 
+
+    function ATAN2 (x : REAL; y : REAL) return REAL is 
+        -- returns  atan (X/Y); -PI < atan2(X,Y) < PI; Y /= 0.0
+    begin   
+        if y = 0.0 and x = 0.0 then 
+            assert false 
+                report "atan2(0.0, 0.0) is undetermined, returned 0,0" 
+                severity NOTE;
+            return 0.0; 
+        else
+            return c_atan2(x,y);
+        end if;     
+    end ATAN2; 
+
+
+    function SINH (X : real) return real is
+    	-- hyperbolic sine; returns (e**X - e**(-X))/2
+    begin
+        assert false severity failure;
+    end SINH;
+
+    function  COSH (X : real) return real is
+    	-- hyperbolic cosine; returns (e**X + e**(-X))/2
+    begin
+        assert false severity failure;
+    end COSH;
+
+    function  TANH (X : real) return real is
+    	-- hyperbolic tangent; -- returns (e**X - e**(-X))/(e**X + e**(-X))
+    begin
+        assert false severity failure;
+    end TANH;
+    
+    function ASINH (X : real) return real is
+    	-- returns ln( X + sqrt( X**2 + 1))
+    begin
+        assert false severity failure;
+    end ASINH;
+
+    function c_acosh (x : real ) return real;
+    attribute foreign of c_acosh : function is "VHPIDIRECT acosh"; 
+
+    function c_acosh (x : real ) return real is
+    begin
+        assert false severity failure;
+    end c_acosh;
+
+    function ACOSH (X : real) return real is
+    	-- returns ln( X + sqrt( X**2 - 1));   X >= 1
+    begin
+      	if abs x >= 1.0 then 
+         	assert false report "Out of range parameter passed to ACOSH" 
+			severity ERROR; 
+         	return x;
+      	end if; 
+        return c_acosh(x);
+    end ACOSH;
+
+    function c_atanh (x : real ) return real;
+    attribute foreign of c_atanh : function is "VHPIDIRECT atanh"; 
+
+    function c_atanh (x : real ) return real is
+    begin
+        assert false severity failure;
+    end c_atanh;
+
+    function ATANH (X : real) return real is
+    	-- returns (ln( (1 + X)/(1 - X)))/2 ; | X | < 1
+    begin
+      	if abs x < 1.0 then 
+        	assert false report "Out of range parameter passed to ATANH" 
+			severity ERROR; 
+        	return x;
+      	end if; 
+        return c_atanh(x);
+    end ATANH; 
+
+end  MATH_REAL;
diff --git a/libraries/ieee/math_real.vhdl b/libraries/ieee/math_real.vhdl
new file mode 100644
index 000000000..c70d2160b
--- /dev/null
+++ b/libraries/ieee/math_real.vhdl
@@ -0,0 +1,223 @@
+------------------------------------------------------------------------
+--
+-- This source file may be used and distributed without restriction.
+-- No declarations or definitions shall be added to this package. 
+-- This package cannot be sold or distributed for profit.
+--
+--   ****************************************************************
+--   *                                                              *
+--   *                      W A R N I N G		 	    *
+--   *								    *
+--   *   This DRAFT version IS NOT endorsed or approved by IEEE     *
+--   *								    *
+--   ****************************************************************
+--
+-- Title:    PACKAGE MATH_REAL
+--
+-- Library:  This package shall be compiled into a library 
+--           symbolically named IEEE.
+--
+-- Purpose:  VHDL declarations for mathematical package MATH_REAL
+--	     which contains common real constants, common real
+--	     functions, and real trascendental functions.
+--
+-- Author:   IEEE VHDL Math Package Study Group 
+--
+-- Notes:
+-- 	The package body shall be considered the formal definition of 
+-- 	the semantics of this package. Tool developers may choose to implement 
+-- 	the package body in the most efficient manner available to them.
+--
+-- History:
+-- 	Version 0.1  (Strawman) Jose A. Torres	6/22/92
+-- 	Version 0.2		Jose A. Torres	1/15/93
+-- 	Version	0.3		Jose A. Torres	4/13/93
+--	Version 0.4		Jose A. Torres	4/19/93
+--	Version 0.5		Jose A. Torres	4/20/93 Added RANDOM()
+--	Version 0.6		Jose A. Torres	4/23/93 Renamed RANDOM as
+--							UNIFORM.  Modified
+--							rights banner.
+--	Version 0.7		Jose A. Torres	5/28/93 Rev up for compatibility
+--							with package body.
+--
+-- GHDL history
+--  2005-04-07  Initial version.
+--  2005-09-01  Some PI constants added.
+-------------------------------------------------------------
+Library IEEE;
+
+Package MATH_REAL is
+
+    -- 
+    -- commonly used constants
+    --
+    constant MATH_E          : real := 2.71828_18284_59045_23536; --  e
+    constant MATH_1_OVER_E   : real := 0.36787_94411_71442_32160; --  1/e
+    constant MATH_PI         : real := 3.14159_26535_89793_23846; --  pi
+    constant MATH_2_PI       : real := 2.0 * MATH_PI;             -- 2 * pi
+    constant MATH_1_OVER_PI  : real := 0.31830_98861_83790_67154; -- 1/pi
+    constant MATH_PI_OVER_2  : real := 1.57079_63267_94896_61923; -- pi / 2
+    constant MATH_PI_OVER_4  : real := 0.78539_81633_97448_30962; -- pi / 4
+    constant  MATH_LOG_OF_2  : real := 0.69314_71805_59945_30942;
+    						  -- natural log of 2
+    constant  MATH_LOG_OF_10: real := 2.30258_50929_94045_68402;
+    						  -- natural log of10
+    constant  MATH_LOG2_OF_E:  real := 1.44269_50408_88963_4074;
+    						  -- log base 2 of e
+    constant  MATH_LOG10_OF_E: real := 0.43429_44819_03251_82765;
+    						  -- log base 10 of e
+    constant  MATH_SQRT2: real := 1.41421_35623_73095_04880; 
+    						  -- sqrt of 2
+    constant  MATH_SQRT1_2: real := 0.70710_67811_86547_52440; 
+    						  -- sqrt of 1/2
+    constant  MATH_SQRT_PI: real := 1.77245_38509_05516_02730; 
+    						  -- sqrt of pi
+    constant  MATH_DEG_TO_RAD: real := 0.01745_32925_19943_29577;
+    			  	-- conversion factor from degree to radian
+    constant  MATH_RAD_TO_DEG: real := 57.29577_95130_82320_87685;
+    			   	-- conversion factor from radian to degree
+
+    --
+    -- function declarations
+    --
+    function SIGN (X: real ) return real;
+    	-- returns 1.0 if X > 0.0; 0.0 if X == 0.0; -1.0 if X < 0.0
+
+    function CEIL (X : real ) return real;
+    attribute foreign of ceil : function is "VHPIDIRECT ceil"; 
+    	-- returns smallest integer value (as real) not less than X
+
+    function FLOOR (X : real ) return real;
+    attribute foreign of floor : function is "VHPIDIRECT floor"; 
+    	-- returns largest integer value (as real) not greater than X
+
+    function ROUND (X : real ) return real;
+    attribute foreign of round : function is "VHPIDIRECT round"; 
+    	-- returns integer FLOOR(X + 0.5) if X > 0;
+    	-- return integer CEIL(X - 0.5) if X < 0
+    
+    function FMAX (X, Y : real ) return real;
+    attribute foreign of fmax : function is "VHPIDIRECT fmax"; 
+    	-- returns the algebraically larger of X and Y
+
+    function FMIN (X, Y : real ) return real;
+    attribute foreign of fmin : function is "VHPIDIRECT fmin"; 
+    	-- returns the algebraically smaller of X and Y
+
+    procedure UNIFORM (variable Seed1,Seed2:inout integer; variable X:out real);
+	-- returns a pseudo-random number with uniform distribution in the 
+	-- interval (0.0, 1.0).
+	-- Before the first call to UNIFORM, the seed values (Seed1, Seed2) must
+	-- be initialized to values in the range [1, 2147483562] and 
+	-- [1, 2147483398] respectively.  The seed values are modified after 
+	-- each call to UNIFORM.
+	-- This random number generator is portable for 32-bit computers, and
+	-- it has period ~2.30584*(10**18) for each set of seed values.
+	--
+	-- For VHDL-1992, the seeds will be global variables, functions to 
+	-- initialize their values (INIT_SEED) will be provided, and the UNIFORM
+	-- procedure call will be modified accordingly.  
+
+    function SRAND (seed: in integer ) return integer;
+    attribute foreign of srand : function is "VHPIDIRECT srand"; 
+    	--
+	-- sets value of seed for sequence of 
+    	-- pseudo-random numbers.   
+    	-- It uses the foreign native C function srand().
+
+    function RAND return integer;		
+    attribute foreign of rand : function is "VHPIDIRECT rand"; 
+    	--
+	-- returns an integer pseudo-random number with uniform distribution.
+	-- It uses the foreign native C function rand(). 
+    	-- Seed for the sequence is initialized with the
+    	-- SRAND() function and value of the seed is changed every
+        -- time SRAND() is called,  but it is not visible.
+    	-- The range of generated values is platform dependent.
+
+    function GET_RAND_MAX  return integer;		
+    	--
+	-- returns the upper bound of the range of the
+    	-- pseudo-random numbers generated by  RAND().
+    	-- The support for this function is platform dependent, and
+	-- it uses foreign native C functions or constants.
+	-- It may not be available in some platforms.
+    	-- Note: the value of (RAND() / GET_RAND_MAX()) is a
+    	--       pseudo-random number distributed between 0 & 1.
+
+    function SQRT (X : real ) return real;
+    	-- returns square root of X;  X >= 0
+
+    function CBRT (X : real ) return real;
+    attribute foreign of cbrt : function is "VHPIDIRECT cbrt"; 
+    	-- returns cube root of X
+
+    function "**" (X : integer; Y : real) return real;
+    	-- returns Y power of X ==>  X**Y;
+    	-- error if X = 0 and Y <= 0.0
+    	-- error if X < 0 and Y does not have an integer value
+
+    function "**" (X : real; Y : real) return real;
+    	-- returns Y power of X ==>  X**Y;
+    	-- error if X = 0.0 and Y <= 0.0
+    	-- error if X < 0.0 and Y does not have an integer value
+
+    function EXP  (X : real ) return real;
+    attribute foreign of exp : function is "VHPIDIRECT exp"; 
+    	-- returns e**X; where e = MATH_E
+
+    function LOG (X : real ) return real;
+    	-- returns natural logarithm of X; X > 0
+
+    function LOG (BASE: positive; X : real) return real;
+    	-- returns logarithm base BASE of X; X > 0
+
+    function  SIN (X : real ) return real;
+    attribute foreign of sin : function is "VHPIDIRECT sin"; 
+    	-- returns sin X; X in radians
+
+    function  COS ( X : real ) return real;
+    attribute foreign of cos : function is "VHPIDIRECT cos"; 
+    	-- returns cos X; X in radians
+
+    function  TAN (X : real ) return real;
+    attribute foreign of tan : function is "VHPIDIRECT tan"; 
+    	-- returns tan X; X in radians
+    	-- X /= ((2k+1) * PI/2), where k is an integer
+
+    function  ASIN (X : real ) return real; 
+    	-- returns  -PI/2 < asin X < PI/2; | X | <= 1
+
+    function  ACOS (X : real ) return real;
+    	-- returns  0 < acos X < PI; | X | <= 1
+
+    function  ATAN (X : real) return real;
+    attribute foreign of atan : function is "VHPIDIRECT atan"; 
+    	-- returns  -PI/2 < atan X < PI/2
+
+    function  ATAN2 (X : real; Y : real) return real;
+    	-- returns  atan (X/Y); -PI < atan2(X,Y) < PI; Y /= 0.0
+
+    function SINH (X : real) return real;
+    attribute foreign of sinh : function is "VHPIDIRECT sinh"; 
+    	-- hyperbolic sine; returns (e**X - e**(-X))/2
+
+    function  COSH (X : real) return real;
+    attribute foreign of cosh : function is "VHPIDIRECT cosh"; 
+    	-- hyperbolic cosine; returns (e**X + e**(-X))/2
+
+    function  TANH (X : real) return real;
+    attribute foreign of tanh : function is "VHPIDIRECT tanh"; 
+    	-- hyperbolic tangent; -- returns (e**X - e**(-X))/(e**X + e**(-X))
+    
+    function ASINH (X : real) return real;
+    attribute foreign of asinh : function is "VHPIDIRECT asinh"; 
+    	-- returns ln( X + sqrt( X**2 + 1))
+
+    function ACOSH (X : real) return real;
+    	-- returns ln( X + sqrt( X**2 - 1));   X >= 1
+
+    function ATANH (X : real) return real;
+    	-- returns (ln( (1 + X)/(1 - X)))/2 ; | X | < 1
+
+end  MATH_REAL;
diff --git a/libraries/ieee/numeric_bit-body.vhdl b/libraries/ieee/numeric_bit-body.vhdl
new file mode 100644
index 000000000..895594631
--- /dev/null
+++ b/libraries/ieee/numeric_bit-body.vhdl
@@ -0,0 +1,1818 @@
+-- -----------------------------------------------------------------------------
+--
+-- Copyright 1995 by IEEE. All rights reserved.
+--
+-- This source file is considered by the IEEE to be an essential part of the use
+-- of the standard 1076.3 and as such may be distributed without change, except
+-- as permitted by the standard. This source file may not be sold or distributed
+-- for profit. This package may be modified to include additional data required
+-- by tools, but must in no way change the external interfaces or simulation
+-- behaviour of the description. It is permissible to add comments and/or
+-- attributes to the package declarations, but not to change or delete any
+-- original lines of the approved package declaration. The package body may be
+-- changed only in accordance with the terms of clauses 7.1 and 7.2 of the
+-- standard.
+--
+-- Title      : Standard VHDL Synthesis Package (1076.3, NUMERIC_BIT)
+--
+-- Library    : This package shall be compiled into a library symbolically
+--            : named IEEE.
+--
+-- Developers : IEEE DASC Synthesis Working Group, PAR 1076.3
+--
+-- Purpose    : This package defines numeric types and arithmetic functions
+--            : for use with synthesis tools. Two numeric types are defined:
+--            : -- > UNSIGNED: represents an UNSIGNED number in vector form
+--            : -- > SIGNED: represents a SIGNED number in vector form
+--            : The base element type is type BIT.
+--            : The leftmost bit is treated as the most significant bit.
+--            : Signed vectors are represented in two's complement form.
+--            : This package contains overloaded arithmetic operators on
+--            : the SIGNED and UNSIGNED types. The package also contains
+--            : useful type conversions functions, clock detection
+--            : functions, and other utility functions.
+--            :
+--            : If any argument to a function is a null array, a null array is
+--            : returned (exceptions, if any, are noted individually).
+--
+-- Limitation :
+--
+-- Note       : No declarations or definitions shall be included in,
+--            : or excluded from this package. The "package declaration"
+--            : defines the types, subtypes and declarations of
+--            : NUMERIC_BIT. The NUMERIC_BIT package body shall be
+--            : considered the formal definition of the semantics of
+--            : this package. Tool developers may choose to implement
+--            : the package body in the most efficient manner available
+--            : to them.
+--            :
+-- -----------------------------------------------------------------------------
+-- Version    : 2.4
+-- Date       : 12 April 1995
+-- -----------------------------------------------------------------------------
+
+--==============================================================================
+--======================= Package Body =========================================
+--==============================================================================
+
+package body NUMERIC_BIT is
+
+  -- null range array constants
+
+  constant NAU: UNSIGNED(0 downto 1) := (others => '0');
+  constant NAS: SIGNED(0 downto 1) := (others => '0');
+
+  -- implementation controls
+
+  constant NO_WARNING: BOOLEAN := FALSE; -- default to emit warnings
+
+  --=========================Local Subprograms =================================
+
+  function MAX (LEFT, RIGHT: INTEGER) return INTEGER is
+  begin
+    if LEFT > RIGHT then return LEFT;
+    else return RIGHT;
+    end if;
+  end MAX;
+
+  function MIN (LEFT, RIGHT: INTEGER) return INTEGER is
+  begin
+    if LEFT < RIGHT then return LEFT;
+    else return RIGHT;
+    end if;
+  end MIN;
+
+  function SIGNED_NUM_BITS (ARG: INTEGER) return NATURAL is
+    variable NBITS: NATURAL;
+    variable N: NATURAL;
+  begin
+    if ARG >= 0 then
+      N := ARG;
+    else
+      N := -(ARG+1);
+    end if;
+    NBITS := 1;
+    while N > 0 loop
+      NBITS := NBITS+1;
+      N := N / 2;
+    end loop;
+    return NBITS;
+  end SIGNED_NUM_BITS;
+
+  function UNSIGNED_NUM_BITS (ARG: NATURAL) return NATURAL is
+    variable NBITS: NATURAL;
+    variable N: NATURAL;
+  begin
+    N := ARG;
+    NBITS := 1;
+    while N > 1 loop
+      NBITS := NBITS+1;
+      N := N / 2;
+    end loop;
+    return NBITS;
+  end UNSIGNED_NUM_BITS;
+
+  ------------------------------------------------------------------------------
+  -- this internal function computes the addition of two UNSIGNED
+  -- with input carry
+  -- * the two arguments are of the same length
+
+  function ADD_UNSIGNED (L, R: UNSIGNED; C: BIT) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(L_LEFT downto 0) is R;
+    variable RESULT: UNSIGNED(L_LEFT downto 0);
+    variable CBIT: BIT := C;
+  begin
+    for I in 0 to L_LEFT loop
+      RESULT(I) := CBIT xor XL(I) xor XR(I);
+      CBIT := (CBIT and XL(I)) or (CBIT and XR(I)) or (XL(I) and XR(I));
+    end loop;
+    return RESULT;
+  end ADD_UNSIGNED;
+
+  -- this internal function computes the addition of two SIGNED
+  -- with input carry
+  -- * the two arguments are of the same length
+
+  function ADD_SIGNED (L, R: SIGNED; C: BIT) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    alias XR: SIGNED(L_LEFT downto 0) is R;
+    variable RESULT: SIGNED(L_LEFT downto 0);
+    variable CBIT: BIT := C;
+  begin
+    for I in 0 to L_LEFT loop
+      RESULT(I) := CBIT xor XL(I) xor XR(I);
+      CBIT := (CBIT and XL(I)) or (CBIT and XR(I)) or (XL(I) and XR(I));
+    end loop;
+    return RESULT;
+  end ADD_SIGNED;
+
+  ------------------------------------------------------------------------------
+
+  -- this internal procedure computes UNSIGNED division
+  -- giving the quotient and remainder.
+  procedure DIVMOD (NUM, XDENOM: UNSIGNED; XQUOT, XREMAIN: out UNSIGNED) is
+    variable TEMP: UNSIGNED(NUM'LENGTH downto 0);
+    variable QUOT: UNSIGNED(MAX(NUM'LENGTH, XDENOM'LENGTH)-1 downto 0);
+    alias DENOM: UNSIGNED(XDENOM'LENGTH-1 downto 0) is XDENOM;
+    variable TOPBIT: INTEGER;
+  begin
+    TEMP := "0"&NUM;
+    QUOT := (others => '0');
+    TOPBIT := -1;
+    for J in DENOM'RANGE loop
+      if DENOM(J)='1' then
+        TOPBIT := J;
+        exit;
+      end if;
+    end loop;
+    assert TOPBIT >= 0 report "DIV, MOD, or REM by zero" severity ERROR;
+
+    for J in NUM'LENGTH-(TOPBIT+1) downto 0 loop
+      if TEMP(TOPBIT+J+1 downto J) >= "0"&DENOM(TOPBIT downto 0) then
+        TEMP(TOPBIT+J+1 downto J) := (TEMP(TOPBIT+J+1 downto J))
+            -("0"&DENOM(TOPBIT downto 0));
+        QUOT(J) := '1';
+      end if;
+      assert TEMP(TOPBIT+J+1)='0'
+          report "internal error in the division algorithm"
+          severity ERROR;
+    end loop;
+    XQUOT := RESIZE(QUOT, XQUOT'LENGTH);
+    XREMAIN := RESIZE(TEMP, XREMAIN'LENGTH);
+  end DIVMOD;
+
+  -----------------Local Subprograms - shift/rotate ops-------------------------
+
+  function XSLL (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: BIT_VECTOR(ARG_L downto 0) := (others => '0');
+  begin
+    if COUNT <= ARG_L then
+      RESULT(ARG_L downto COUNT) := XARG(ARG_L-COUNT downto 0);
+    end if;
+    return RESULT;
+  end XSLL;
+
+  function XSRL (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: BIT_VECTOR(ARG_L downto 0) := (others => '0');
+  begin
+    if COUNT <= ARG_L then
+      RESULT(ARG_L-COUNT downto 0) := XARG(ARG_L downto COUNT);
+    end if;
+    return RESULT;
+  end XSRL;
+
+  function XSRA (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: BIT_VECTOR(ARG_L downto 0);
+    variable XCOUNT: NATURAL := COUNT;
+  begin
+    if ((ARG'LENGTH <= 1) or (XCOUNT = 0)) then return ARG;
+    else
+      if (XCOUNT > ARG_L) then XCOUNT := ARG_L;
+      end if;
+      RESULT(ARG_L-XCOUNT downto 0) := XARG(ARG_L downto XCOUNT);
+      RESULT(ARG_L downto (ARG_L - XCOUNT + 1)) := (others => XARG(ARG_L));
+    end if;
+    return RESULT;
+  end XSRA;
+
+  function XROL (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: BIT_VECTOR(ARG_L downto 0) := XARG;
+    variable COUNTM: INTEGER;
+  begin
+    COUNTM := COUNT mod (ARG_L + 1);
+    if COUNTM /= 0 then
+      RESULT(ARG_L downto COUNTM) := XARG(ARG_L-COUNTM downto 0);
+      RESULT(COUNTM-1 downto 0) := XARG(ARG_L downto ARG_L-COUNTM+1);
+    end if;
+    return RESULT;
+  end XROL;
+
+  function XROR (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: BIT_VECTOR(ARG_L downto 0) := XARG;
+    variable COUNTM: INTEGER;
+  begin
+    COUNTM := COUNT mod (ARG_L + 1);
+    if COUNTM /= 0 then
+      RESULT(ARG_L-COUNTM downto 0) := XARG(ARG_L downto COUNTM);
+      RESULT(ARG_L downto ARG_L-COUNTM+1) := XARG(COUNTM-1 downto 0);
+    end if;
+    return RESULT;
+  end XROR;
+
+  ---------------- Local Subprograms - Relational Operators --------------------
+
+  -- General "=" for UNSIGNED vectors, same length
+  --
+  function UNSIGNED_EQUAL (L, R: UNSIGNED) return BOOLEAN is
+  begin
+    return BIT_VECTOR(L) = BIT_VECTOR(R);
+  end UNSIGNED_EQUAL;
+
+  --
+  -- General "=" for SIGNED vectors, same length
+  --
+  function SIGNED_EQUAL (L, R: SIGNED) return BOOLEAN is
+  begin
+    return BIT_VECTOR(L) = BIT_VECTOR(R);
+  end SIGNED_EQUAL;
+
+  --
+  -- General "<" for UNSIGNED vectors, same length
+  --
+  function UNSIGNED_LESS (L, R: UNSIGNED) return BOOLEAN is
+  begin
+    return BIT_VECTOR(L) < BIT_VECTOR(R);
+  end UNSIGNED_LESS;
+
+  --
+  -- General "<" function for SIGNED vectors, same length
+  --
+  function SIGNED_LESS (L, R: SIGNED) return BOOLEAN is
+    -- Need aliases to assure index direction
+    variable INTERN_L: SIGNED(0 to L'LENGTH-1);
+    variable INTERN_R: SIGNED(0 to R'LENGTH-1);
+  begin
+    INTERN_L := L;
+    INTERN_R := R;
+    INTERN_L(0) := not INTERN_L(0);
+    INTERN_R(0) := not INTERN_R(0);
+    return BIT_VECTOR(INTERN_L) < BIT_VECTOR(INTERN_R);
+  end SIGNED_LESS;
+
+  --
+  -- General "<=" function for UNSIGNED vectors, same length
+  --
+  function UNSIGNED_LESS_OR_EQUAL (L, R: UNSIGNED) return BOOLEAN is
+  begin
+    return BIT_VECTOR(L) <= BIT_VECTOR(R);
+  end UNSIGNED_LESS_OR_EQUAL;
+
+  --
+  -- General "<=" function for SIGNED vectors, same length
+  --
+  function SIGNED_LESS_OR_EQUAL (L, R: SIGNED) return BOOLEAN is
+    -- Need aliases to assure index direction
+    variable INTERN_L: SIGNED(0 to L'LENGTH-1);
+    variable INTERN_R: SIGNED(0 to R'LENGTH-1);
+  begin
+    INTERN_L := L;
+    INTERN_R := R;
+    INTERN_L(0) := not INTERN_L(0);
+    INTERN_R(0) := not INTERN_R(0);
+    return BIT_VECTOR(INTERN_L) <= BIT_VECTOR(INTERN_R);
+  end SIGNED_LESS_OR_EQUAL;
+
+  --====================== Exported Functions ==================================
+
+  -- Id: A.1
+  function "abs" (ARG: SIGNED) return SIGNED is
+    constant ARG_LEFT: INTEGER := ARG'LENGTH-1;
+    variable RESULT: SIGNED(ARG_LEFT downto 0);
+  begin
+    if ARG'LENGTH < 1 then return NAS;
+    end if;
+    RESULT := ARG;
+    if RESULT(RESULT'LEFT) = '1' then
+      RESULT := -RESULT;
+    end if;
+    return RESULT;
+  end "abs";
+
+  -- Id: A.2
+  function "-" (ARG: SIGNED) return SIGNED is
+    constant ARG_LEFT: INTEGER := ARG'LENGTH-1;
+    alias XARG: SIGNED(ARG_LEFT downto 0) is ARG;
+    variable RESULT: SIGNED(ARG_LEFT downto 0);
+    variable CBIT: BIT := '1';
+  begin
+    if ARG'LENGTH < 1 then return NAS;
+    end if;
+    for I in 0 to RESULT'LEFT loop
+      RESULT(I) := not(XARG(I)) xor CBIT;
+      CBIT := CBIT and not(XARG(I));
+    end loop;
+    return RESULT;
+  end "-";
+
+  --============================================================================
+
+  -- Id: A.3
+  function "+" (L, R: UNSIGNED) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    return ADD_UNSIGNED(RESIZE(L, SIZE), RESIZE(R, SIZE), '0');
+  end "+";
+
+  -- Id: A.4
+  function "+" (L, R: SIGNED) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    return ADD_SIGNED(RESIZE(L, SIZE), RESIZE(R, SIZE), '0');
+  end "+";
+
+  -- Id: A.5
+  function "+" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+  begin
+    return L + TO_UNSIGNED(R, L'LENGTH);
+  end "+";
+
+  -- Id: A.6
+  function "+" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+  begin
+    return TO_UNSIGNED(L, R'LENGTH) + R;
+  end "+";
+
+  -- Id: A.7
+  function "+" (L: SIGNED; R: INTEGER) return SIGNED is
+  begin
+    return L + TO_SIGNED(R, L'LENGTH);
+  end "+";
+
+  -- Id: A.8
+  function "+" (L: INTEGER; R: SIGNED) return SIGNED is
+  begin
+    return TO_SIGNED(L, R'LENGTH) + R;
+  end "+";
+
+  --============================================================================
+
+  -- Id: A.9
+  function "-" (L, R: UNSIGNED) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    return ADD_UNSIGNED(RESIZE(L, SIZE),
+        not(RESIZE(R, SIZE)),
+        '1');
+  end "-";
+
+  -- Id: A.10
+  function "-" (L, R: SIGNED) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    return ADD_SIGNED(RESIZE(L, SIZE),
+        not(RESIZE(R, SIZE)),
+        '1');
+  end "-";
+
+  -- Id: A.11
+  function "-" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+  begin
+    return L - TO_UNSIGNED(R, L'LENGTH);
+  end "-";
+
+  -- Id: A.12
+  function "-" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+  begin
+    return TO_UNSIGNED(L, R'LENGTH) - R;
+  end "-";
+
+  -- Id: A.13
+  function "-" (L: SIGNED; R: INTEGER) return SIGNED is
+  begin
+    return L - TO_SIGNED(R, L'LENGTH);
+  end "-";
+
+  -- Id: A.14
+  function "-" (L: INTEGER; R: SIGNED) return SIGNED is
+  begin
+    return TO_SIGNED(L, R'LENGTH) - R;
+  end "-";
+
+  --============================================================================
+
+  -- Id: A.15
+  function "*" (L, R: UNSIGNED) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    variable RESULT: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0) := (others => '0');
+    variable ADVAL: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    ADVAL := RESIZE(XR, RESULT'LENGTH);
+    for I in 0 to L_LEFT loop
+      if XL(I)='1' then RESULT := RESULT + ADVAL;
+      end if;
+      ADVAL := SHIFT_LEFT(ADVAL, 1);
+    end loop;
+    return RESULT;
+  end "*";
+
+  -- Id: A.16
+  function "*" (L, R: SIGNED) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    variable XL: SIGNED(L_LEFT downto 0);
+    variable XR: SIGNED(R_LEFT downto 0);
+    variable RESULT: SIGNED((L_LEFT+R_LEFT+1) downto 0) := (others => '0');
+    variable ADVAL: SIGNED((L_LEFT+R_LEFT+1) downto 0);
+  begin
+    if ((L_LEFT < 0) or (R_LEFT < 0)) then return NAS;
+    end if;
+    XL := L;
+    XR := R;
+    ADVAL := RESIZE(XR, RESULT'LENGTH);
+    for I in 0 to L_LEFT-1 loop
+      if XL(I)='1' then RESULT := RESULT + ADVAL;
+      end if;
+      ADVAL := SHIFT_LEFT(ADVAL, 1);
+    end loop;
+    if XL(L_LEFT)='1' then
+      RESULT := RESULT - ADVAL;
+    end if;
+    return RESULT;
+  end "*";
+
+  -- Id: A.17
+  function "*" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+  begin
+    return L * TO_UNSIGNED(R, L'LENGTH);
+  end "*";
+
+  -- Id: A.18
+  function "*" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+  begin
+    return TO_UNSIGNED(L, R'LENGTH) * R;
+  end "*";
+
+  -- Id: A.19
+  function "*" (L: SIGNED; R: INTEGER) return SIGNED is
+  begin
+    return L * TO_SIGNED(R, L'LENGTH);
+  end "*";
+
+  -- Id: A.20
+  function "*" (L: INTEGER; R: SIGNED) return SIGNED is
+  begin
+    return TO_SIGNED(L, R'LENGTH) * R;
+  end "*";
+
+  --============================================================================
+
+  -- Id: A.21
+  function "/" (L, R: UNSIGNED) return UNSIGNED is
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    DIVMOD(L, R, FQUOT, FREMAIN);
+    return FQUOT;
+  end "/";
+
+  -- Id: A.22
+  function "/" (L, R: SIGNED) return SIGNED is
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+    variable XNUM: UNSIGNED(L'LENGTH-1 downto 0);
+    variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0);
+    variable QNEG: BOOLEAN := FALSE;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    if L(L'LEFT)='1' then
+      XNUM := UNSIGNED(-L);
+      QNEG := TRUE;
+    else
+      XNUM := UNSIGNED(L);
+    end if;
+    if R(R'LEFT)='1' then
+      XDENOM := UNSIGNED(-R);
+      QNEG := not QNEG;
+    else
+      XDENOM := UNSIGNED(R);
+    end if;
+    DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN);
+    if QNEG then FQUOT := "0"-FQUOT;
+    end if;
+    return SIGNED(FQUOT);
+  end "/";
+
+  -- Id: A.23
+  function "/" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R));
+    variable XR, QUOT: UNSIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAU;
+    end if;
+    if (R_LENGTH > L'LENGTH) then
+      QUOT := (others => '0');
+      return RESIZE(QUOT, L'LENGTH);
+    end if;
+    XR := TO_UNSIGNED(R, R_LENGTH);
+    QUOT := RESIZE((L / XR), QUOT'LENGTH);
+    return RESIZE(QUOT, L'LENGTH);
+  end "/";
+
+  -- Id: A.24
+  function "/" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+    constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, QUOT: UNSIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAU;
+    end if;
+    XL := TO_UNSIGNED(L, L_LENGTH);
+    QUOT := RESIZE((XL / R), QUOT'LENGTH);
+    if L_LENGTH > R'LENGTH
+        and QUOT(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""/"": Quotient Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(QUOT, R'LENGTH);
+  end "/";
+
+  -- Id: A.25
+  function "/" (L: SIGNED; R: INTEGER) return SIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R));
+    variable XR, QUOT: SIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAS;
+    end if;
+    if (R_LENGTH > L'LENGTH) then
+      QUOT := (others => '0');
+      return RESIZE(QUOT, L'LENGTH);
+    end if;
+    XR := TO_SIGNED(R, R_LENGTH);
+    QUOT := RESIZE((L / XR), QUOT'LENGTH);
+    return RESIZE(QUOT, L'LENGTH);
+  end "/";
+
+  -- Id: A.26
+  function "/" (L: INTEGER; R: SIGNED) return SIGNED is
+    constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, QUOT: SIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAS;
+    end if;
+    XL := TO_SIGNED(L, L_LENGTH);
+    QUOT := RESIZE((XL / R), QUOT'LENGTH);
+    if L_LENGTH > R'LENGTH and QUOT(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => QUOT(R'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""/"": Quotient Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(QUOT, R'LENGTH);
+  end "/";
+
+  --============================================================================
+
+  -- Id: A.27
+  function "rem" (L, R: UNSIGNED) return UNSIGNED is
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    DIVMOD(L, R, FQUOT, FREMAIN);
+    return FREMAIN;
+  end "rem";
+
+  -- Id: A.28
+  function "rem" (L, R: SIGNED) return SIGNED is
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+    variable XNUM: UNSIGNED(L'LENGTH-1 downto 0);
+    variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0);
+    variable RNEG: BOOLEAN := FALSE;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    if L(L'LEFT)='1' then
+      XNUM := UNSIGNED(-L);
+      RNEG := TRUE;
+    else
+      XNUM := UNSIGNED(L);
+    end if;
+    if R(R'LEFT)='1' then
+      XDENOM := UNSIGNED(-R);
+    else
+      XDENOM := UNSIGNED(R);
+    end if;
+    DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN);
+    if RNEG then
+      FREMAIN := "0"-FREMAIN;
+    end if;
+    return SIGNED(FREMAIN);
+  end "rem";
+
+  -- Id: A.29
+  function "rem" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R));
+    variable XR, XREM: UNSIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAU;
+    end if;
+    XR := TO_UNSIGNED(R, R_LENGTH);
+    XREM := RESIZE((L rem XR), XREM'LENGTH);
+    if R_LENGTH > L'LENGTH and XREM(R_LENGTH-1 downto L'LENGTH)
+        /= (R_LENGTH-1 downto L'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""rem"": Remainder Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, L'LENGTH);
+  end "rem";
+
+  -- Id: A.30
+  function "rem" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+    constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, XREM: UNSIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAU;
+    end if;
+    XL := TO_UNSIGNED(L, L_LENGTH);
+    XREM := RESIZE((XL rem R), XREM'LENGTH);
+    if L_LENGTH > R'LENGTH and XREM(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""rem"": Remainder Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, R'LENGTH);
+  end "rem";
+
+  -- Id: A.31
+  function "rem" (L: SIGNED; R: INTEGER) return SIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R));
+    variable XR, XREM: SIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAS;
+    end if;
+    XR := TO_SIGNED(R, R_LENGTH);
+    XREM := RESIZE((L rem XR), XREM'LENGTH);
+    if R_LENGTH > L'LENGTH and XREM(R_LENGTH-1 downto L'LENGTH)
+        /= (R_LENGTH-1 downto L'LENGTH => XREM(L'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""rem"": Remainder Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, L'LENGTH);
+  end "rem";
+
+  -- Id: A.32
+  function "rem" (L: INTEGER; R: SIGNED) return SIGNED is
+    constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, XREM: SIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAS;
+    end if;
+    XL := TO_SIGNED(L, L_LENGTH);
+    XREM := RESIZE((XL rem R), XREM'LENGTH);
+    if L_LENGTH > R'LENGTH and XREM(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => XREM(R'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""rem"": Remainder Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, R'LENGTH);
+  end "rem";
+
+  --============================================================================
+
+  -- Id: A.33
+  function "mod" (L, R: UNSIGNED) return UNSIGNED is
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    DIVMOD(L, R, FQUOT, FREMAIN);
+    return FREMAIN;
+  end "mod";
+
+  -- Id: A.34
+  function "mod" (L, R: SIGNED) return SIGNED is
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+    variable XNUM: UNSIGNED(L'LENGTH-1 downto 0);
+    variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0);
+    variable RNEG: BOOLEAN := FALSE;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    if L(L'LEFT)='1' then
+      XNUM := UNSIGNED(-L);
+    else
+      XNUM := UNSIGNED(L);
+    end if;
+    if R(R'LEFT)='1' then
+      XDENOM := UNSIGNED(-R);
+      RNEG := TRUE;
+    else
+      XDENOM := UNSIGNED(R);
+    end if;
+    DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN);
+    if RNEG and L(L'LEFT)='1' then
+      FREMAIN := "0"-FREMAIN;
+      elsif RNEG and FREMAIN/="0" then
+          FREMAIN := FREMAIN-XDENOM;
+      elsif L(L'LEFT)='1' and FREMAIN/="0" then
+          FREMAIN := XDENOM-FREMAIN;
+    end if;
+    return SIGNED(FREMAIN);
+  end "mod";
+
+  -- Id: A.35
+  function "mod" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R));
+    variable XR, XREM: UNSIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAU;
+    end if;
+    XR := TO_UNSIGNED(R, R_LENGTH);
+    XREM := RESIZE((L mod XR), XREM'LENGTH);
+    if R_LENGTH > L'LENGTH and XREM(R_LENGTH-1 downto L'LENGTH)
+        /= (R_LENGTH-1 downto L'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""mod"": modulus Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, L'LENGTH);
+  end "mod";
+
+  -- Id: A.36
+  function "mod" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+    constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, XREM: UNSIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAU;
+    end if;
+    XL := TO_UNSIGNED(L, L_LENGTH);
+    XREM := RESIZE((XL mod R), XREM'LENGTH);
+    if L_LENGTH > R'LENGTH and XREM(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""mod"": modulus Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, R'LENGTH);
+  end "mod";
+
+  -- Id: A.37
+  function "mod" (L: SIGNED; R: INTEGER) return SIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R));
+    variable XR, XREM: SIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAS;
+    end if;
+    XR := TO_SIGNED(R, R_LENGTH);
+    XREM := RESIZE((L mod XR), XREM'LENGTH);
+    if R_LENGTH > L'LENGTH and XREM(R_LENGTH-1 downto L'LENGTH)
+        /= (R_LENGTH-1 downto L'LENGTH => XREM(L'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""mod"": modulus Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, L'LENGTH);
+  end "mod";
+
+  -- Id: A.38
+  function "mod" (L: INTEGER; R: SIGNED) return SIGNED is
+    constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, XREM: SIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAS;
+    end if;
+    XL := TO_SIGNED(L, L_LENGTH);
+    XREM := RESIZE((XL mod R), XREM'LENGTH);
+    if L_LENGTH > R'LENGTH and XREM(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => XREM(R'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_BIT.""mod"": modulus Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, R'LENGTH);
+  end "mod";
+
+  --============================================================================
+
+  -- Id: C.1
+  function ">" (L, R: UNSIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return not UNSIGNED_LESS_OR_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end ">";
+
+  -- Id: C.2
+  function ">" (L, R: SIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return not SIGNED_LESS_OR_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end ">";
+
+  -- Id: C.3
+  function ">" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return TRUE;
+    end if;
+    return not UNSIGNED_LESS_OR_EQUAL(TO_UNSIGNED(L, R'LENGTH), R);
+  end ">";
+
+  -- Id: C.4
+  function ">" (L: INTEGER; R: SIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return L > 0;
+    end if;
+    return not SIGNED_LESS_OR_EQUAL(TO_SIGNED(L, R'LENGTH), R);
+  end ">";
+
+  -- Id: C.5
+  function ">" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return FALSE;
+    end if;
+    return not UNSIGNED_LESS_OR_EQUAL(L, TO_UNSIGNED(R, L'LENGTH));
+  end ">";
+
+  -- Id: C.6
+  function ">" (L: SIGNED; R: INTEGER) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R;
+    end if;
+    return not SIGNED_LESS_OR_EQUAL(L, TO_SIGNED(R, L'LENGTH));
+  end ">";
+
+  --============================================================================
+
+  -- Id: C.7
+  function "<" (L, R: UNSIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return UNSIGNED_LESS(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end "<";
+
+  -- Id: C.8
+  function "<" (L, R: SIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return SIGNED_LESS(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end "<";
+
+  -- Id: C.9
+  function "<" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L < 0;
+    end if;
+    return UNSIGNED_LESS(TO_UNSIGNED(L, R'LENGTH), R);
+  end "<";
+
+  -- Id: C.10
+  function "<" (L: INTEGER; R: SIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return L < 0;
+    end if;
+    return SIGNED_LESS(TO_SIGNED(L, R'LENGTH), R);
+  end "<";
+
+  -- Id: C.11
+  function "<" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R;
+    end if;
+    return UNSIGNED_LESS(L, TO_UNSIGNED(R, L'LENGTH));
+  end "<";
+
+  -- Id: C.12
+  function "<" (L: SIGNED; R: INTEGER) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R;
+    end if;
+    return SIGNED_LESS(L, TO_SIGNED(R, L'LENGTH));
+  end "<";
+
+  --============================================================================
+
+  -- Id: C.13
+  function "<=" (L, R: UNSIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return UNSIGNED_LESS_OR_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end "<=";
+
+  -- Id: C.14
+  function "<=" (L, R: SIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return SIGNED_LESS_OR_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end "<=";
+
+  -- Id: C.15
+  function "<=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L < 0;
+    end if;
+    return UNSIGNED_LESS_OR_EQUAL(TO_UNSIGNED(L, R'LENGTH), R);
+  end "<=";
+
+  -- Id: C.16
+  function "<=" (L: INTEGER; R: SIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return L < 0;
+    end if;
+    return SIGNED_LESS_OR_EQUAL(TO_SIGNED(L, R'LENGTH), R);
+  end "<=";
+
+  -- Id: C.17
+  function "<=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R;
+    end if;
+    return UNSIGNED_LESS_OR_EQUAL(L, TO_UNSIGNED(R, L'LENGTH));
+  end "<=";
+
+  -- Id: C.18
+  function "<=" (L: SIGNED; R: INTEGER) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R;
+    end if;
+    return SIGNED_LESS_OR_EQUAL(L, TO_SIGNED(R, L'LENGTH));
+  end "<=";
+
+  --============================================================================
+
+  -- Id: C.19
+  function ">=" (L, R: UNSIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return not UNSIGNED_LESS(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end ">=";
+
+  -- Id: C.20
+  function ">=" (L, R: SIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return not SIGNED_LESS(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end ">=";
+
+  -- Id: C.21
+  function ">=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L > 0;
+    end if;
+    return not UNSIGNED_LESS(TO_UNSIGNED(L, R'LENGTH), R);
+  end ">=";
+
+  -- Id: C.22
+  function ">=" (L: INTEGER; R: SIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return L > 0;
+    end if;
+    return not SIGNED_LESS(TO_SIGNED(L, R'LENGTH), R);
+  end ">=";
+
+  -- Id: C.23
+  function ">=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R;
+    end if;
+    return not UNSIGNED_LESS(L, TO_UNSIGNED(R, L'LENGTH));
+  end ">=";
+
+  -- Id: C.24
+  function ">=" (L: SIGNED; R: INTEGER) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R;
+    end if;
+    return not SIGNED_LESS(L, TO_SIGNED(R, L'LENGTH));
+  end ">=";
+
+  --============================================================================
+
+  -- Id: C.25
+  function "=" (L, R: UNSIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return UNSIGNED_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end "=";
+
+  -- Id: C.26
+  function "=" (L, R: SIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return SIGNED_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE));
+  end "=";
+
+  -- Id: C.27
+  function "=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return FALSE;
+    end if;
+    return UNSIGNED_EQUAL(TO_UNSIGNED(L, R'LENGTH), R);
+  end "=";
+
+  -- Id: C.28
+  function "=" (L: INTEGER; R: SIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return FALSE;
+    end if;
+    return SIGNED_EQUAL(TO_SIGNED(L, R'LENGTH), R);
+  end "=";
+
+  -- Id: C.29
+  function "=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return FALSE;
+    end if;
+    return UNSIGNED_EQUAL(L, TO_UNSIGNED(R, L'LENGTH));
+  end "=";
+
+  -- Id: C.30
+  function "=" (L: SIGNED; R: INTEGER) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return FALSE;
+    end if;
+    return SIGNED_EQUAL(L, TO_SIGNED(R, L'LENGTH));
+  end "=";
+
+  --============================================================================
+
+  -- Id: C.31
+  function "/=" (L, R: UNSIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    return not(UNSIGNED_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE)));
+  end "/=";
+
+  -- Id: C.32
+  function "/=" (L, R: SIGNED) return BOOLEAN is
+    variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    return not(SIGNED_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE)));
+  end "/=";
+
+  -- Id: C.33
+  function "/=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return TRUE;
+    end if;
+    return not(UNSIGNED_EQUAL(TO_UNSIGNED(L, R'LENGTH), R));
+  end "/=";
+
+  -- Id: C.34
+  function "/=" (L: INTEGER; R: SIGNED) return BOOLEAN is
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return TRUE;
+    end if;
+    return not(SIGNED_EQUAL(TO_SIGNED(L, R'LENGTH), R));
+  end "/=";
+
+  -- Id: C.35
+  function "/=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return TRUE;
+    end if;
+    return not(UNSIGNED_EQUAL(L, TO_UNSIGNED(R, L'LENGTH)));
+  end "/=";
+
+  -- Id: C.36
+  function "/=" (L: SIGNED; R: INTEGER) return BOOLEAN is
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return TRUE;
+    end if;
+    return not(SIGNED_EQUAL(L, TO_SIGNED(R, L'LENGTH)));
+  end "/=";
+
+  --============================================================================
+
+  -- Id: S.1
+  function SHIFT_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAU;
+    end if;
+    return UNSIGNED(XSLL(BIT_VECTOR(ARG), COUNT));
+  end SHIFT_LEFT;
+
+  -- Id: S.2
+  function SHIFT_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAU;
+    end if;
+    return UNSIGNED(XSRL(BIT_VECTOR(ARG), COUNT));
+  end SHIFT_RIGHT;
+
+  -- Id: S.3
+  function SHIFT_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAS;
+    end if;
+    return SIGNED(XSLL(BIT_VECTOR(ARG), COUNT));
+  end SHIFT_LEFT;
+
+  -- Id: S.4
+  function SHIFT_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAS;
+    end if;
+    return SIGNED(XSRA(BIT_VECTOR(ARG), COUNT));
+  end SHIFT_RIGHT;
+
+  --============================================================================
+
+  -- Id: S.5
+  function ROTATE_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAU;
+    end if;
+    return UNSIGNED(XROL(BIT_VECTOR(ARG), COUNT));
+  end ROTATE_LEFT;
+
+  -- Id: S.6
+  function ROTATE_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAU;
+    end if;
+    return UNSIGNED(XROR(BIT_VECTOR(ARG), COUNT));
+  end ROTATE_RIGHT;
+
+  -- Id: S.7
+  function ROTATE_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAS;
+    end if;
+    return SIGNED(XROL(BIT_VECTOR(ARG), COUNT));
+  end ROTATE_LEFT;
+
+  -- Id: S.8
+  function ROTATE_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAS;
+    end if;
+    return SIGNED(XROR(BIT_VECTOR(ARG), COUNT));
+  end ROTATE_RIGHT;
+
+  --============================================================================
+
+--START-V93
+  ------------------------------------------------------------------------------
+  -- Note : Function S.9 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.9
+  function "sll" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is
+  begin
+    if (COUNT >= 0) then
+      return SHIFT_LEFT(ARG, COUNT);
+    else
+      return SHIFT_RIGHT(ARG, -COUNT);
+    end if;
+  end "sll";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.10 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.10
+  function "sll" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is
+  begin
+    if (COUNT >= 0) then
+      return SHIFT_LEFT(ARG, COUNT);
+    else
+      return SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), -COUNT));
+    end if;
+  end "sll";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.11 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.11
+  function "srl" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is
+  begin
+    if (COUNT >= 0) then
+      return SHIFT_RIGHT(ARG, COUNT);
+    else
+      return SHIFT_LEFT(ARG, -COUNT);
+    end if;
+  end "srl";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.12 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.12
+  function "srl" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is
+  begin
+    if (COUNT >= 0) then
+      return SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), COUNT));
+    else
+      return SHIFT_LEFT(ARG, -COUNT);
+    end if;
+  end "srl";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.13 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.13
+  function "rol" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is
+  begin
+    if (COUNT >= 0) then
+      return ROTATE_LEFT(ARG, COUNT);
+    else
+      return ROTATE_RIGHT(ARG, -COUNT);
+    end if;
+  end "rol";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.14 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.14
+  function "rol" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is
+  begin
+    if (COUNT >= 0) then
+      return ROTATE_LEFT(ARG, COUNT);
+    else
+      return ROTATE_RIGHT(ARG, -COUNT);
+    end if;
+  end "rol";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.15 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.15
+  function "ror" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is
+  begin
+    if (COUNT >= 0) then
+      return ROTATE_RIGHT(ARG, COUNT);
+    else
+      return ROTATE_LEFT(ARG, -COUNT);
+    end if;
+  end "ror";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.16 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.16
+  function "ror" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is
+  begin
+    if (COUNT >= 0) then
+      return ROTATE_RIGHT(ARG, COUNT);
+    else
+      return ROTATE_LEFT(ARG, -COUNT);
+    end if;
+  end "ror";
+
+--END-V93
+  --============================================================================
+
+  -- Id: D.1
+  function TO_INTEGER (ARG: UNSIGNED) return NATURAL is
+    constant ARG_LEFT: INTEGER := ARG'LENGTH-1;
+    alias XARG: UNSIGNED(ARG_LEFT downto 0) is ARG;
+    variable RESULT: NATURAL := 0;
+  begin
+    if (ARG'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.TO_INTEGER: null detected, returning 0"
+          severity WARNING;
+      return 0;
+    end if;
+    for I in XARG'RANGE loop
+      RESULT := RESULT+RESULT;
+      if XARG(I) = '1' then
+        RESULT := RESULT + 1;
+      end if;
+    end loop;
+    return RESULT;
+  end TO_INTEGER;
+
+  -- Id: D.2
+  function TO_INTEGER (ARG: SIGNED) return INTEGER is
+  begin
+    if (ARG'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.TO_INTEGER: null detected, returning 0"
+          severity WARNING;
+      return 0;
+    end if;
+    if ARG(ARG'LEFT) = '0' then
+      return TO_INTEGER(UNSIGNED(ARG));
+    else
+      return (- (TO_INTEGER(UNSIGNED(- (ARG + 1)))) -1);
+    end if;
+  end TO_INTEGER;
+
+  -- Id: D.3
+  function TO_UNSIGNED (ARG, SIZE: NATURAL) return UNSIGNED is
+    variable RESULT: UNSIGNED(SIZE-1 downto 0);
+    variable I_VAL: NATURAL := ARG;
+  begin
+    if (SIZE < 1) then return NAU;
+    end if;
+    for I in 0 to RESULT'LEFT loop
+      if (I_VAL mod 2) = 0 then
+        RESULT(I) := '0';
+      else RESULT(I) := '1';
+      end if;
+      I_VAL := I_VAL/2;
+    end loop;
+    if not(I_VAL =0) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.TO_UNSIGNED: vector truncated"
+          severity WARNING;
+    end if;
+    return RESULT;
+  end TO_UNSIGNED;
+
+  -- Id: D.4
+  function TO_SIGNED (ARG: INTEGER;
+    SIZE: NATURAL) return SIGNED is
+        variable RESULT: SIGNED(SIZE-1 downto 0);
+    variable B_VAL: BIT := '0';
+    variable I_VAL: INTEGER := ARG;
+  begin
+    if (SIZE < 1) then return NAS;
+    end if;
+    if (ARG < 0) then
+      B_VAL := '1';
+      I_VAL := -(ARG+1);
+    end if;
+    for I in 0 to RESULT'LEFT loop
+      if (I_VAL mod 2) = 0 then
+        RESULT(I) := B_VAL;
+      else
+        RESULT(I) := not B_VAL;
+      end if;
+      I_VAL := I_VAL/2;
+    end loop;
+    if ((I_VAL/=0) or (B_VAL/=RESULT(RESULT'LEFT))) then
+      assert NO_WARNING
+          report "NUMERIC_BIT.TO_SIGNED: vector truncated"
+          severity WARNING;
+    end if;
+    return RESULT;
+  end TO_SIGNED;
+
+  --============================================================================
+
+  -- Id: R.1
+  function RESIZE (ARG: SIGNED; NEW_SIZE: NATURAL) return SIGNED is
+    alias INVEC: SIGNED(ARG'LENGTH-1 downto 0) is ARG;
+    variable RESULT: SIGNED(NEW_SIZE-1 downto 0) := (others => '0');
+    constant BOUND: INTEGER := MIN(ARG'LENGTH, RESULT'LENGTH)-2;
+  begin
+    if (NEW_SIZE < 1) then return NAS;
+    end if;
+    if (ARG'LENGTH = 0) then return RESULT;
+    end if;
+    RESULT := (others => ARG(ARG'LEFT));
+    if BOUND >= 0 then
+      RESULT(BOUND downto 0) := INVEC(BOUND downto 0);
+    end if;
+    return RESULT;
+  end RESIZE;
+
+  -- Id: R.2
+  function RESIZE (ARG: UNSIGNED; NEW_SIZE: NATURAL) return UNSIGNED is
+    constant ARG_LEFT: INTEGER := ARG'LENGTH-1;
+    alias XARG: UNSIGNED(ARG_LEFT downto 0) is ARG;
+    variable RESULT: UNSIGNED(NEW_SIZE-1 downto 0) := (others => '0');
+  begin
+    if (NEW_SIZE < 1) then return NAU;
+    end if;
+    if XARG'LENGTH =0 then return RESULT;
+    end if;
+    if (RESULT'LENGTH < ARG'LENGTH) then
+      RESULT(RESULT'LEFT downto 0) := XARG(RESULT'LEFT downto 0);
+    else
+      RESULT(RESULT'LEFT downto XARG'LEFT+1) := (others => '0');
+      RESULT(XARG'LEFT downto 0) := XARG;
+    end if;
+    return RESULT;
+  end RESIZE;
+
+  --============================================================================
+
+  -- Id: L.1
+  function "not" (L: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(not(BIT_VECTOR(L)));
+    return RESULT;
+  end "not";
+
+  -- Id: L.2
+  function "and" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(BIT_VECTOR(L) and BIT_VECTOR(R));
+    return RESULT;
+  end "and";
+
+  -- Id: L.3
+  function "or" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(BIT_VECTOR(L) or BIT_VECTOR(R));
+    return RESULT;
+  end "or";
+
+  -- Id: L.4
+  function "nand" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(BIT_VECTOR(L) nand BIT_VECTOR(R));
+    return RESULT;
+  end "nand";
+
+  -- Id: L.5
+  function "nor" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(BIT_VECTOR(L) nor BIT_VECTOR(R));
+    return RESULT;
+  end "nor";
+
+  -- Id: L.6
+  function "xor" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(BIT_VECTOR(L) xor BIT_VECTOR(R));
+    return RESULT;
+  end "xor";
+
+--START-V93
+  ------------------------------------------------------------------------------
+  -- Note : Function L.7 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: L.7
+  function "xnor" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(BIT_VECTOR(L) xnor BIT_VECTOR(R));
+    return RESULT;
+  end "xnor";
+--END-V93
+
+  -- Id: L.8
+  function "not" (L: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(not(BIT_VECTOR(L)));
+    return RESULT;
+  end "not";
+
+  -- Id: L.9
+  function "and" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(BIT_VECTOR(L) and BIT_VECTOR(R));
+    return RESULT;
+  end "and";
+
+  -- Id: L.10
+  function "or" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(BIT_VECTOR(L) or BIT_VECTOR(R));
+    return RESULT;
+  end "or";
+
+  -- Id: L.11
+  function "nand" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(BIT_VECTOR(L) nand BIT_VECTOR(R));
+    return RESULT;
+  end "nand";
+
+  -- Id: L.12
+  function "nor" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(BIT_VECTOR(L) nor BIT_VECTOR(R));
+    return RESULT;
+  end "nor";
+
+  -- Id: L.13
+  function "xor" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(BIT_VECTOR(L) xor BIT_VECTOR(R));
+    return RESULT;
+  end "xor";
+
+--START-V93
+  ------------------------------------------------------------------------------
+  -- Note : Function L.14 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: L.14
+  function "xnor" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(BIT_VECTOR(L) xnor BIT_VECTOR(R));
+    return RESULT;
+  end "xnor";
+--END-V93
+
+  --============================================================================
+
+  -- Id: E.1
+  function RISING_EDGE (signal S: BIT) return BOOLEAN is
+  begin
+    return S'EVENT and S = '1';
+  end RISING_EDGE;
+
+  -- Id: E.2
+  function FALLING_EDGE (signal S: BIT) return BOOLEAN is
+  begin
+    return S'EVENT and S = '0';
+  end FALLING_EDGE;
+
+  --============================================================================
+end NUMERIC_BIT;
diff --git a/libraries/ieee/numeric_bit.vhdl b/libraries/ieee/numeric_bit.vhdl
new file mode 100644
index 000000000..8f049f21a
--- /dev/null
+++ b/libraries/ieee/numeric_bit.vhdl
@@ -0,0 +1,813 @@
+-- -----------------------------------------------------------------------------
+--
+-- Copyright 1995 by IEEE. All rights reserved.
+--
+-- This source file is considered by the IEEE to be an essential part of the use
+-- of the standard 1076.3 and as such may be distributed without change, except
+-- as permitted by the standard. This source file may not be sold or distributed
+-- for profit. This package may be modified to include additional data required
+-- by tools, but must in no way change the external interfaces or simulation
+-- behaviour of the description. It is permissible to add comments and/or
+-- attributes to the package declarations, but not to change or delete any
+-- original lines of the approved package declaration. The package body may be
+-- changed only in accordance with the terms of clauses 7.1 and 7.2 of the
+-- standard.
+--
+-- Title      : Standard VHDL Synthesis Package (1076.3, NUMERIC_BIT)
+--
+-- Library    : This package shall be compiled into a library symbolically
+--            : named IEEE.
+--
+-- Developers : IEEE DASC Synthesis Working Group, PAR 1076.3
+--
+-- Purpose    : This package defines numeric types and arithmetic functions
+--            : for use with synthesis tools. Two numeric types are defined:
+--            : -- > UNSIGNED: represents an UNSIGNED number in vector form
+--            : -- > SIGNED: represents a SIGNED number in vector form
+--            : The base element type is type BIT.
+--            : The leftmost bit is treated as the most significant bit.
+--            : Signed vectors are represented in two's complement form.
+--            : This package contains overloaded arithmetic operators on
+--            : the SIGNED and UNSIGNED types. The package also contains
+--            : useful type conversions functions, clock detection
+--            : functions, and other utility functions.
+--            :
+--            : If any argument to a function is a null array, a null array is
+--            : returned (exceptions, if any, are noted individually).
+--
+-- Limitation :
+--
+-- Note       : No declarations or definitions shall be included in,
+--            : or excluded from this package. The "package declaration"
+--            : defines the types, subtypes and declarations of
+--            : NUMERIC_BIT. The NUMERIC_BIT package body shall be
+--            : considered the formal definition of the semantics of
+--            : this package. Tool developers may choose to implement
+--            : the package body in the most efficient manner available
+--            : to them.
+--            :
+-- -----------------------------------------------------------------------------
+-- Version    : 2.4
+-- Date       : 12 April 1995
+-- -----------------------------------------------------------------------------
+
+package NUMERIC_BIT is
+  constant CopyRightNotice: STRING
+      := "Copyright 1995 IEEE. All rights reserved.";
+
+  --============================================================================
+  -- Numeric array type definitions
+  --============================================================================
+
+  type UNSIGNED is array (NATURAL range <> ) of BIT;
+  type SIGNED is array (NATURAL range <> ) of BIT;
+
+  --============================================================================
+  -- Arithmetic Operators:
+  --============================================================================
+
+  -- Id: A.1
+  function "abs" (ARG: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0).
+  -- Result: Returns the absolute value of a SIGNED vector ARG.
+
+  -- Id: A.2
+  function "-" (ARG: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0).
+  -- Result: Returns the value of the unary minus operation on a
+  --         SIGNED vector ARG.
+
+  --============================================================================
+
+  -- Id: A.3
+  function "+" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0).
+  -- Result: Adds two UNSIGNED vectors that may be of different lengths.
+
+  -- Id: A.4
+  function "+" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0).
+  -- Result: Adds two SIGNED vectors that may be of different lengths.
+
+  -- Id: A.5
+  function "+" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0).
+  -- Result: Adds an UNSIGNED vector, L, with a non-negative INTEGER, R.
+
+  -- Id: A.6
+  function "+" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0).
+  -- Result: Adds a non-negative INTEGER, L, with an UNSIGNED vector, R.
+
+  -- Id: A.7
+  function "+" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0).
+  -- Result: Adds an INTEGER, L(may be positive or negative), to a SIGNED
+  -- vector, R.
+
+  -- Id: A.8
+  function "+" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0).
+  -- Result: Adds a SIGNED vector, L, to an INTEGER, R.
+
+  --============================================================================
+
+  -- Id: A.9
+  function "-" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0).
+  -- Result: Subtracts two UNSIGNED vectors that may be of different lengths.
+
+  -- Id: A.10
+  function "-" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0).
+  -- Result: Subtracts a SIGNED vector, R, from another SIGNED vector, L,
+  --         that may possibly be of different lengths.
+
+  -- Id: A.11
+  function "-" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0).
+  -- Result: Subtracts a non-negative INTEGER, R, from an UNSIGNED vector, L.
+
+  -- Id: A.12
+  function "-" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0).
+  -- Result: Subtracts an UNSIGNED vector, R, from a non-negative INTEGER, L.
+
+  -- Id: A.13
+  function "-" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0).
+  -- Result: Subtracts an INTEGER, R, from a SIGNED vector, L.
+
+  -- Id: A.14
+  function "-" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0).
+  -- Result: Subtracts a SIGNED vector, R, from an INTEGER, L.
+
+  --============================================================================
+
+  -- Id: A.15
+  function "*" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0).
+  -- Result: Performs the multiplication operation on two UNSIGNED vectors
+  --         that may possibly be of different lengths.
+
+  -- Id: A.16
+  function "*" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED((L'LENGTH+R'LENGTH-1) downto 0)
+  -- Result: Multiplies two SIGNED vectors that may possibly be of
+  --         different lengths.
+
+  -- Id: A.17
+  function "*" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED((L'LENGTH+L'LENGTH-1) downto 0).
+  -- Result: Multiplies an UNSIGNED vector, L, with a non-negative
+  --         INTEGER, R. R is converted to an UNSIGNED vector of
+  --         size L'LENGTH before multiplication.
+
+  -- Id: A.18
+  function "*" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED((R'LENGTH+R'LENGTH-1) downto 0).
+  -- Result: Multiplies an UNSIGNED vector, R, with a non-negative
+  --         INTEGER, L. L is converted to an UNSIGNED vector of
+  --         size R'LENGTH before multiplication.
+
+  -- Id: A.19
+  function "*" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED((L'LENGTH+L'LENGTH-1) downto 0)
+  -- Result: Multiplies a SIGNED vector, L, with an INTEGER, R. R is
+  --         converted to a SIGNED vector of size L'LENGTH before
+  --         multiplication.
+
+  -- Id: A.20
+  function "*" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED((R'LENGTH+R'LENGTH-1) downto 0)
+  -- Result: Multiplies a SIGNED vector, R, with an INTEGER, L. L is
+  --         converted to a SIGNED vector of size R'LENGTH before
+  --         multiplication.
+
+  --============================================================================
+  --
+  -- NOTE: If second argument is zero for "/" operator, a severity level
+  --       of ERROR is issued.
+
+  -- Id: A.21
+  function "/" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Divides an UNSIGNED vector, L, by another UNSIGNED vector, R.
+
+  -- Id: A.22
+  function "/" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Divides an SIGNED vector, L, by another SIGNED vector, R.
+
+  -- Id: A.23
+  function "/" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Divides an UNSIGNED vector, L, by a non-negative INTEGER, R.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.24
+  function "/" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Divides a non-negative INTEGER, L, by an UNSIGNED vector, R.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  -- Id: A.25
+  function "/" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Divides a SIGNED vector, L, by an INTEGER, R.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.26
+  function "/" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Divides an INTEGER, L, by a SIGNED vector, R.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  --============================================================================
+  --
+  -- NOTE: If second argument is zero for "rem" operator, a severity level
+  --       of ERROR is issued.
+
+  -- Id: A.27
+  function "rem" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where L and R are UNSIGNED vectors.
+
+  -- Id: A.28
+  function "rem" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where L and R are SIGNED vectors.
+
+  -- Id: A.29
+  function "rem" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where L is an UNSIGNED vector and R is a
+  --         non-negative INTEGER.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.30
+  function "rem" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where R is an UNSIGNED vector and L is a
+  --         non-negative INTEGER.
+  -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  -- Id: A.31
+  function "rem" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where L is SIGNED vector and R is an INTEGER.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.32
+  function "rem" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where R is SIGNED vector and L is an INTEGER.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  --============================================================================
+  --
+  -- NOTE: If second argument is zero for "mod" operator, a severity level
+  --       of ERROR is issued.
+
+  -- Id: A.33
+  function "mod" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L and R are UNSIGNED vectors.
+
+  -- Id: A.34
+  function "mod" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L and R are SIGNED vectors.
+
+  -- Id: A.35
+  function "mod" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L is an UNSIGNED vector and R
+  --         is a non-negative INTEGER.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.36
+  function "mod" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where R is an UNSIGNED vector and L
+  --         is a non-negative INTEGER.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  -- Id: A.37
+  function "mod" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.38
+  function "mod" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  --============================================================================
+  -- Comparison Operators
+  --============================================================================
+
+  -- Id: C.1
+  function ">" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.2
+  function ">" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.3
+  function ">" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.4
+  function ">" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L is a INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.5
+  function ">" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.6
+  function ">" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L is a SIGNED vector and
+  --         R is a INTEGER.
+
+  --============================================================================
+
+  -- Id: C.7
+  function "<" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.8
+  function "<" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.9
+  function "<" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.10
+  function "<" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.11
+  function "<" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.12
+  function "<" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+
+  -- Id: C.13
+  function "<=" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.14
+  function "<=" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.15
+  function "<=" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.16
+  function "<=" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.17
+  function "<=" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.18
+  function "<=" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+
+  -- Id: C.19
+  function ">=" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.20
+  function ">=" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.21
+  function ">=" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.22
+  function ">=" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.23
+  function ">=" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.24
+  function ">=" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+
+  -- Id: C.25
+  function "=" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.26
+  function "=" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.27
+  function "=" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.28
+  function "=" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.29
+  function "=" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.30
+  function "=" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+
+  -- Id: C.31
+  function "/=" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.32
+  function "/=" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.33
+  function "/=" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.34
+  function "/=" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.35
+  function "/=" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.36
+  function "/=" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+  -- Shift and Rotate Functions
+  --============================================================================
+
+  -- Id: S.1
+  function SHIFT_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a shift-left on an UNSIGNED vector COUNT times.
+  --         The vacated positions are filled with Bit '0'.
+  --         The COUNT leftmost bits are lost.
+
+  -- Id: S.2
+  function SHIFT_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a shift-right on an UNSIGNED vector COUNT times.
+  --         The vacated positions are filled with Bit '0'.
+  --         The COUNT rightmost bits are lost.
+
+  -- Id: S.3
+  function SHIFT_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a shift-left on a SIGNED vector COUNT times.
+  --         The vacated positions are filled with Bit '0'.
+  --         The COUNT leftmost bits, except ARG'LEFT, are lost.
+
+  -- Id: S.4
+  function SHIFT_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a shift-right on a SIGNED vector COUNT times.
+  --         The vacated positions are filled with the leftmost bit, ARG'LEFT.
+  --         The COUNT rightmost bits are lost.
+
+  --============================================================================
+
+  -- Id: S.5
+  function ROTATE_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a rotate-left of an UNSIGNED vector COUNT times.
+
+  -- Id: S.6
+  function ROTATE_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a rotate-right of an UNSIGNED vector COUNT times.
+
+  -- Id: S.7
+  function ROTATE_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a logical rotate-left of a SIGNED vector COUNT times.
+
+  -- Id: S.8
+  function ROTATE_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a logical rotate-right of a SIGNED vector COUNT times.
+
+  --============================================================================
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.9 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.9
+  function "sll" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: SHIFT_LEFT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.10 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.10
+  function "sll" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: SHIFT_LEFT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.11 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.11
+  function "srl" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: SHIFT_RIGHT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.12 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.12
+  function "srl" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), COUNT))
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.13 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.13
+  function "rol" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: ROTATE_LEFT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.14 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.14
+  function "rol" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: ROTATE_LEFT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.15 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.15
+  function "ror" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: ROTATE_RIGHT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.16 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.16
+  function "ror" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: ROTATE_RIGHT(ARG, COUNT)
+
+  --============================================================================
+  -- RESIZE Functions
+  --============================================================================
+
+  -- Id: R.1
+  function RESIZE (ARG: SIGNED; NEW_SIZE: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(NEW_SIZE-1 downto 0)
+  -- Result: Resizes the SIGNED vector ARG to the specified size.
+  --         To create a larger vector, the new [leftmost] bit positions
+  --         are filled with the sign bit (ARG'LEFT). When truncating,
+  --         the sign bit is retained along with the rightmost part.
+
+  -- Id: R.2
+  function RESIZE (ARG: UNSIGNED; NEW_SIZE: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(NEW_SIZE-1 downto 0)
+  -- Result: Resizes the UNSIGNED vector ARG to the specified size.
+  --         To create a larger vector, the new [leftmost] bit positions
+  --         are filled with '0'. When truncating, the leftmost bits
+  --         are dropped.
+
+  --============================================================================
+  -- Conversion Functions
+  --============================================================================
+
+  -- Id: D.1
+  function TO_INTEGER (ARG: UNSIGNED) return NATURAL;
+  -- Result subtype: NATURAL. Value cannot be negative since parameter is an
+  --         UNSIGNED vector.
+  -- Result: Converts the UNSIGNED vector to an INTEGER.
+
+  -- Id: D.2
+  function TO_INTEGER (ARG: SIGNED) return INTEGER;
+  -- Result subtype: INTEGER
+  -- Result: Converts a SIGNED vector to an INTEGER.
+
+  -- Id: D.3
+  function TO_UNSIGNED (ARG, SIZE: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(SIZE-1 downto 0)
+  -- Result: Converts a non-negative INTEGER to an UNSIGNED vector with
+  --         the specified size.
+
+  -- Id: D.4
+  function TO_SIGNED (ARG: INTEGER; SIZE: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(SIZE-1 downto 0)
+  -- Result: Converts an INTEGER to a SIGNED vector of the specified size.
+
+  --============================================================================
+  -- Logical Operators
+  --============================================================================
+
+  -- Id: L.1
+  function "not" (L: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Termwise inversion
+
+  -- Id: L.2
+  function "and" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector AND operation
+
+  -- Id: L.3
+  function "or" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector OR operation
+
+  -- Id: L.4
+  function "nand" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector NAND operation
+
+  -- Id: L.5
+  function "nor" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector NOR operation
+
+  -- Id: L.6
+  function "xor" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector XOR operation
+
+  ------------------------------------------------------------------------------
+  -- Note : Function L.7 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: L.7
+  function "xnor" (L, R: UNSIGNED) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector XNOR operation
+
+  -- Id: L.8
+  function "not" (L: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Termwise inversion
+
+  -- Id: L.9
+  function "and" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector AND operation
+
+  -- Id: L.10
+  function "or" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector OR operation
+
+  -- Id: L.11
+  function "nand" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector NAND operation
+
+  -- Id: L.12
+  function "nor" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector NOR operation
+
+  -- Id: L.13
+  function "xor" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector XOR operation
+
+  ------------------------------------------------------------------------------
+  -- Note : Function L.14 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: L.14
+  function "xnor" (L, R: SIGNED) return SIGNED; --V93
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector XNOR operation
+
+  --============================================================================
+  -- Edge Detection Functions
+  --============================================================================
+
+  -- Id: E.1
+  function RISING_EDGE (signal S: BIT) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Returns TRUE if an event is detected on signal S and the
+  --         value changed from a '0' to a '1'.
+
+  -- Id: E.2
+  function FALLING_EDGE (signal S: BIT) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Returns TRUE if an event is detected on signal S and the
+  --         value changed from a '1' to a '0'.
+
+end NUMERIC_BIT;
diff --git a/libraries/ieee/numeric_std-body.vhdl b/libraries/ieee/numeric_std-body.vhdl
new file mode 100644
index 000000000..a5d609dc3
--- /dev/null
+++ b/libraries/ieee/numeric_std-body.vhdl
@@ -0,0 +1,2545 @@
+-- --------------------------------------------------------------------
+--
+-- Copyright 1995 by IEEE. All rights reserved.
+--
+-- This source file is considered by the IEEE to be an essential part of the use
+-- of the standard 1076.3 and as such may be distributed without change, except
+-- as permitted by the standard. This source file may not be sold or distributed
+-- for profit. This package may be modified to include additional data required
+-- by tools, but must in no way change the external interfaces or simulation
+-- behaviour of the description. It is permissible to add comments and/or
+-- attributes to the package declarations, but not to change or delete any
+-- original lines of the approved package declaration. The package body may be
+-- changed only in accordance with the terms of clauses 7.1 and 7.2 of the
+-- standard.
+--
+-- Title      : Standard VHDL Synthesis Package (1076.3, NUMERIC_STD)
+--
+-- Library    : This package shall be compiled into a library symbolically
+--            : named IEEE.
+--
+-- Developers : IEEE DASC Synthesis Working Group, PAR 1076.3
+--
+-- Purpose    : This package defines numeric types and arithmetic functions
+--            : for use with synthesis tools. Two numeric types are defined:
+--            : -- > UNSIGNED: represents UNSIGNED number in vector form
+--            : -- > SIGNED: represents a SIGNED number in vector form
+--            : The base element type is type STD_LOGIC.
+--            : The leftmost bit is treated as the most significant bit.
+--            : Signed vectors are represented in two's complement form.
+--            : This package contains overloaded arithmetic operators on
+--            : the SIGNED and UNSIGNED types. The package also contains
+--            : useful type conversions functions.
+--            :
+--            : If any argument to a function is a null array, a null array is
+--            : returned (exceptions, if any, are noted individually).
+--
+-- Limitation :
+--
+-- Note       : No declarations or definitions shall be included in,
+--            : or excluded from this package. The "package declaration"
+--            : defines the types, subtypes and declarations of
+--            : NUMERIC_STD. The NUMERIC_STD package body shall be
+--            : considered the formal definition of the semantics of
+--            : this package. Tool developers may choose to implement
+--            : the package body in the most efficient manner available
+--            : to them.
+--
+-- --------------------------------------------------------------------
+--   modification history :
+-- --------------------------------------------------------------------
+--   Version:  2.4
+--   Date   :  12 April 1995
+-- -----------------------------------------------------------------------------
+
+--==============================================================================
+--============================= Package Body ===================================
+--==============================================================================
+
+package body NUMERIC_STD is
+
+  -- null range array constants
+
+  constant NAU: UNSIGNED(0 downto 1) := (others => '0');
+  constant NAS: SIGNED(0 downto 1) := (others => '0');
+
+  -- implementation controls
+
+  constant NO_WARNING: BOOLEAN := FALSE; -- default to emit warnings
+
+  --=========================Local Subprograms =================================
+
+  function MAX (LEFT, RIGHT: INTEGER) return INTEGER is
+  begin
+    if LEFT > RIGHT then return LEFT;
+    else return RIGHT;
+    end if;
+  end MAX;
+
+  function MIN (LEFT, RIGHT: INTEGER) return INTEGER is
+  begin
+    if LEFT < RIGHT then return LEFT;
+    else return RIGHT;
+    end if;
+  end MIN;
+
+  function SIGNED_NUM_BITS (ARG: INTEGER) return NATURAL is
+    variable NBITS: NATURAL;
+    variable N: NATURAL;
+  begin
+    if ARG >= 0 then
+      N := ARG;
+    else
+      N := -(ARG+1);
+    end if;
+    NBITS := 1;
+    while N > 0 loop
+      NBITS := NBITS+1;
+      N := N / 2;
+    end loop;
+    return NBITS;
+  end SIGNED_NUM_BITS;
+
+  function UNSIGNED_NUM_BITS (ARG: NATURAL) return NATURAL is
+    variable NBITS: NATURAL;
+    variable N: NATURAL;
+  begin
+    N := ARG;
+    NBITS := 1;
+    while N > 1 loop
+      NBITS := NBITS+1;
+      N := N / 2;
+    end loop;
+    return NBITS;
+  end UNSIGNED_NUM_BITS;
+
+  ------------------------------------------------------------------------
+
+  -- this internal function computes the addition of two UNSIGNED
+  -- with input CARRY
+  -- * the two arguments are of the same length
+
+  function ADD_UNSIGNED (L, R: UNSIGNED; C: STD_LOGIC) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(L_LEFT downto 0) is R;
+    variable RESULT: UNSIGNED(L_LEFT downto 0);
+    variable CBIT: STD_LOGIC := C;
+  begin
+    for I in 0 to L_LEFT loop
+      RESULT(I) := CBIT xor XL(I) xor XR(I);
+      CBIT := (CBIT and XL(I)) or (CBIT and XR(I)) or (XL(I) and XR(I));
+    end loop;
+    return RESULT;
+  end ADD_UNSIGNED;
+
+  -- this internal function computes the addition of two SIGNED
+  -- with input CARRY
+  -- * the two arguments are of the same length
+
+  function ADD_SIGNED (L, R: SIGNED; C: STD_LOGIC) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    alias XR: SIGNED(L_LEFT downto 0) is R;
+    variable RESULT: SIGNED(L_LEFT downto 0);
+    variable CBIT: STD_LOGIC := C;
+  begin
+    for I in 0 to L_LEFT loop
+      RESULT(I) := CBIT xor XL(I) xor XR(I);
+      CBIT := (CBIT and XL(I)) or (CBIT and XR(I)) or (XL(I) and XR(I));
+    end loop;
+    return RESULT;
+  end ADD_SIGNED;
+
+  -----------------------------------------------------------------------------
+
+  -- this internal procedure computes UNSIGNED division
+  -- giving the quotient and remainder.
+  procedure DIVMOD (NUM, XDENOM: UNSIGNED; XQUOT, XREMAIN: out UNSIGNED) is
+    variable TEMP: UNSIGNED(NUM'LENGTH downto 0);
+    variable QUOT: UNSIGNED(MAX(NUM'LENGTH, XDENOM'LENGTH)-1 downto 0);
+    alias DENOM: UNSIGNED(XDENOM'LENGTH-1 downto 0) is XDENOM;
+    variable TOPBIT: INTEGER;
+  begin
+    TEMP := "0"&NUM;
+    QUOT := (others => '0');
+    TOPBIT := -1;
+    for J in DENOM'RANGE loop
+      if DENOM(J)='1' then
+        TOPBIT := J;
+        exit;
+      end if;
+    end loop;
+    assert TOPBIT >= 0 report "DIV, MOD, or REM by zero" severity ERROR;
+
+    for J in NUM'LENGTH-(TOPBIT+1) downto 0 loop
+      if TEMP(TOPBIT+J+1 downto J) >= "0"&DENOM(TOPBIT downto 0) then
+        TEMP(TOPBIT+J+1 downto J) := (TEMP(TOPBIT+J+1 downto J))
+            -("0"&DENOM(TOPBIT downto 0));
+        QUOT(J) := '1';
+      end if;
+      assert TEMP(TOPBIT+J+1)='0'
+          report "internal error in the division algorithm"
+          severity ERROR;
+    end loop;
+    XQUOT := RESIZE(QUOT, XQUOT'LENGTH);
+    XREMAIN := RESIZE(TEMP, XREMAIN'LENGTH);
+  end DIVMOD;
+
+  -----------------Local Subprograms - shift/rotate ops-------------------------
+
+  function XSLL (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR
+      is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0) := (others => '0');
+  begin
+    if COUNT <= ARG_L then
+      RESULT(ARG_L downto COUNT) := XARG(ARG_L-COUNT downto 0);
+    end if;
+    return RESULT;
+  end XSLL;
+
+  function XSRL (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR
+      is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0) := (others => '0');
+  begin
+    if COUNT <= ARG_L then
+      RESULT(ARG_L-COUNT downto 0) := XARG(ARG_L downto COUNT);
+    end if;
+    return RESULT;
+  end XSRL;
+
+  function XSRA (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR
+      is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0);
+    variable XCOUNT: NATURAL := COUNT;
+  begin
+    if ((ARG'LENGTH <= 1) or (XCOUNT = 0)) then return ARG;
+    else
+      if (XCOUNT > ARG_L) then XCOUNT := ARG_L;
+      end if;
+      RESULT(ARG_L-XCOUNT downto 0) := XARG(ARG_L downto XCOUNT);
+      RESULT(ARG_L downto (ARG_L - XCOUNT + 1)) := (others => XARG(ARG_L));
+    end if;
+    return RESULT;
+  end XSRA;
+
+  function XROL (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR
+      is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0) := XARG;
+    variable COUNTM: INTEGER;
+  begin
+    COUNTM := COUNT mod (ARG_L + 1);
+    if COUNTM /= 0 then
+      RESULT(ARG_L downto COUNTM) := XARG(ARG_L-COUNTM downto 0);
+      RESULT(COUNTM-1 downto 0) := XARG(ARG_L downto ARG_L-COUNTM+1);
+    end if;
+    return RESULT;
+  end XROL;
+
+  function XROR (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR
+      is
+    constant ARG_L: INTEGER := ARG'LENGTH-1;
+    alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG;
+    variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0) := XARG;
+    variable COUNTM: INTEGER;
+  begin
+    COUNTM := COUNT mod (ARG_L + 1);
+    if COUNTM /= 0 then
+      RESULT(ARG_L-COUNTM downto 0) := XARG(ARG_L downto COUNTM);
+      RESULT(ARG_L downto ARG_L-COUNTM+1) := XARG(COUNTM-1 downto 0);
+    end if;
+    return RESULT;
+  end XROR;
+
+  -----------------Local Subprograms - Relational ops---------------------------
+
+  --
+  -- General "=" for UNSIGNED vectors, same length
+  --
+  function UNSIGNED_EQUAL (L, R: UNSIGNED) return BOOLEAN is
+  begin
+    return STD_LOGIC_VECTOR(L) = STD_LOGIC_VECTOR(R);
+  end UNSIGNED_EQUAL;
+
+  --
+  -- General "=" for SIGNED vectors, same length
+  --
+  function SIGNED_EQUAL (L, R: SIGNED) return BOOLEAN is
+  begin
+    return STD_LOGIC_VECTOR(L) = STD_LOGIC_VECTOR(R);
+  end SIGNED_EQUAL;
+
+  --
+  -- General "<" for UNSIGNED vectors, same length
+  --
+  function UNSIGNED_LESS (L, R: UNSIGNED) return BOOLEAN is
+  begin
+    return STD_LOGIC_VECTOR(L) < STD_LOGIC_VECTOR(R);
+  end UNSIGNED_LESS;
+
+  --
+  -- General "<" function for SIGNED vectors, same length
+  --
+  function SIGNED_LESS (L, R: SIGNED) return BOOLEAN is
+    variable INTERN_L: SIGNED(0 to L'LENGTH-1);
+    variable INTERN_R: SIGNED(0 to R'LENGTH-1);
+  begin
+    INTERN_L := L;
+    INTERN_R := R;
+    INTERN_L(0) := not INTERN_L(0);
+    INTERN_R(0) := not INTERN_R(0);
+    return STD_LOGIC_VECTOR(INTERN_L) < STD_LOGIC_VECTOR(INTERN_R);
+  end SIGNED_LESS;
+
+  --
+  -- General "<=" function for UNSIGNED vectors, same length
+  --
+  function UNSIGNED_LESS_OR_EQUAL (L, R: UNSIGNED) return BOOLEAN is
+  begin
+    return STD_LOGIC_VECTOR(L) <= STD_LOGIC_VECTOR(R);
+  end UNSIGNED_LESS_OR_EQUAL;
+
+  --
+  -- General "<=" function for SIGNED vectors, same length
+  --
+  function SIGNED_LESS_OR_EQUAL (L, R: SIGNED) return BOOLEAN is
+    -- Need aliases to assure index direction
+    variable INTERN_L: SIGNED(0 to L'LENGTH-1);
+    variable INTERN_R: SIGNED(0 to R'LENGTH-1);
+  begin
+    INTERN_L := L;
+    INTERN_R := R;
+    INTERN_L(0) := not INTERN_L(0);
+    INTERN_R(0) := not INTERN_R(0);
+    return STD_LOGIC_VECTOR(INTERN_L) <= STD_LOGIC_VECTOR(INTERN_R);
+  end SIGNED_LESS_OR_EQUAL;
+
+  --=========================Exported Functions ==========================
+
+  -- Id: A.1
+  function "abs" (ARG: SIGNED) return SIGNED is
+    constant ARG_LEFT: INTEGER := ARG'LENGTH-1;
+    alias XARG: SIGNED(ARG_LEFT downto 0) is ARG;
+    variable RESULT: SIGNED(ARG_LEFT downto 0);
+  begin
+    if ARG'LENGTH < 1 then return NAS;
+    end if;
+    RESULT := TO_01(XARG, 'X');
+    if (RESULT(RESULT'LEFT)='X') then return RESULT;
+    end if;
+    if RESULT(RESULT'LEFT) = '1' then
+      RESULT := -RESULT;
+    end if;
+    return RESULT;
+  end "abs";
+
+  -- Id: A.2
+  function "-" (ARG: SIGNED) return SIGNED is
+    constant ARG_LEFT: INTEGER := ARG'LENGTH-1;
+    alias XARG: SIGNED(ARG_LEFT downto 0) is ARG;
+    variable RESULT, XARG01 : SIGNED(ARG_LEFT downto 0);
+    variable CBIT: STD_LOGIC := '1';
+  begin
+    if ARG'LENGTH < 1 then return NAS;
+    end if;
+    XARG01 := TO_01(ARG, 'X');
+    if (XARG01(XARG01'LEFT)='X') then return XARG01;
+    end if;
+    for I in 0 to RESULT'LEFT loop
+      RESULT(I) := not(XARG01(I)) xor CBIT;
+      CBIT := CBIT and not(XARG01(I));
+    end loop;
+    return RESULT;
+  end "-";
+
+  --============================================================================
+
+  -- Id: A.3
+  function "+" (L, R: UNSIGNED) return UNSIGNED is
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : UNSIGNED(SIZE-1 downto 0);
+    variable R01 : UNSIGNED(SIZE-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    L01 := TO_01(RESIZE(L, SIZE), 'X');
+    if (L01(L01'LEFT)='X') then return L01;
+    end if;
+    R01 := TO_01(RESIZE(R, SIZE), 'X');
+    if (R01(R01'LEFT)='X') then return R01;
+    end if;
+    return ADD_UNSIGNED(L01, R01, '0');
+  end "+";
+
+  -- Id: A.4
+  function "+" (L, R: SIGNED) return SIGNED is
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : SIGNED(SIZE-1 downto 0);
+    variable R01 : SIGNED(SIZE-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    L01 := TO_01(RESIZE(L, SIZE), 'X');
+    if (L01(L01'LEFT)='X') then return L01;
+    end if;
+    R01 := TO_01(RESIZE(R, SIZE), 'X');
+    if (R01(R01'LEFT)='X') then return R01;
+    end if;
+    return ADD_SIGNED(L01, R01, '0');
+  end "+";
+
+  -- Id: A.5
+  function "+" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+  begin
+    return L + TO_UNSIGNED(R, L'LENGTH);
+  end "+";
+
+  -- Id: A.6
+  function "+" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+  begin
+    return TO_UNSIGNED(L, R'LENGTH) + R;
+  end "+";
+
+  -- Id: A.7
+  function "+" (L: SIGNED; R: INTEGER) return SIGNED is
+  begin
+    return L + TO_SIGNED(R, L'LENGTH);
+  end "+";
+
+  -- Id: A.8
+  function "+" (L: INTEGER; R: SIGNED) return SIGNED is
+  begin
+    return TO_SIGNED(L, R'LENGTH) + R;
+  end "+";
+
+  --============================================================================
+
+  -- Id: A.9
+  function "-" (L, R: UNSIGNED) return UNSIGNED is
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : UNSIGNED(SIZE-1 downto 0);
+    variable R01 : UNSIGNED(SIZE-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    L01 := TO_01(RESIZE(L, SIZE), 'X');
+    if (L01(L01'LEFT)='X') then return L01;
+    end if;
+    R01 := TO_01(RESIZE(R, SIZE), 'X');
+    if (R01(R01'LEFT)='X') then return R01;
+    end if;
+    return ADD_UNSIGNED(L01, not(R01), '1');
+  end "-";
+
+  -- Id: A.10
+  function "-" (L, R: SIGNED) return SIGNED is
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : SIGNED(SIZE-1 downto 0);
+    variable R01 : SIGNED(SIZE-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    L01 := TO_01(RESIZE(L, SIZE), 'X');
+    if (L01(L01'LEFT)='X') then return L01;
+    end if;
+    R01 := TO_01(RESIZE(R, SIZE), 'X');
+    if (R01(R01'LEFT)='X') then return R01;
+    end if;
+    return ADD_SIGNED(L01, not(R01), '1');
+  end "-";
+
+  -- Id: A.11
+  function "-" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+  begin
+    return L - TO_UNSIGNED(R, L'LENGTH);
+  end "-";
+
+  -- Id: A.12
+  function "-" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+  begin
+    return TO_UNSIGNED(L, R'LENGTH) - R;
+  end "-";
+
+  -- Id: A.13
+  function "-" (L: SIGNED; R: INTEGER) return SIGNED is
+  begin
+    return L - TO_SIGNED(R, L'LENGTH);
+  end "-";
+
+  -- Id: A.14
+  function "-" (L: INTEGER; R: SIGNED) return SIGNED is
+  begin
+    return TO_SIGNED(L, R'LENGTH) - R;
+  end "-";
+
+  --============================================================================
+
+  -- Id: A.15
+  function "*" (L, R: UNSIGNED) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XXL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XXR: UNSIGNED(R_LEFT downto 0) is R;
+    variable XL: UNSIGNED(L_LEFT downto 0);
+    variable XR: UNSIGNED(R_LEFT downto 0);
+    variable RESULT: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0) :=
+        (others => '0');
+    variable ADVAL: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    XL := TO_01(XXL, 'X');
+    XR := TO_01(XXR, 'X');
+    if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then
+      RESULT := (others => 'X');
+      return RESULT;
+    end if;
+    ADVAL := RESIZE(XR, RESULT'LENGTH);
+    for I in 0 to L_LEFT loop
+      if XL(I)='1' then RESULT := RESULT + ADVAL;
+      end if;
+      ADVAL := SHIFT_LEFT(ADVAL, 1);
+    end loop;
+    return RESULT;
+  end "*";
+
+  -- Id: A.16
+  function "*" (L, R: SIGNED) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    variable XL: SIGNED(L_LEFT downto 0);
+    variable XR: SIGNED(R_LEFT downto 0);
+    variable RESULT: SIGNED((L_LEFT+R_LEFT+1) downto 0) := (others => '0');
+    variable ADVAL: SIGNED((L_LEFT+R_LEFT+1) downto 0);
+  begin
+    if ((L_LEFT < 0) or (R_LEFT < 0)) then return NAS;
+    end if;
+    XL := TO_01(L, 'X');
+    XR := TO_01(R, 'X');
+    if ((XL(L_LEFT)='X') or (XR(R_LEFT)='X')) then
+      RESULT := (others => 'X');
+      return RESULT;
+    end if;
+    ADVAL := RESIZE(XR, RESULT'LENGTH);
+    for I in 0 to L_LEFT-1 loop
+      if XL(I)='1' then RESULT := RESULT + ADVAL;
+      end if;
+      ADVAL := SHIFT_LEFT(ADVAL, 1);
+    end loop;
+    if XL(L_LEFT)='1' then
+      RESULT := RESULT - ADVAL;
+    end if;
+    return RESULT;
+  end "*";
+
+  -- Id: A.17
+  function "*" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+  begin
+    return L * TO_UNSIGNED(R, L'LENGTH);
+  end "*";
+
+  -- Id: A.18
+  function "*" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+  begin
+    return TO_UNSIGNED(L, R'LENGTH) * R;
+  end "*";
+
+  -- Id: A.19
+  function "*" (L: SIGNED; R: INTEGER) return SIGNED is
+  begin
+    return L * TO_SIGNED(R, L'LENGTH);
+  end "*";
+
+  -- Id: A.20
+  function "*" (L: INTEGER; R: SIGNED) return SIGNED is
+  begin
+    return TO_SIGNED(L, R'LENGTH) * R;
+  end "*";
+
+  --============================================================================
+
+  -- Id: A.21
+  function "/" (L, R: UNSIGNED) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XXL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XXR: UNSIGNED(R_LEFT downto 0) is R;
+    variable XL: UNSIGNED(L_LEFT downto 0);
+    variable XR: UNSIGNED(R_LEFT downto 0);
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    XL := TO_01(XXL, 'X');
+    XR := TO_01(XXR, 'X');
+    if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then
+      FQUOT := (others => 'X');
+      return FQUOT;
+    end if;
+    DIVMOD(XL, XR, FQUOT, FREMAIN);
+    return FQUOT;
+  end "/";
+
+  -- Id: A.22
+  function "/" (L, R: SIGNED) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XXL: SIGNED(L_LEFT downto 0) is L;
+    alias XXR: SIGNED(R_LEFT downto 0) is R;
+    variable XL: SIGNED(L_LEFT downto 0);
+    variable XR: SIGNED(R_LEFT downto 0);
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+    variable XNUM: UNSIGNED(L'LENGTH-1 downto 0);
+    variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0);
+    variable QNEG: BOOLEAN := FALSE;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    XL := TO_01(XXL, 'X');
+    XR := TO_01(XXR, 'X');
+    if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then
+      FQUOT := (others => 'X');
+      return SIGNED(FQUOT);
+    end if;
+    if XL(XL'LEFT)='1' then
+      XNUM := UNSIGNED(-XL);
+      QNEG := TRUE;
+    else
+      XNUM := UNSIGNED(XL);
+    end if;
+    if XR(XR'LEFT)='1' then
+      XDENOM := UNSIGNED(-XR);
+      QNEG := not QNEG;
+    else
+      XDENOM := UNSIGNED(XR);
+    end if;
+    DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN);
+    if QNEG then FQUOT := "0"-FQUOT;
+    end if;
+    return SIGNED(FQUOT);
+  end "/";
+
+  -- Id: A.23
+  function "/" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R));
+    variable XR, QUOT: UNSIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAU;
+    end if;
+    if (R_LENGTH > L'LENGTH) then
+      QUOT := (others => '0');
+      return RESIZE(QUOT, L'LENGTH);
+    end if;
+    XR := TO_UNSIGNED(R, R_LENGTH);
+    QUOT := RESIZE((L / XR), QUOT'LENGTH);
+    return RESIZE(QUOT, L'LENGTH);
+  end "/";
+
+  -- Id: A.24
+  function "/" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+    constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, QUOT: UNSIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAU;
+    end if;
+    XL := TO_UNSIGNED(L, L_LENGTH);
+    QUOT := RESIZE((XL / R), QUOT'LENGTH);
+    if L_LENGTH > R'LENGTH and QUOT(0)/='X'
+        and QUOT(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_STD.""/"": Quotient Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(QUOT, R'LENGTH);
+  end "/";
+
+  -- Id: A.25
+  function "/" (L: SIGNED; R: INTEGER) return SIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R));
+    variable XR, QUOT: SIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAS;
+    end if;
+    if (R_LENGTH > L'LENGTH) then
+      QUOT := (others => '0');
+      return RESIZE(QUOT, L'LENGTH);
+    end if;
+    XR := TO_SIGNED(R, R_LENGTH);
+    QUOT := RESIZE((L / XR), QUOT'LENGTH);
+    return RESIZE(QUOT, L'LENGTH);
+  end "/";
+
+  -- Id: A.26
+  function "/" (L: INTEGER; R: SIGNED) return SIGNED is
+    constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, QUOT: SIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAS;
+    end if;
+    XL := TO_SIGNED(L, L_LENGTH);
+    QUOT := RESIZE((XL / R), QUOT'LENGTH);
+    if L_LENGTH > R'LENGTH and QUOT(0)/='X'
+        and QUOT(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => QUOT(R'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_STD.""/"": Quotient Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(QUOT, R'LENGTH);
+  end "/";
+
+  --============================================================================
+
+  -- Id: A.27
+  function "rem" (L, R: UNSIGNED) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XXL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XXR: UNSIGNED(R_LEFT downto 0) is R;
+    variable XL: UNSIGNED(L_LEFT downto 0);
+    variable XR: UNSIGNED(R_LEFT downto 0);
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    XL := TO_01(XXL, 'X');
+    XR := TO_01(XXR, 'X');
+    if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then
+      FREMAIN := (others => 'X');
+      return FREMAIN;
+    end if;
+    DIVMOD(XL, XR, FQUOT, FREMAIN);
+    return FREMAIN;
+  end "rem";
+
+  -- Id: A.28
+  function "rem" (L, R: SIGNED) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XXL: SIGNED(L_LEFT downto 0) is L;
+    alias XXR: SIGNED(R_LEFT downto 0) is R;
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+    variable XNUM: UNSIGNED(L'LENGTH-1 downto 0);
+    variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0);
+    variable RNEG: BOOLEAN := FALSE;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    XNUM := UNSIGNED(TO_01(XXL, 'X'));
+    XDENOM := UNSIGNED(TO_01(XXR, 'X'));
+    if ((XNUM(XNUM'LEFT)='X') or (XDENOM(XDENOM'LEFT)='X')) then
+      FREMAIN := (others => 'X');
+      return SIGNED(FREMAIN);
+    end if;
+    if XNUM(XNUM'LEFT)='1' then
+      XNUM := UNSIGNED(-SIGNED(XNUM));
+      RNEG := TRUE;
+    else
+      XNUM := UNSIGNED(XNUM);
+    end if;
+    if XDENOM(XDENOM'LEFT)='1' then
+      XDENOM := UNSIGNED(-SIGNED(XDENOM));
+    else
+      XDENOM := UNSIGNED(XDENOM);
+    end if;
+    DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN);
+    if RNEG then
+      FREMAIN := "0"-FREMAIN;
+    end if;
+    return SIGNED(FREMAIN);
+  end "rem";
+
+  -- Id: A.29
+  function "rem" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R));
+    variable XR, XREM: UNSIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAU;
+    end if;
+    XR := TO_UNSIGNED(R, R_LENGTH);
+    XREM := L rem XR;
+    if R_LENGTH > L'LENGTH and XREM(0)/='X'
+        and XREM(R_LENGTH-1 downto L'LENGTH)
+        /= (R_LENGTH-1 downto L'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_STD.""rem"": Remainder Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, L'LENGTH);
+  end "rem";
+
+  -- Id: A.30
+  function "rem" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+    constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, XREM: UNSIGNED(L_LENGTH-1 downto 0);
+  begin
+    XL := TO_UNSIGNED(L, L_LENGTH);
+    XREM := XL rem R;
+    if L_LENGTH > R'LENGTH and XREM(0)/='X'
+        and XREM(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_STD.""rem"": Remainder Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, R'LENGTH);
+  end "rem";
+
+  -- Id: A.31
+  function "rem" (L: SIGNED; R: INTEGER) return SIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R));
+    variable XR, XREM: SIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAS;
+    end if;
+    XR := TO_SIGNED(R, R_LENGTH);
+    XREM := RESIZE((L rem XR), XREM'LENGTH);
+    if R_LENGTH > L'LENGTH and XREM(0)/='X'
+        and XREM(R_LENGTH-1 downto L'LENGTH)
+        /= (R_LENGTH-1 downto L'LENGTH => XREM(L'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_STD.""rem"": Remainder Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, L'LENGTH);
+  end "rem";
+
+  -- Id: A.32
+  function "rem" (L: INTEGER; R: SIGNED) return SIGNED is
+    constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, XREM: SIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAS;
+    end if;
+    XL := TO_SIGNED(L, L_LENGTH);
+    XREM := RESIZE((XL rem R), XREM'LENGTH);
+    if L_LENGTH > R'LENGTH and XREM(0)/='X'
+        and XREM(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => XREM(R'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_STD.""rem"": Remainder Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, R'LENGTH);
+  end "rem";
+
+  --============================================================================
+
+  -- Id: A.33
+  function "mod" (L, R: UNSIGNED) return UNSIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XXL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XXR: UNSIGNED(R_LEFT downto 0) is R;
+    variable XL: UNSIGNED(L_LEFT downto 0);
+    variable XR: UNSIGNED(R_LEFT downto 0);
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU;
+    end if;
+    XL := TO_01(XXL, 'X');
+    XR := TO_01(XXR, 'X');
+    if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then
+      FREMAIN := (others => 'X');
+      return FREMAIN;
+    end if;
+    DIVMOD(XL, XR, FQUOT, FREMAIN);
+    return FREMAIN;
+  end "mod";
+
+  -- Id: A.34
+  function "mod" (L, R: SIGNED) return SIGNED is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XXL: SIGNED(L_LEFT downto 0) is L;
+    alias XXR: SIGNED(R_LEFT downto 0) is R;
+    variable XL: SIGNED(L_LEFT downto 0);
+    variable XR: SIGNED(R_LEFT downto 0);
+    variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0);
+    variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0);
+    variable XNUM: UNSIGNED(L'LENGTH-1 downto 0);
+    variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0);
+    variable RNEG: BOOLEAN := FALSE;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS;
+    end if;
+    XL := TO_01(XXL, 'X');
+    XR := TO_01(XXR, 'X');
+    if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then
+      FREMAIN := (others => 'X');
+      return SIGNED(FREMAIN);
+    end if;
+    if XL(XL'LEFT)='1' then
+      XNUM := UNSIGNED(-XL);
+    else
+      XNUM := UNSIGNED(XL);
+    end if;
+    if XR(XR'LEFT)='1' then
+      XDENOM := UNSIGNED(-XR);
+      RNEG := TRUE;
+    else
+      XDENOM := UNSIGNED(XR);
+    end if;
+    DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN);
+    if RNEG and L(L'LEFT)='1' then
+      FREMAIN := "0"-FREMAIN;
+    elsif RNEG and FREMAIN/="0" then
+      FREMAIN := FREMAIN-XDENOM;
+    elsif L(L'LEFT)='1' and FREMAIN/="0" then
+      FREMAIN := XDENOM-FREMAIN;
+    end if;
+    return SIGNED(FREMAIN);
+  end "mod";
+
+  -- Id: A.35
+  function "mod" (L: UNSIGNED; R: NATURAL) return UNSIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R));
+    variable XR, XREM: UNSIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAU;
+    end if;
+    XR := TO_UNSIGNED(R, R_LENGTH);
+    XREM := RESIZE((L mod XR), XREM'LENGTH);
+    if R_LENGTH > L'LENGTH and XREM(0)/='X'
+        and XREM(R_LENGTH-1 downto L'LENGTH)
+        /= (R_LENGTH-1 downto L'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_STD.""mod"": Modulus Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, L'LENGTH);
+  end "mod";
+
+  -- Id: A.36
+  function "mod" (L: NATURAL; R: UNSIGNED) return UNSIGNED is
+    constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, XREM: UNSIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAU;
+    end if;
+    XL := TO_UNSIGNED(L, L_LENGTH);
+    XREM := RESIZE((XL mod R), XREM'LENGTH);
+    if L_LENGTH > R'LENGTH and XREM(0)/='X'
+        and XREM(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => '0')
+        then
+      assert NO_WARNING report "NUMERIC_STD.""mod"": Modulus Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, R'LENGTH);
+  end "mod";
+
+  -- Id: A.37
+  function "mod" (L: SIGNED; R: INTEGER) return SIGNED is
+    constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R));
+    variable XR, XREM: SIGNED(R_LENGTH-1 downto 0);
+  begin
+    if (L'LENGTH < 1) then return NAS;
+    end if;
+    XR := TO_SIGNED(R, R_LENGTH);
+    XREM := RESIZE((L mod XR), XREM'LENGTH);
+    if R_LENGTH > L'LENGTH and XREM(0)/='X'
+        and XREM(R_LENGTH-1 downto L'LENGTH)
+        /= (R_LENGTH-1 downto L'LENGTH => XREM(L'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_STD.""mod"": Modulus Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, L'LENGTH);
+  end "mod";
+
+  -- Id: A.38
+  function "mod" (L: INTEGER; R: SIGNED) return SIGNED is
+    constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH);
+    variable XL, XREM: SIGNED(L_LENGTH-1 downto 0);
+  begin
+    if (R'LENGTH < 1) then return NAS;
+    end if;
+    XL := TO_SIGNED(L, L_LENGTH);
+    XREM := RESIZE((XL mod R), XREM'LENGTH);
+    if L_LENGTH > R'LENGTH and XREM(0)/='X'
+        and XREM(L_LENGTH-1 downto R'LENGTH)
+        /= (L_LENGTH-1 downto R'LENGTH => XREM(R'LENGTH-1))
+        then
+      assert NO_WARNING report "NUMERIC_STD.""mod"": Modulus Truncated"
+          severity WARNING;
+    end if;
+    return RESIZE(XREM, R'LENGTH);
+  end "mod";
+
+  --============================================================================
+
+  -- Id: C.1
+  function ">" (L, R: UNSIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return not UNSIGNED_LESS_OR_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end ">";
+
+  -- Id: C.2
+  function ">" (L, R: SIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : SIGNED(L_LEFT downto 0);
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return not SIGNED_LESS_OR_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end ">";
+
+  -- Id: C.3
+  function ">" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return TRUE;
+    end if;
+    return not UNSIGNED_LESS_OR_EQUAL(TO_UNSIGNED(L, R01'LENGTH), R01);
+  end ">";
+
+  -- Id: C.4
+  function ">" (L: INTEGER; R: SIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return L > 0;
+    end if;
+    return not SIGNED_LESS_OR_EQUAL(TO_SIGNED(L, R01'LENGTH), R01);
+  end ">";
+
+  -- Id: C.5
+  function ">" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return FALSE;
+    end if;
+    return not UNSIGNED_LESS_OR_EQUAL(L01, TO_UNSIGNED(R, L01'LENGTH));
+  end ">";
+
+  -- Id: C.6
+  function ">" (L: SIGNED; R: INTEGER) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    variable L01 : SIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD."">"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R;
+    end if;
+    return not SIGNED_LESS_OR_EQUAL(L01, TO_SIGNED(R, L01'LENGTH));
+  end ">";
+
+  --============================================================================
+
+  -- Id: C.7
+  function "<" (L, R: UNSIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return UNSIGNED_LESS(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end "<";
+
+  -- Id: C.8
+  function "<" (L, R: SIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : SIGNED(L_LEFT downto 0);
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return SIGNED_LESS(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end "<";
+
+  -- Id: C.9
+  function "<" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L < 0;
+    end if;
+    return UNSIGNED_LESS(TO_UNSIGNED(L, R01'LENGTH), R01);
+  end "<";
+
+  -- Id: C.10
+  function "<" (L: INTEGER; R: SIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return L < 0;
+    end if;
+    return SIGNED_LESS(TO_SIGNED(L, R01'LENGTH), R01);
+  end "<";
+
+  -- Id: C.11
+  function "<" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R;
+    end if;
+    return UNSIGNED_LESS(L01, TO_UNSIGNED(R, L01'LENGTH));
+  end "<";
+
+  -- Id: C.12
+  function "<" (L: SIGNED; R: INTEGER) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    variable L01 : SIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<"": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R;
+    end if;
+    return SIGNED_LESS(L01, TO_SIGNED(R, L01'LENGTH));
+  end "<";
+
+  --============================================================================
+
+  -- Id: C.13
+  function "<=" (L, R: UNSIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return UNSIGNED_LESS_OR_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end "<=";
+
+  -- Id: C.14
+  function "<=" (L, R: SIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : SIGNED(L_LEFT downto 0);
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return SIGNED_LESS_OR_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end "<=";
+
+  -- Id: C.15
+  function "<=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L < 0;
+    end if;
+    return UNSIGNED_LESS_OR_EQUAL(TO_UNSIGNED(L, R01'LENGTH), R01);
+  end "<=";
+
+  -- Id: C.16
+  function "<=" (L: INTEGER; R: SIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return L < 0;
+    end if;
+    return SIGNED_LESS_OR_EQUAL(TO_SIGNED(L, R01'LENGTH), R01);
+  end "<=";
+
+  -- Id: C.17
+  function "<=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+  begin
+    if (L_LEFT < 0) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R;
+    end if;
+    return UNSIGNED_LESS_OR_EQUAL(L01, TO_UNSIGNED(R, L01'LENGTH));
+  end "<=";
+
+  -- Id: C.18
+  function "<=" (L: SIGNED; R: INTEGER) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    variable L01 : SIGNED(L_LEFT downto 0);
+  begin
+    if (L_LEFT < 0) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""<="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R;
+    end if;
+    return SIGNED_LESS_OR_EQUAL(L01, TO_SIGNED(R, L01'LENGTH));
+  end "<=";
+
+  --============================================================================
+
+  -- Id: C.19
+  function ">=" (L, R: UNSIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return not UNSIGNED_LESS(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end ">=";
+
+  -- Id: C.20
+  function ">=" (L, R: SIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : SIGNED(L_LEFT downto 0);
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return not SIGNED_LESS(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end ">=";
+
+  -- Id: C.21
+  function ">=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L > 0;
+    end if;
+    return not UNSIGNED_LESS(TO_UNSIGNED(L, R01'LENGTH), R01);
+  end ">=";
+
+  -- Id: C.22
+  function ">=" (L: INTEGER; R: SIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return L > 0;
+    end if;
+    return not SIGNED_LESS(TO_SIGNED(L, R01'LENGTH), R01);
+  end ">=";
+
+  -- Id: C.23
+  function ">=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R;
+    end if;
+    return not UNSIGNED_LESS(L01, TO_UNSIGNED(R, L01'LENGTH));
+  end ">=";
+
+  -- Id: C.24
+  function ">=" (L: SIGNED; R: INTEGER) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    variable L01 : SIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD."">="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R;
+    end if;
+    return not SIGNED_LESS(L01, TO_SIGNED(R, L01'LENGTH));
+  end ">=";
+
+  --============================================================================
+
+  -- Id: C.25
+  function "=" (L, R: UNSIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return UNSIGNED_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end "=";
+
+  -- Id: C.26
+  function "=" (L, R: SIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : SIGNED(L_LEFT downto 0);
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    return SIGNED_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE));
+  end "=";
+
+  -- Id: C.27
+  function "=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return FALSE;
+    end if;
+    return UNSIGNED_EQUAL(TO_UNSIGNED(L, R01'LENGTH), R01);
+  end "=";
+
+  -- Id: C.28
+  function "=" (L: INTEGER; R: SIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return FALSE;
+    end if;
+    return SIGNED_EQUAL(TO_SIGNED(L, R01'LENGTH), R01);
+  end "=";
+
+  -- Id: C.29
+  function "=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return FALSE;
+    end if;
+    return UNSIGNED_EQUAL(L01, TO_UNSIGNED(R, L01'LENGTH));
+  end "=";
+
+  -- Id: C.30
+  function "=" (L: SIGNED; R: INTEGER) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    variable L01 : SIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": null argument detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""="": metavalue detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return FALSE;
+    end if;
+    return SIGNED_EQUAL(L01, TO_SIGNED(R, L01'LENGTH));
+  end "=";
+
+  --============================================================================
+
+  -- Id: C.31
+  function "/=" (L, R: UNSIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": metavalue detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    return not(UNSIGNED_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE)));
+  end "/=";
+
+  -- Id: C.32
+  function "/=" (L, R: SIGNED) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH);
+    variable L01 : SIGNED(L_LEFT downto 0);
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    R01 := TO_01(XR, 'X');
+    if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": metavalue detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    return not(SIGNED_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE)));
+  end "/=";
+
+  -- Id: C.33
+  function "/=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: UNSIGNED(R_LEFT downto 0) is R;
+    variable R01 : UNSIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": metavalue detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    if UNSIGNED_NUM_BITS(L) > R'LENGTH then return TRUE;
+    end if;
+    return not(UNSIGNED_EQUAL(TO_UNSIGNED(L, R01'LENGTH), R01));
+  end "/=";
+
+  -- Id: C.34
+  function "/=" (L: INTEGER; R: SIGNED) return BOOLEAN is
+    constant R_LEFT: INTEGER := R'LENGTH-1;
+    alias XR: SIGNED(R_LEFT downto 0) is R;
+    variable R01 : SIGNED(R_LEFT downto 0);
+  begin
+    if (R'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    R01 := TO_01(XR, 'X');
+    if (R01(R01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": metavalue detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    if SIGNED_NUM_BITS(L) > R'LENGTH then return TRUE;
+    end if;
+    return not(SIGNED_EQUAL(TO_SIGNED(L, R01'LENGTH), R01));
+  end "/=";
+
+  -- Id: C.35
+  function "/=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: UNSIGNED(L_LEFT downto 0) is L;
+    variable L01 : UNSIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": metavalue detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    if UNSIGNED_NUM_BITS(R) > L'LENGTH then return TRUE;
+    end if;
+    return not(UNSIGNED_EQUAL(L01, TO_UNSIGNED(R, L01'LENGTH)));
+  end "/=";
+
+  -- Id: C.36
+  function "/=" (L: SIGNED; R: INTEGER) return BOOLEAN is
+    constant L_LEFT: INTEGER := L'LENGTH-1;
+    alias XL: SIGNED(L_LEFT downto 0) is L;
+    variable L01 : SIGNED(L_LEFT downto 0);
+  begin
+    if (L'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": null argument detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    L01 := TO_01(XL, 'X');
+    if (L01(L01'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.""/="": metavalue detected, returning TRUE"
+          severity WARNING;
+      return TRUE;
+    end if;
+    if SIGNED_NUM_BITS(R) > L'LENGTH then return TRUE;
+    end if;
+    return not(SIGNED_EQUAL(L01, TO_SIGNED(R, L01'LENGTH)));
+  end "/=";
+
+  --============================================================================
+
+  -- Id: S.1
+  function SHIFT_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAU;
+    end if;
+    return UNSIGNED(XSLL(STD_LOGIC_VECTOR(ARG), COUNT));
+  end SHIFT_LEFT;
+
+  -- Id: S.2
+  function SHIFT_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAU;
+    end if;
+    return UNSIGNED(XSRL(STD_LOGIC_VECTOR(ARG), COUNT));
+  end SHIFT_RIGHT;
+
+  -- Id: S.3
+  function SHIFT_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAS;
+    end if;
+    return SIGNED(XSLL(STD_LOGIC_VECTOR(ARG), COUNT));
+  end SHIFT_LEFT;
+
+  -- Id: S.4
+  function SHIFT_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAS;
+    end if;
+    return SIGNED(XSRA(STD_LOGIC_VECTOR(ARG), COUNT));
+  end SHIFT_RIGHT;
+
+  --============================================================================
+
+  -- Id: S.5
+  function ROTATE_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAU;
+    end if;
+    return UNSIGNED(XROL(STD_LOGIC_VECTOR(ARG), COUNT));
+  end ROTATE_LEFT;
+
+  -- Id: S.6
+  function ROTATE_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAU;
+    end if;
+    return UNSIGNED(XROR(STD_LOGIC_VECTOR(ARG), COUNT));
+  end ROTATE_RIGHT;
+
+
+  -- Id: S.7
+  function ROTATE_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAS;
+    end if;
+    return SIGNED(XROL(STD_LOGIC_VECTOR(ARG), COUNT));
+  end ROTATE_LEFT;
+
+  -- Id: S.8
+  function ROTATE_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is
+  begin
+    if (ARG'LENGTH < 1) then return NAS;
+    end if;
+    return SIGNED(XROR(STD_LOGIC_VECTOR(ARG), COUNT));
+  end ROTATE_RIGHT;
+
+  --============================================================================
+--START-V93
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.9 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.9
+  function "sll" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is
+  begin
+    if (COUNT >= 0) then
+      return SHIFT_LEFT(ARG, COUNT);
+    else
+      return SHIFT_RIGHT(ARG, -COUNT);
+    end if;
+  end "sll";
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.10 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.10
+  function "sll" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is
+  begin
+    if (COUNT >= 0) then
+      return SHIFT_LEFT(ARG, COUNT);
+    else
+      return SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), -COUNT));
+    end if;
+  end "sll";
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.11 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.11
+  function "srl" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is
+  begin
+    if (COUNT >= 0) then
+      return SHIFT_RIGHT(ARG, COUNT);
+    else
+      return SHIFT_LEFT(ARG, -COUNT);
+    end if;
+  end "srl";
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.12 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.12
+  function "srl" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is
+  begin
+    if (COUNT >= 0) then
+      return SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), COUNT));
+    else
+      return SHIFT_LEFT(ARG, -COUNT);
+    end if;
+  end "srl";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.13 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.13
+  function "rol" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is
+  begin
+    if (COUNT >= 0) then
+      return ROTATE_LEFT(ARG, COUNT);
+    else
+      return ROTATE_RIGHT(ARG, -COUNT);
+    end if;
+  end "rol";
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.14 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.14
+  function "rol" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is
+  begin
+    if (COUNT >= 0) then
+      return ROTATE_LEFT(ARG, COUNT);
+    else
+      return ROTATE_RIGHT(ARG, -COUNT);
+    end if;
+  end "rol";
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.15 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.15
+  function "ror" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is
+  begin
+    if (COUNT >= 0) then
+      return ROTATE_RIGHT(ARG, COUNT);
+    else
+      return ROTATE_LEFT(ARG, -COUNT);
+    end if;
+  end "ror";
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.16 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.16
+  function "ror" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is
+  begin
+    if (COUNT >= 0) then
+      return ROTATE_RIGHT(ARG, COUNT);
+    else
+      return ROTATE_LEFT(ARG, -COUNT);
+    end if;
+  end "ror";
+
+--END-V93
+  --============================================================================
+
+  -- Id: D.1
+  function TO_INTEGER (ARG: UNSIGNED) return NATURAL is
+    constant ARG_LEFT: INTEGER := ARG'LENGTH-1;
+    alias XXARG: UNSIGNED(ARG_LEFT downto 0) is ARG;
+    variable XARG: UNSIGNED(ARG_LEFT downto 0);
+    variable RESULT: NATURAL := 0;
+  begin
+    if (ARG'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.TO_INTEGER: null detected, returning 0"
+          severity WARNING;
+      return 0;
+    end if;
+    XARG := TO_01(XXARG, 'X');
+    if (XARG(XARG'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.TO_INTEGER: metavalue detected, returning 0"
+          severity WARNING;
+      return 0;
+    end if;
+    for I in XARG'RANGE loop
+      RESULT := RESULT+RESULT;
+      if XARG(I) = '1' then
+        RESULT := RESULT + 1;
+      end if;
+    end loop;
+    return RESULT;
+  end TO_INTEGER;
+
+  -- Id: D.2
+  function TO_INTEGER (ARG: SIGNED) return INTEGER is
+    variable XARG: SIGNED(ARG'LENGTH-1 downto 0);
+  begin
+    if (ARG'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.TO_INTEGER: null detected, returning 0"
+          severity WARNING;
+      return 0;
+    end if;
+    XARG := TO_01(ARG, 'X');
+    if (XARG(XARG'LEFT)='X') then
+      assert NO_WARNING
+          report "NUMERIC_STD.TO_INTEGER: metavalue detected, returning 0"
+          severity WARNING;
+      return 0;
+    end if;
+    if XARG(XARG'LEFT) = '0' then
+      return TO_INTEGER(UNSIGNED(XARG));
+    else
+      return (- (TO_INTEGER(UNSIGNED(- (XARG + 1)))) -1);
+    end if;
+  end TO_INTEGER;
+
+  -- Id: D.3
+  function TO_UNSIGNED (ARG, SIZE: NATURAL) return UNSIGNED is
+    variable RESULT: UNSIGNED(SIZE-1 downto 0);
+    variable I_VAL: NATURAL := ARG;
+  begin
+    if (SIZE < 1) then return NAU;
+    end if;
+    for I in 0 to RESULT'LEFT loop
+      if (I_VAL mod 2) = 0 then
+        RESULT(I) := '0';
+      else RESULT(I) := '1';
+      end if;
+      I_VAL := I_VAL/2;
+    end loop;
+    if not(I_VAL =0) then
+      assert NO_WARNING
+          report "NUMERIC_STD.TO_UNSIGNED: vector truncated"
+          severity WARNING;
+    end if;
+    return RESULT;
+  end TO_UNSIGNED;
+
+  -- Id: D.4
+  function TO_SIGNED (ARG: INTEGER; SIZE: NATURAL) return SIGNED is
+    variable RESULT: SIGNED(SIZE-1 downto 0);
+    variable B_VAL: STD_LOGIC := '0';
+    variable I_VAL: INTEGER := ARG;
+  begin
+    if (SIZE < 1) then return NAS;
+    end if;
+    if (ARG < 0) then
+      B_VAL := '1';
+      I_VAL := -(ARG+1);
+    end if;
+    for I in 0 to RESULT'LEFT loop
+      if (I_VAL mod 2) = 0 then
+        RESULT(I) := B_VAL;
+      else
+        RESULT(I) := not B_VAL;
+      end if;
+      I_VAL := I_VAL/2;
+    end loop;
+    if ((I_VAL/=0) or (B_VAL/=RESULT(RESULT'LEFT))) then
+      assert NO_WARNING
+          report "NUMERIC_STD.TO_SIGNED: vector truncated"
+          severity WARNING;
+    end if;
+    return RESULT;
+  end TO_SIGNED;
+
+  --============================================================================
+
+  -- Id: R.1
+  function RESIZE (ARG: SIGNED; NEW_SIZE: NATURAL) return SIGNED is
+    alias INVEC: SIGNED(ARG'LENGTH-1 downto 0) is ARG;
+    variable RESULT: SIGNED(NEW_SIZE-1 downto 0) := (others => '0');
+    constant BOUND: INTEGER := MIN(ARG'LENGTH, RESULT'LENGTH)-2;
+  begin
+    if (NEW_SIZE < 1) then return NAS;
+    end if;
+    if (ARG'LENGTH = 0) then return RESULT;
+    end if;
+    RESULT := (others => ARG(ARG'LEFT));
+    if BOUND >= 0 then
+      RESULT(BOUND downto 0) := INVEC(BOUND downto 0);
+    end if;
+    return RESULT;
+  end RESIZE;
+
+  -- Id: R.2
+  function RESIZE (ARG: UNSIGNED; NEW_SIZE: NATURAL) return UNSIGNED is
+    constant ARG_LEFT: INTEGER := ARG'LENGTH-1;
+    alias XARG: UNSIGNED(ARG_LEFT downto 0) is ARG;
+    variable RESULT: UNSIGNED(NEW_SIZE-1 downto 0) := (others => '0');
+  begin
+    if (NEW_SIZE < 1) then return NAU;
+    end if;
+    if XARG'LENGTH =0 then return RESULT;
+    end if;
+    if (RESULT'LENGTH < ARG'LENGTH) then
+      RESULT(RESULT'LEFT downto 0) := XARG(RESULT'LEFT downto 0);
+    else
+      RESULT(RESULT'LEFT downto XARG'LEFT+1) := (others => '0');
+      RESULT(XARG'LEFT downto 0) := XARG;
+    end if;
+    return RESULT;
+  end RESIZE;
+
+  --============================================================================
+
+  -- Id: L.1
+  function "not" (L: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(not(STD_LOGIC_VECTOR(L)));
+    return RESULT;
+  end "not";
+
+  -- Id: L.2
+  function "and" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) and STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "and";
+
+  -- Id: L.3
+  function "or" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) or STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "or";
+
+  -- Id: L.4
+  function "nand" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) nand STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "nand";
+
+  -- Id: L.5
+  function "nor" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) nor STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "nor";
+
+  -- Id: L.6
+  function "xor" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) xor STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "xor";
+
+--START-V93
+  ------------------------------------------------------------------------------
+  -- Note : Function L.7 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: L.7
+  function "xnor" (L, R: UNSIGNED) return UNSIGNED is
+    variable RESULT: UNSIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) xnor STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "xnor";
+--END-V93
+
+  -- Id: L.8
+  function "not" (L: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(not(STD_LOGIC_VECTOR(L)));
+    return RESULT;
+  end "not";
+
+  -- Id: L.9
+  function "and" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(STD_LOGIC_VECTOR(L) and STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "and";
+
+  -- Id: L.10
+  function "or" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(STD_LOGIC_VECTOR(L) or STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "or";
+
+  -- Id: L.11
+  function "nand" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(STD_LOGIC_VECTOR(L) nand STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "nand";
+
+  -- Id: L.12
+  function "nor" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(STD_LOGIC_VECTOR(L) nor STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "nor";
+
+  -- Id: L.13
+  function "xor" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(STD_LOGIC_VECTOR(L) xor STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "xor";
+
+--START-V93
+  ------------------------------------------------------------------------------
+  -- Note : Function L.14 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: L.14
+  function "xnor" (L, R: SIGNED) return SIGNED is
+    variable RESULT: SIGNED(L'LENGTH-1 downto 0);
+  begin
+    RESULT := SIGNED(STD_LOGIC_VECTOR(L) xnor STD_LOGIC_VECTOR(R));
+    return RESULT;
+  end "xnor";
+--END-V93
+
+  --============================================================================
+
+  -- support constants for STD_MATCH:
+
+  type BOOLEAN_TABLE is array(STD_ULOGIC, STD_ULOGIC) of BOOLEAN;
+
+  constant MATCH_TABLE: BOOLEAN_TABLE := (
+      --------------------------------------------------------------------------
+      -- U      X      0      1      Z      W      L      H      -
+      --------------------------------------------------------------------------
+      (FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,  TRUE), -- | U |
+      (FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,  TRUE), -- | X |
+      (FALSE, FALSE,  TRUE, FALSE, FALSE, FALSE,  TRUE, FALSE,  TRUE), -- | 0 |
+      (FALSE, FALSE, FALSE,  TRUE, FALSE, FALSE, FALSE,  TRUE,  TRUE), -- | 1 |
+      (FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,  TRUE), -- | Z |
+      (FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,  TRUE), -- | W |
+      (FALSE, FALSE,  TRUE, FALSE, FALSE, FALSE,  TRUE, FALSE,  TRUE), -- | L |
+      (FALSE, FALSE, FALSE,  TRUE, FALSE, FALSE, FALSE,  TRUE,  TRUE), -- | H |
+      ( TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE)  -- | - |
+      );
+
+  -- Id: M.1
+  function STD_MATCH (L, R: STD_ULOGIC) return BOOLEAN is
+    variable VALUE: STD_ULOGIC;
+  begin
+    return MATCH_TABLE(L, R);
+  end STD_MATCH;
+
+  -- Id: M.2
+  function STD_MATCH (L, R: UNSIGNED) return BOOLEAN is
+    alias LV: UNSIGNED(1 to L'LENGTH) is L;
+    alias RV: UNSIGNED(1 to R'LENGTH) is R;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.STD_MATCH: null detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if LV'LENGTH /= RV'LENGTH then
+      assert NO_WARNING
+          report "NUMERIC_STD.STD_MATCH: L'LENGTH /= R'LENGTH, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    else
+      for I in LV'LOW to LV'HIGH loop
+        if not (MATCH_TABLE(LV(I), RV(I))) then
+          return FALSE;
+        end if;
+      end loop;
+      return TRUE;
+    end if;
+  end STD_MATCH;
+
+  -- Id: M.3
+  function STD_MATCH (L, R: SIGNED) return BOOLEAN is
+    alias LV: SIGNED(1 to L'LENGTH) is L;
+    alias RV: SIGNED(1 to R'LENGTH) is R;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.STD_MATCH: null detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if LV'LENGTH /= RV'LENGTH then
+      assert NO_WARNING
+          report "NUMERIC_STD.STD_MATCH: L'LENGTH /= R'LENGTH, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    else
+      for I in LV'LOW to LV'HIGH loop
+        if not (MATCH_TABLE(LV(I), RV(I))) then
+          return FALSE;
+        end if;
+      end loop;
+      return TRUE;
+    end if;
+  end STD_MATCH;
+
+  -- Id: M.4
+  function STD_MATCH (L, R: STD_LOGIC_VECTOR) return BOOLEAN is
+    alias LV: STD_LOGIC_VECTOR(1 to L'LENGTH) is L;
+    alias RV: STD_LOGIC_VECTOR(1 to R'LENGTH) is R;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.STD_MATCH: null detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if LV'LENGTH /= RV'LENGTH then
+      assert NO_WARNING
+          report "NUMERIC_STD.STD_MATCH: L'LENGTH /= R'LENGTH, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    else
+      for I in LV'LOW to LV'HIGH loop
+        if not (MATCH_TABLE(LV(I), RV(I))) then
+          return FALSE;
+        end if;
+      end loop;
+      return TRUE;
+    end if;
+  end STD_MATCH;
+
+  -- Id: M.5
+  function STD_MATCH (L, R: STD_ULOGIC_VECTOR) return BOOLEAN is
+    alias LV: STD_ULOGIC_VECTOR(1 to L'LENGTH) is L;
+    alias RV: STD_ULOGIC_VECTOR(1 to R'LENGTH) is R;
+  begin
+    if ((L'LENGTH < 1) or (R'LENGTH < 1)) then
+      assert NO_WARNING
+          report "NUMERIC_STD.STD_MATCH: null detected, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    end if;
+    if LV'LENGTH /= RV'LENGTH then
+      assert NO_WARNING
+          report "NUMERIC_STD.STD_MATCH: L'LENGTH /= R'LENGTH, returning FALSE"
+          severity WARNING;
+      return FALSE;
+    else
+      for I in LV'LOW to LV'HIGH loop
+        if not (MATCH_TABLE(LV(I), RV(I))) then
+          return FALSE;
+        end if;
+      end loop;
+      return TRUE;
+    end if;
+  end STD_MATCH;
+
+  --============================================================================
+
+  -- function TO_01 is used to convert vectors to the
+  --          correct form for exported functions,
+  --          and to report if there is an element which
+  --          is not in (0, 1, H, L).
+
+  -- Id: T.1
+  function TO_01 (S: UNSIGNED; XMAP: STD_LOGIC := '0') return UNSIGNED is
+    variable RESULT: UNSIGNED(S'LENGTH-1 downto 0);
+    variable BAD_ELEMENT: BOOLEAN := FALSE;
+    alias XS: UNSIGNED(S'LENGTH-1 downto 0) is S;
+  begin
+    if (S'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.TO_01: null detected, returning NAU"
+          severity WARNING;
+      return NAU;
+    end if;
+    for I in RESULT'RANGE loop
+      case XS(I) is
+        when '0' | 'L' => RESULT(I) := '0';
+        when '1' | 'H' => RESULT(I) := '1';
+        when others => BAD_ELEMENT := TRUE;
+      end case;
+    end loop;
+    if BAD_ELEMENT then
+      for I in RESULT'RANGE loop
+        RESULT(I) := XMAP; -- standard fixup
+      end loop;
+    end if;
+    return RESULT;
+  end TO_01;
+
+  -- Id: T.2
+  function TO_01 (S: SIGNED; XMAP: STD_LOGIC := '0') return SIGNED is
+    variable RESULT: SIGNED(S'LENGTH-1 downto 0);
+    variable BAD_ELEMENT: BOOLEAN := FALSE;
+    alias XS: SIGNED(S'LENGTH-1 downto 0) is S;
+  begin
+    if (S'LENGTH < 1) then
+      assert NO_WARNING
+          report "NUMERIC_STD.TO_01: null detected, returning NAS"
+          severity WARNING;
+      return NAS;
+    end if;
+    for I in RESULT'RANGE loop
+      case XS(I) is
+        when '0' | 'L' => RESULT(I) := '0';
+        when '1' | 'H' => RESULT(I) := '1';
+        when others => BAD_ELEMENT := TRUE;
+      end case;
+    end loop;
+    if BAD_ELEMENT then
+      for I in RESULT'RANGE loop
+        RESULT(I) := XMAP; -- standard fixup
+      end loop;
+    end if;
+    return RESULT;
+  end TO_01;
+
+  --============================================================================
+
+end NUMERIC_STD;
diff --git a/libraries/ieee/numeric_std.vhdl b/libraries/ieee/numeric_std.vhdl
new file mode 100644
index 000000000..da22c32b0
--- /dev/null
+++ b/libraries/ieee/numeric_std.vhdl
@@ -0,0 +1,853 @@
+-- --------------------------------------------------------------------
+--
+-- Copyright 1995 by IEEE. All rights reserved.
+--
+-- This source file is considered by the IEEE to be an essential part of the use
+-- of the standard 1076.3 and as such may be distributed without change, except
+-- as permitted by the standard. This source file may not be sold or distributed
+-- for profit. This package may be modified to include additional data required
+-- by tools, but must in no way change the external interfaces or simulation
+-- behaviour of the description. It is permissible to add comments and/or
+-- attributes to the package declarations, but not to change or delete any
+-- original lines of the approved package declaration. The package body may be
+-- changed only in accordance with the terms of clauses 7.1 and 7.2 of the
+-- standard.
+--
+-- Title      : Standard VHDL Synthesis Package (1076.3, NUMERIC_STD)
+--
+-- Library    : This package shall be compiled into a library symbolically
+--            : named IEEE.
+--
+-- Developers : IEEE DASC Synthesis Working Group, PAR 1076.3
+--
+-- Purpose    : This package defines numeric types and arithmetic functions
+--            : for use with synthesis tools. Two numeric types are defined:
+--            : -- > UNSIGNED: represents UNSIGNED number in vector form
+--            : -- > SIGNED: represents a SIGNED number in vector form
+--            : The base element type is type STD_LOGIC.
+--            : The leftmost bit is treated as the most significant bit.
+--            : Signed vectors are represented in two's complement form.
+--            : This package contains overloaded arithmetic operators on
+--            : the SIGNED and UNSIGNED types. The package also contains
+--            : useful type conversions functions.
+--            :
+--            : If any argument to a function is a null array, a null array is
+--            : returned (exceptions, if any, are noted individually).
+--
+-- Limitation :
+--
+-- Note       : No declarations or definitions shall be included in,
+--            : or excluded from this package. The "package declaration"
+--            : defines the types, subtypes and declarations of
+--            : NUMERIC_STD. The NUMERIC_STD package body shall be
+--            : considered the formal definition of the semantics of
+--            : this package. Tool developers may choose to implement
+--            : the package body in the most efficient manner available
+--            : to them.
+--
+-- --------------------------------------------------------------------
+--   modification history :
+-- --------------------------------------------------------------------
+--   Version:  2.4
+--   Date   :  12 April 1995
+-- -----------------------------------------------------------------------------
+library IEEE;
+use IEEE.STD_LOGIC_1164.all;
+
+package NUMERIC_STD is
+  constant CopyRightNotice: STRING
+      := "Copyright 1995 IEEE. All rights reserved.";
+
+  --============================================================================
+  -- Numeric array type definitions
+  --============================================================================
+
+  type UNSIGNED is array (NATURAL range <>) of STD_LOGIC;
+  type SIGNED is array (NATURAL range <>) of STD_LOGIC;
+
+  --============================================================================
+  -- Arithmetic Operators:
+  --===========================================================================
+
+  -- Id: A.1
+  function "abs" (ARG: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0).
+  -- Result: Returns the absolute value of a SIGNED vector ARG.
+
+  -- Id: A.2
+  function "-" (ARG: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0).
+  -- Result: Returns the value of the unary minus operation on a
+  --         SIGNED vector ARG.
+
+  --============================================================================
+
+  -- Id: A.3
+  function "+" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0).
+  -- Result: Adds two UNSIGNED vectors that may be of different lengths.
+
+  -- Id: A.4
+  function "+" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0).
+  -- Result: Adds two SIGNED vectors that may be of different lengths.
+
+  -- Id: A.5
+  function "+" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0).
+  -- Result: Adds an UNSIGNED vector, L, with a non-negative INTEGER, R.
+
+  -- Id: A.6
+  function "+" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0).
+  -- Result: Adds a non-negative INTEGER, L, with an UNSIGNED vector, R.
+
+  -- Id: A.7
+  function "+" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0).
+  -- Result: Adds an INTEGER, L(may be positive or negative), to a SIGNED
+  --         vector, R.
+
+  -- Id: A.8
+  function "+" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0).
+  -- Result: Adds a SIGNED vector, L, to an INTEGER, R.
+
+  --============================================================================
+
+  -- Id: A.9
+  function "-" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0).
+  -- Result: Subtracts two UNSIGNED vectors that may be of different lengths.
+
+  -- Id: A.10
+  function "-" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0).
+  -- Result: Subtracts a SIGNED vector, R, from another SIGNED vector, L,
+  --         that may possibly be of different lengths.
+
+  -- Id: A.11
+  function "-" (L: UNSIGNED;R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0).
+  -- Result: Subtracts a non-negative INTEGER, R, from an UNSIGNED vector, L.
+
+  -- Id: A.12
+  function "-" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0).
+  -- Result: Subtracts an UNSIGNED vector, R, from a non-negative INTEGER, L.
+
+  -- Id: A.13
+  function "-" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0).
+  -- Result: Subtracts an INTEGER, R, from a SIGNED vector, L.
+
+  -- Id: A.14
+  function "-" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0).
+  -- Result: Subtracts a SIGNED vector, R, from an INTEGER, L.
+
+  --============================================================================
+
+  -- Id: A.15
+  function "*" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0).
+  -- Result: Performs the multiplication operation on two UNSIGNED vectors
+  --         that may possibly be of different lengths.
+
+  -- Id: A.16
+  function "*" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED((L'LENGTH+R'LENGTH-1) downto 0)
+  -- Result: Multiplies two SIGNED vectors that may possibly be of
+  --         different lengths.
+
+  -- Id: A.17
+  function "*" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED((L'LENGTH+L'LENGTH-1) downto 0).
+  -- Result: Multiplies an UNSIGNED vector, L, with a non-negative
+  --         INTEGER, R. R is converted to an UNSIGNED vector of
+  --         SIZE L'LENGTH before multiplication.
+
+  -- Id: A.18
+  function "*" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED((R'LENGTH+R'LENGTH-1) downto 0).
+  -- Result: Multiplies an UNSIGNED vector, R, with a non-negative
+  --         INTEGER, L. L is converted to an UNSIGNED vector of
+  --         SIZE R'LENGTH before multiplication.
+
+  -- Id: A.19
+  function "*" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED((L'LENGTH+L'LENGTH-1) downto 0)
+  -- Result: Multiplies a SIGNED vector, L, with an INTEGER, R. R is
+  --         converted to a SIGNED vector of SIZE L'LENGTH before
+  --         multiplication.
+
+  -- Id: A.20
+  function "*" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED((R'LENGTH+R'LENGTH-1) downto 0)
+  -- Result: Multiplies a SIGNED vector, R, with an INTEGER, L. L is
+  --         converted to a SIGNED vector of SIZE R'LENGTH before
+  --         multiplication.
+
+  --============================================================================
+  --
+  -- NOTE: If second argument is zero for "/" operator, a severity level
+  --       of ERROR is issued.
+
+  -- Id: A.21
+  function "/" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Divides an UNSIGNED vector, L, by another UNSIGNED vector, R.
+
+  -- Id: A.22
+  function "/" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Divides an SIGNED vector, L, by another SIGNED vector, R.
+
+  -- Id: A.23
+  function "/" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Divides an UNSIGNED vector, L, by a non-negative INTEGER, R.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.24
+  function "/" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Divides a non-negative INTEGER, L, by an UNSIGNED vector, R.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  -- Id: A.25
+  function "/" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Divides a SIGNED vector, L, by an INTEGER, R.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.26
+  function "/" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Divides an INTEGER, L, by a SIGNED vector, R.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  --============================================================================
+  --
+  -- NOTE: If second argument is zero for "rem" operator, a severity level
+  --       of ERROR is issued.
+
+  -- Id: A.27
+  function "rem" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where L and R are UNSIGNED vectors.
+
+  -- Id: A.28
+  function "rem" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where L and R are SIGNED vectors.
+
+  -- Id: A.29
+  function "rem" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where L is an UNSIGNED vector and R is a
+  --         non-negative INTEGER.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.30
+  function "rem" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where R is an UNSIGNED vector and L is a
+  --         non-negative INTEGER.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  -- Id: A.31
+  function "rem" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where L is SIGNED vector and R is an INTEGER.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.32
+  function "rem" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L rem R" where R is SIGNED vector and L is an INTEGER.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  --============================================================================
+  --
+  -- NOTE: If second argument is zero for "mod" operator, a severity level
+  --       of ERROR is issued.
+
+  -- Id: A.33
+  function "mod" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L and R are UNSIGNED vectors.
+
+  -- Id: A.34
+  function "mod" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L and R are SIGNED vectors.
+
+  -- Id: A.35
+  function "mod" (L: UNSIGNED; R: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L is an UNSIGNED vector and R
+  --         is a non-negative INTEGER.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.36
+  function "mod" (L: NATURAL; R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where R is an UNSIGNED vector and L
+  --         is a non-negative INTEGER.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  -- Id: A.37
+  function "mod" (L: SIGNED; R: INTEGER) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+  --         If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH.
+
+  -- Id: A.38
+  function "mod" (L: INTEGER; R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(R'LENGTH-1 downto 0)
+  -- Result: Computes "L mod R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+  --         If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH.
+
+  --============================================================================
+  -- Comparison Operators
+  --============================================================================
+
+  -- Id: C.1
+  function ">" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.2
+  function ">" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.3
+  function ">" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.4
+  function ">" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L is a INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.5
+  function ">" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.6
+  function ">" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L > R" where L is a SIGNED vector and
+  --         R is a INTEGER.
+
+  --============================================================================
+
+  -- Id: C.7
+  function "<" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.8
+  function "<" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.9
+  function "<" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.10
+  function "<" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.11
+  function "<" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.12
+  function "<" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L < R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+
+  -- Id: C.13
+  function "<=" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.14
+  function "<=" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.15
+  function "<=" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.16
+  function "<=" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.17
+  function "<=" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.18
+  function "<=" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L <= R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+
+  -- Id: C.19
+  function ">=" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.20
+  function ">=" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.21
+  function ">=" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.22
+  function ">=" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.23
+  function ">=" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.24
+  function ">=" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L >= R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+
+  -- Id: C.25
+  function "=" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.26
+  function "=" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.27
+  function "=" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.28
+  function "=" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.29
+  function "=" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.30
+  function "=" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L = R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+
+  -- Id: C.31
+  function "/=" (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L and R are UNSIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.32
+  function "/=" (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L and R are SIGNED vectors possibly
+  --         of different lengths.
+
+  -- Id: C.33
+  function "/=" (L: NATURAL; R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L is a non-negative INTEGER and
+  --         R is an UNSIGNED vector.
+
+  -- Id: C.34
+  function "/=" (L: INTEGER; R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L is an INTEGER and
+  --         R is a SIGNED vector.
+
+  -- Id: C.35
+  function "/=" (L: UNSIGNED; R: NATURAL) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L is an UNSIGNED vector and
+  --         R is a non-negative INTEGER.
+
+  -- Id: C.36
+  function "/=" (L: SIGNED; R: INTEGER) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: Computes "L /= R" where L is a SIGNED vector and
+  --         R is an INTEGER.
+
+  --============================================================================
+  -- Shift and Rotate Functions
+  --============================================================================
+
+  -- Id: S.1
+  function SHIFT_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a shift-left on an UNSIGNED vector COUNT times.
+  --         The vacated positions are filled with '0'.
+  --         The COUNT leftmost elements are lost.
+
+  -- Id: S.2
+  function SHIFT_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a shift-right on an UNSIGNED vector COUNT times.
+  --         The vacated positions are filled with '0'.
+  --         The COUNT rightmost elements are lost.
+
+  -- Id: S.3
+  function SHIFT_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a shift-left on a SIGNED vector COUNT times.
+  --         The vacated positions are filled with '0'.
+  --         The COUNT leftmost elements are lost.
+
+  -- Id: S.4
+  function SHIFT_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a shift-right on a SIGNED vector COUNT times.
+  --         The vacated positions are filled with the leftmost
+  --         element, ARG'LEFT. The COUNT rightmost elements are lost.
+
+  --============================================================================
+
+  -- Id: S.5
+  function ROTATE_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a rotate-left of an UNSIGNED vector COUNT times.
+
+  -- Id: S.6
+  function ROTATE_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a rotate-right of an UNSIGNED vector COUNT times.
+
+  -- Id: S.7
+  function ROTATE_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a logical rotate-left of a SIGNED
+  --         vector COUNT times.
+
+  -- Id: S.8
+  function ROTATE_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: Performs a logical rotate-right of a SIGNED
+  --         vector COUNT times.
+
+  --============================================================================
+
+  --============================================================================
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.9 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.9
+  function "sll" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: SHIFT_LEFT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.10 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.10
+  function "sll" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: SHIFT_LEFT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.11 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.11
+  function "srl" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: SHIFT_RIGHT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.12 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.12
+  function "srl" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), COUNT))
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.13 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.13
+  function "rol" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: ROTATE_LEFT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.14 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.14
+  function "rol" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: ROTATE_LEFT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  -- Note : Function S.15 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.15
+  function "ror" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: ROTATE_RIGHT(ARG, COUNT)
+
+  ------------------------------------------------------------------------------
+  --   Note : Function S.16 is not compatible with VHDL 1076-1987. Comment
+  --   out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  ------------------------------------------------------------------------------
+  -- Id: S.16
+  function "ror" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93
+  -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0)
+  -- Result: ROTATE_RIGHT(ARG, COUNT)
+
+  --============================================================================
+  --   RESIZE Functions
+  --============================================================================
+
+  -- Id: R.1
+  function RESIZE (ARG: SIGNED; NEW_SIZE: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(NEW_SIZE-1 downto 0)
+  -- Result: Resizes the SIGNED vector ARG to the specified size.
+  --         To create a larger vector, the new [leftmost] bit positions
+  --         are filled with the sign bit (ARG'LEFT). When truncating,
+  --         the sign bit is retained along with the rightmost part.
+
+  -- Id: R.2
+  function RESIZE (ARG: UNSIGNED; NEW_SIZE: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(NEW_SIZE-1 downto 0)
+  -- Result: Resizes the SIGNED vector ARG to the specified size.
+  --         To create a larger vector, the new [leftmost] bit positions
+  --         are filled with '0'. When truncating, the leftmost bits
+  --         are dropped.
+
+  --============================================================================
+  -- Conversion Functions
+  --============================================================================
+
+  -- Id: D.1
+  function TO_INTEGER (ARG: UNSIGNED) return NATURAL;
+  -- Result subtype: NATURAL. Value cannot be negative since parameter is an
+  --             UNSIGNED vector.
+  -- Result: Converts the UNSIGNED vector to an INTEGER.
+
+  -- Id: D.2
+  function TO_INTEGER (ARG: SIGNED) return INTEGER;
+  -- Result subtype: INTEGER
+  -- Result: Converts a SIGNED vector to an INTEGER.
+
+  -- Id: D.3
+  function TO_UNSIGNED (ARG, SIZE: NATURAL) return UNSIGNED;
+  -- Result subtype: UNSIGNED(SIZE-1 downto 0)
+  -- Result: Converts a non-negative INTEGER to an UNSIGNED vector with
+  --         the specified SIZE.
+
+  -- Id: D.4
+  function TO_SIGNED (ARG: INTEGER; SIZE: NATURAL) return SIGNED;
+  -- Result subtype: SIGNED(SIZE-1 downto 0)
+  -- Result: Converts an INTEGER to a SIGNED vector of the specified SIZE.
+
+  --============================================================================
+  -- Logical Operators
+  --============================================================================
+
+  -- Id: L.1
+  function "not" (L: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Termwise inversion
+
+  -- Id: L.2
+  function "and" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector AND operation
+
+  -- Id: L.3
+  function "or" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector OR operation
+
+  -- Id: L.4
+  function "nand" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector NAND operation
+
+  -- Id: L.5
+  function "nor" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector NOR operation
+
+  -- Id: L.6
+  function "xor" (L, R: UNSIGNED) return UNSIGNED;
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector XOR operation
+
+  -- ---------------------------------------------------------------------------
+  -- Note : Function L.7 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  -- ---------------------------------------------------------------------------
+  -- Id: L.7
+  function "xnor" (L, R: UNSIGNED) return UNSIGNED; --V93
+  -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector XNOR operation
+
+  -- Id: L.8
+  function "not" (L: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Termwise inversion
+
+  -- Id: L.9
+  function "and" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector AND operation
+
+  -- Id: L.10
+  function "or" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector OR operation
+
+  -- Id: L.11
+  function "nand" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector NAND operation
+
+  -- Id: L.12
+  function "nor" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector NOR operation
+
+  -- Id: L.13
+  function "xor" (L, R: SIGNED) return SIGNED;
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector XOR operation
+
+  -- ---------------------------------------------------------------------------
+  -- Note : Function L.14 is not compatible with VHDL 1076-1987. Comment
+  -- out the function (declaration and body) for VHDL 1076-1987 compatibility.
+  -- ---------------------------------------------------------------------------
+  -- Id: L.14
+  function "xnor" (L, R: SIGNED) return SIGNED; --V93
+  -- Result subtype: SIGNED(L'LENGTH-1 downto 0)
+  -- Result: Vector XNOR operation
+
+  --============================================================================
+  -- Match Functions
+  --============================================================================
+
+  -- Id: M.1
+  function STD_MATCH (L, R: STD_ULOGIC) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: terms compared per STD_LOGIC_1164 intent
+
+  -- Id: M.2
+  function STD_MATCH (L, R: UNSIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: terms compared per STD_LOGIC_1164 intent
+
+  -- Id: M.3
+  function STD_MATCH (L, R: SIGNED) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: terms compared per STD_LOGIC_1164 intent
+
+  -- Id: M.4
+  function STD_MATCH (L, R: STD_LOGIC_VECTOR) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: terms compared per STD_LOGIC_1164 intent
+
+  -- Id: M.5
+  function STD_MATCH (L, R: STD_ULOGIC_VECTOR) return BOOLEAN;
+  -- Result subtype: BOOLEAN
+  -- Result: terms compared per STD_LOGIC_1164 intent
+
+  --============================================================================
+  -- Translation Functions
+  --============================================================================
+
+  -- Id: T.1
+  function TO_01 (S: UNSIGNED; XMAP: STD_LOGIC := '0') return UNSIGNED;
+  -- Result subtype: UNSIGNED(S'RANGE)
+  -- Result: Termwise, 'H' is translated to '1', and 'L' is translated
+  --         to '0'. If a value other than '0'|'1'|'H'|'L' is found,
+  --         the array is set to (others => XMAP), and a warning is
+  --         issued.
+
+  -- Id: T.2
+  function TO_01 (S: SIGNED; XMAP: STD_LOGIC := '0') return SIGNED;
+  -- Result subtype: SIGNED(S'RANGE)
+  -- Result: Termwise, 'H' is translated to '1', and 'L' is translated
+  --         to '0'. If a value other than '0'|'1'|'H'|'L' is found,
+  --         the array is set to (others => XMAP), and a warning is
+  --         issued.
+
+end NUMERIC_STD;
diff --git a/libraries/ieee/std_logic_1164.vhdl b/libraries/ieee/std_logic_1164.vhdl
new file mode 100644
index 000000000..c53113be9
--- /dev/null
+++ b/libraries/ieee/std_logic_1164.vhdl
@@ -0,0 +1,175 @@
+-- --------------------------------------------------------------------
+--
+--   Title     :  std_logic_1164 multi-value logic system
+--   Library   :  This package shall be compiled into a library
+--             :  symbolically named IEEE.
+--             :
+--   Developers:  IEEE model standards group (par 1164)
+--   Purpose   :  This packages defines a standard for designers
+--             :  to use in describing the interconnection data types
+--             :  used in vhdl modeling.
+--             :
+--   Limitation:  The logic system defined in this package may
+--             :  be insufficient for modeling switched transistors,
+--             :  since such a requirement is out of the scope of this
+--             :  effort. Furthermore, mathematics, primitives,
+--             :  timing standards, etc. are considered orthogonal
+--             :  issues as it relates to this package and are therefore
+--             :  beyond the scope of this effort.
+--             :
+--   Note      :  No declarations or definitions shall be included in,
+--             :  or excluded from this package. The "package declaration"
+--             :  defines the types, subtypes and declarations of
+--             :  std_logic_1164. The std_logic_1164 package body shall be
+--             :  considered the formal definition of the semantics of
+--             :  this package. Tool developers may choose to implement
+--             :  the package body in the most efficient manner available
+--             :  to them.
+--             :
+-- --------------------------------------------------------------------
+--   modification history :
+-- --------------------------------------------------------------------
+--  version | mod. date:|
+--   v4.200 | 01/02/92  |
+-- --------------------------------------------------------------------
+
+PACKAGE std_logic_1164 IS
+
+    -------------------------------------------------------------------
+    -- logic state system  (unresolved)
+    -------------------------------------------------------------------
+    TYPE std_ulogic IS ( 'U',  -- Uninitialized
+                         'X',  -- Forcing  Unknown
+                         '0',  -- Forcing  0
+                         '1',  -- Forcing  1
+                         'Z',  -- High Impedance
+                         'W',  -- Weak     Unknown
+                         'L',  -- Weak     0
+                         'H',  -- Weak     1
+                         '-'   -- Don't care
+                       );
+    -------------------------------------------------------------------
+    -- unconstrained array of std_ulogic for use with the resolution function
+    -------------------------------------------------------------------
+    TYPE std_ulogic_vector IS ARRAY ( NATURAL RANGE <> ) OF std_ulogic;
+
+    -------------------------------------------------------------------
+    -- resolution function
+    -------------------------------------------------------------------
+    FUNCTION resolved ( s : std_ulogic_vector ) RETURN std_ulogic;
+
+    -------------------------------------------------------------------
+    -- *** industry standard logic type ***
+    -------------------------------------------------------------------
+    SUBTYPE std_logic IS resolved std_ulogic;
+
+    -------------------------------------------------------------------
+    -- unconstrained array of std_logic for use in declaring signal arrays
+    -------------------------------------------------------------------
+    TYPE std_logic_vector IS ARRAY ( NATURAL RANGE <>) OF std_logic;
+
+    -------------------------------------------------------------------
+    -- common subtypes
+    -------------------------------------------------------------------
+    SUBTYPE X01     IS resolved std_ulogic RANGE 'X' TO '1'; -- ('X','0','1')
+    SUBTYPE X01Z    IS resolved std_ulogic RANGE 'X' TO 'Z'; -- ('X','0','1','Z')
+    SUBTYPE UX01    IS resolved std_ulogic RANGE 'U' TO '1'; -- ('U','X','0','1')
+    SUBTYPE UX01Z   IS resolved std_ulogic RANGE 'U' TO 'Z'; -- ('U','X','0','1','Z')
+
+    -------------------------------------------------------------------
+    -- overloaded logical operators
+    -------------------------------------------------------------------
+
+    FUNCTION "and"  ( l : std_ulogic; r : std_ulogic ) RETURN UX01;
+    FUNCTION "nand" ( l : std_ulogic; r : std_ulogic ) RETURN UX01;
+    FUNCTION "or"   ( l : std_ulogic; r : std_ulogic ) RETURN UX01;
+    FUNCTION "nor"  ( l : std_ulogic; r : std_ulogic ) RETURN UX01;
+    FUNCTION "xor"  ( l : std_ulogic; r : std_ulogic ) RETURN UX01;
+    FUNCTION "xnor" ( l : std_ulogic; r : std_ulogic ) RETURN UX01; --V93
+    FUNCTION "not"  ( l : std_ulogic                 ) RETURN UX01;
+
+    -------------------------------------------------------------------
+    -- vectorized overloaded logical operators
+    -------------------------------------------------------------------
+    FUNCTION "and"  ( l, r : std_logic_vector  ) RETURN std_logic_vector;
+    FUNCTION "and"  ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector;
+
+    FUNCTION "nand" ( l, r : std_logic_vector  ) RETURN std_logic_vector;
+    FUNCTION "nand" ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector;
+
+    FUNCTION "or"   ( l, r : std_logic_vector  ) RETURN std_logic_vector;
+    FUNCTION "or"   ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector;
+
+    FUNCTION "nor"  ( l, r : std_logic_vector  ) RETURN std_logic_vector;
+    FUNCTION "nor"  ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector;
+
+    FUNCTION "xor"  ( l, r : std_logic_vector  ) RETURN std_logic_vector;
+    FUNCTION "xor"  ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector;
+
+--  -----------------------------------------------------------------------
+--  Note : The declaration and implementation of the "xnor" function is
+--  specifically commented until at which time the VHDL language has been
+--  officially adopted as containing such a function. At such a point,
+--  the following comments may be removed along with this notice without
+--  further "official" ballotting of this std_logic_1164 package. It is
+--  the intent of this effort to provide such a function once it becomes
+--  available in the VHDL standard.
+--  -----------------------------------------------------------------------
+    FUNCTION "xnor" ( l, r : std_logic_vector  ) RETURN std_logic_vector; --V93
+    FUNCTION "xnor" ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector;--V93
+
+    FUNCTION "not"  ( l : std_logic_vector  ) RETURN std_logic_vector;
+    FUNCTION "not"  ( l : std_ulogic_vector ) RETURN std_ulogic_vector;
+
+    -------------------------------------------------------------------
+    -- conversion functions
+    -------------------------------------------------------------------
+    FUNCTION To_bit       ( s : std_ulogic;        xmap : BIT := '0') RETURN BIT;
+    FUNCTION To_bitvector ( s : std_logic_vector ; xmap : BIT := '0') RETURN BIT_VECTOR;
+    FUNCTION To_bitvector ( s : std_ulogic_vector; xmap : BIT := '0') RETURN BIT_VECTOR;
+
+    FUNCTION To_StdULogic       ( b : BIT               ) RETURN std_ulogic;
+    FUNCTION To_StdLogicVector  ( b : BIT_VECTOR        ) RETURN std_logic_vector;
+    FUNCTION To_StdLogicVector  ( s : std_ulogic_vector ) RETURN std_logic_vector;
+    FUNCTION To_StdULogicVector ( b : BIT_VECTOR        ) RETURN std_ulogic_vector;
+    FUNCTION To_StdULogicVector ( s : std_logic_vector  ) RETURN std_ulogic_vector;
+
+    -------------------------------------------------------------------
+    -- strength strippers and type convertors
+    -------------------------------------------------------------------
+
+    FUNCTION To_X01  ( s : std_logic_vector  ) RETURN  std_logic_vector;
+    FUNCTION To_X01  ( s : std_ulogic_vector ) RETURN  std_ulogic_vector;
+    FUNCTION To_X01  ( s : std_ulogic        ) RETURN  X01;
+    FUNCTION To_X01  ( b : BIT_VECTOR        ) RETURN  std_logic_vector;
+    FUNCTION To_X01  ( b : BIT_VECTOR        ) RETURN  std_ulogic_vector;
+    FUNCTION To_X01  ( b : BIT               ) RETURN  X01;
+
+    FUNCTION To_X01Z ( s : std_logic_vector  ) RETURN  std_logic_vector;
+    FUNCTION To_X01Z ( s : std_ulogic_vector ) RETURN  std_ulogic_vector;
+    FUNCTION To_X01Z ( s : std_ulogic        ) RETURN  X01Z;
+    FUNCTION To_X01Z ( b : BIT_VECTOR        ) RETURN  std_logic_vector;
+    FUNCTION To_X01Z ( b : BIT_VECTOR        ) RETURN  std_ulogic_vector;
+    FUNCTION To_X01Z ( b : BIT               ) RETURN  X01Z;
+
+    FUNCTION To_UX01  ( s : std_logic_vector  ) RETURN  std_logic_vector;
+    FUNCTION To_UX01  ( s : std_ulogic_vector ) RETURN  std_ulogic_vector;
+    FUNCTION To_UX01  ( s : std_ulogic        ) RETURN  UX01;
+    FUNCTION To_UX01  ( b : BIT_VECTOR        ) RETURN  std_logic_vector;
+    FUNCTION To_UX01  ( b : BIT_VECTOR        ) RETURN  std_ulogic_vector;
+    FUNCTION To_UX01  ( b : BIT               ) RETURN  UX01;
+
+    -------------------------------------------------------------------
+    -- edge detection
+    -------------------------------------------------------------------
+    FUNCTION rising_edge  (SIGNAL s : std_ulogic) RETURN BOOLEAN;
+    FUNCTION falling_edge (SIGNAL s : std_ulogic) RETURN BOOLEAN;
+
+    -------------------------------------------------------------------
+    -- object contains an unknown
+    -------------------------------------------------------------------
+    FUNCTION Is_X ( s : std_ulogic_vector ) RETURN  BOOLEAN;
+    FUNCTION Is_X ( s : std_logic_vector  ) RETURN  BOOLEAN;
+    FUNCTION Is_X ( s : std_ulogic        ) RETURN  BOOLEAN;
+
+END std_logic_1164;
diff --git a/libraries/ieee/std_logic_1164_body.vhdl b/libraries/ieee/std_logic_1164_body.vhdl
new file mode 100644
index 000000000..65c5965e0
--- /dev/null
+++ b/libraries/ieee/std_logic_1164_body.vhdl
@@ -0,0 +1,830 @@
+-- --------------------------------------------------------------------
+--
+--   Title     :  std_logic_1164 multi-value logic system
+--   Library   :  This package shall be compiled into a library
+--             :  symbolically named IEEE.
+--             :
+--   Developers:  IEEE model standards group (par 1164)
+--   Purpose   :  This packages defines a standard for designers
+--             :  to use in describing the interconnection data types
+--             :  used in vhdl modeling.
+--             :
+--   Limitation:  The logic system defined in this package may
+--             :  be insufficient for modeling switched transistors,
+--             :  since such a requirement is out of the scope of this
+--             :  effort. Furthermore, mathematics, primitives,
+--             :  timing standards, etc. are considered orthogonal
+--             :  issues as it relates to this package and are therefore
+--             :  beyond the scope of this effort.
+--             :
+--   Note      :  No declarations or definitions shall be included in,
+--             :  or excluded from this package. The "package declaration"
+--             :  defines the types, subtypes and declarations of
+--             :  std_logic_1164. The std_logic_1164 package body shall be
+--             :  considered the formal definition of the semantics of
+--             :  this package. Tool developers may choose to implement
+--             :  the package body in the most efficient manner available
+--             :  to them.
+--             :
+-- --------------------------------------------------------------------
+--   modification history :
+-- --------------------------------------------------------------------
+--  version | mod. date:|
+--   v4.200 | 01/02/91  |
+-- --------------------------------------------------------------------
+
+PACKAGE BODY std_logic_1164 IS
+    -------------------------------------------------------------------
+    -- local types
+    -------------------------------------------------------------------
+    TYPE stdlogic_1d IS ARRAY (std_ulogic) OF std_ulogic;
+    TYPE stdlogic_table IS ARRAY(std_ulogic, std_ulogic) OF std_ulogic;
+
+    -------------------------------------------------------------------
+    -- resolution function
+    -------------------------------------------------------------------
+    CONSTANT resolution_table : stdlogic_table := (
+    --      ---------------------------------------------------------
+    --      |  U    X    0    1    Z    W    L    H    -        |   |
+    --      ---------------------------------------------------------
+            ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ), -- | U |
+            ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | X |
+            ( 'U', 'X', '0', 'X', '0', '0', '0', '0', 'X' ), -- | 0 |
+            ( 'U', 'X', 'X', '1', '1', '1', '1', '1', 'X' ), -- | 1 |
+            ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', 'X' ), -- | Z |
+            ( 'U', 'X', '0', '1', 'W', 'W', 'W', 'W', 'X' ), -- | W |
+            ( 'U', 'X', '0', '1', 'L', 'W', 'L', 'W', 'X' ), -- | L |
+            ( 'U', 'X', '0', '1', 'H', 'W', 'W', 'H', 'X' ), -- | H |
+            ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' )  -- | - |
+        );
+
+    FUNCTION resolved ( s : std_ulogic_vector ) RETURN std_ulogic IS
+        VARIABLE result : std_ulogic := 'Z';  -- weakest state default
+    BEGIN
+        -- the test for a single driver is essential otherwise the
+        -- loop would return 'X' for a single driver of '-' and that
+        -- would conflict with the value of a single driver unresolved
+        -- signal.
+        IF    (s'LENGTH = 1) THEN    RETURN s(s'LOW);
+        ELSE
+            FOR i IN s'RANGE LOOP
+                result := resolution_table(result, s(i));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END resolved;
+
+    -------------------------------------------------------------------
+    -- tables for logical operations
+    -------------------------------------------------------------------
+
+    -- truth table for "and" function
+    CONSTANT and_table : stdlogic_table := (
+    --      ----------------------------------------------------
+    --      |  U    X    0    1    Z    W    L    H    -         |   |
+    --      ----------------------------------------------------
+            ( 'U', 'U', '0', 'U', 'U', 'U', '0', 'U', 'U' ),  -- | U |
+            ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ),  -- | X |
+            ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ),  -- | 0 |
+            ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | 1 |
+            ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ),  -- | Z |
+            ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ),  -- | W |
+            ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ),  -- | L |
+            ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | H |
+            ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' )   -- | - |
+    );
+
+    -- truth table for "or" function
+    CONSTANT or_table : stdlogic_table := (
+    --      ----------------------------------------------------
+    --      |  U    X    0    1    Z    W    L    H    -         |   |
+    --      ----------------------------------------------------
+            ( 'U', 'U', 'U', '1', 'U', 'U', 'U', '1', 'U' ),  -- | U |
+            ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ),  -- | X |
+            ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | 0 |
+            ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ),  -- | 1 |
+            ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ),  -- | Z |
+            ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ),  -- | W |
+            ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | L |
+            ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ),  -- | H |
+            ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' )   -- | - |
+    );
+
+    -- truth table for "xor" function
+    CONSTANT xor_table : stdlogic_table := (
+    --      ----------------------------------------------------
+    --      |  U    X    0    1    Z    W    L    H    -         |   |
+    --      ----------------------------------------------------
+            ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ),  -- | U |
+            ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | X |
+            ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | 0 |
+            ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ),  -- | 1 |
+            ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | Z |
+            ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | W |
+            ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | L |
+            ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ),  -- | H |
+            ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' )   -- | - |
+    );
+
+    -- truth table for "not" function
+    CONSTANT not_table: stdlogic_1d :=
+    --  -------------------------------------------------
+    --  |   U    X    0    1    Z    W    L    H    -   |
+    --  -------------------------------------------------
+         ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' );
+
+    -------------------------------------------------------------------
+    -- overloaded logical operators ( with optimizing hints )
+    -------------------------------------------------------------------
+
+    FUNCTION "and"  ( l : std_ulogic; r : std_ulogic ) RETURN UX01 IS
+    BEGIN
+        RETURN (and_table(l, r));
+    END "and";
+
+    FUNCTION "nand" ( l : std_ulogic; r : std_ulogic ) RETURN UX01 IS
+    BEGIN
+        RETURN  (not_table ( and_table(l, r)));
+    END "nand";
+
+    FUNCTION "or"   ( l : std_ulogic; r : std_ulogic ) RETURN UX01 IS
+    BEGIN
+        RETURN (or_table(l, r));
+    END "or";
+
+    FUNCTION "nor"  ( l : std_ulogic; r : std_ulogic ) RETURN UX01 IS
+    BEGIN
+        RETURN  (not_table ( or_table( l, r )));
+    END "nor";
+
+    FUNCTION "xor"  ( l : std_ulogic; r : std_ulogic ) RETURN UX01 IS
+    BEGIN
+        RETURN (xor_table(l, r));
+    END "xor";
+
+--START-V93
+    FUNCTION "xnor"  ( l : std_ulogic; r : std_ulogic ) RETURN UX01 IS
+    BEGIN
+        RETURN not_table(xor_table(l, r));
+    END "xnor";
+--END-V93
+
+    FUNCTION "not"  ( l : std_ulogic ) RETURN UX01 IS
+    BEGIN
+        RETURN (not_table(l));
+    END "not";
+
+    -------------------------------------------------------------------
+    -- and
+    -------------------------------------------------------------------
+    FUNCTION "and"  ( l,r : std_logic_vector ) RETURN std_logic_vector IS
+        ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_logic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'and' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := and_table (lv(i), rv(i));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "and";
+    ---------------------------------------------------------------------
+    FUNCTION "and"  ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS
+        ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'and' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := and_table (lv(i), rv(i));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "and";
+    -------------------------------------------------------------------
+    -- nand
+    -------------------------------------------------------------------
+    FUNCTION "nand"  ( l,r : std_logic_vector ) RETURN std_logic_vector IS
+        ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_logic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'nand' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := not_table(and_table (lv(i), rv(i)));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "nand";
+    ---------------------------------------------------------------------
+    FUNCTION "nand"  ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS
+        ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'nand' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := not_table(and_table (lv(i), rv(i)));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "nand";
+    -------------------------------------------------------------------
+    -- or
+    -------------------------------------------------------------------
+    FUNCTION "or"  ( l,r : std_logic_vector ) RETURN std_logic_vector IS
+        ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_logic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'or' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := or_table (lv(i), rv(i));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "or";
+    ---------------------------------------------------------------------
+    FUNCTION "or"  ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS
+        ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'or' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := or_table (lv(i), rv(i));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "or";
+    -------------------------------------------------------------------
+    -- nor
+    -------------------------------------------------------------------
+    FUNCTION "nor"  ( l,r : std_logic_vector ) RETURN std_logic_vector IS
+        ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_logic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'nor' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := not_table(or_table (lv(i), rv(i)));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "nor";
+    ---------------------------------------------------------------------
+    FUNCTION "nor"  ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS
+        ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'nor' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := not_table(or_table (lv(i), rv(i)));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "nor";
+    ---------------------------------------------------------------------
+    -- xor
+    -------------------------------------------------------------------
+    FUNCTION "xor"  ( l,r : std_logic_vector ) RETURN std_logic_vector IS
+        ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_logic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'xor' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := xor_table (lv(i), rv(i));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "xor";
+    ---------------------------------------------------------------------
+    FUNCTION "xor"  ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS
+        ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'xor' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := xor_table (lv(i), rv(i));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "xor";
+--    -------------------------------------------------------------------
+--    -- xnor
+--    -------------------------------------------------------------------
+--  -----------------------------------------------------------------------
+--  Note : The declaration and implementation of the "xnor" function is
+--  specifically commented until at which time the VHDL language has been
+--  officially adopted as containing such a function. At such a point,
+--  the following comments may be removed along with this notice without
+--  further "official" ballotting of this std_logic_1164 package. It is
+--  the intent of this effort to provide such a function once it becomes
+--  available in the VHDL standard.
+--  -----------------------------------------------------------------------
+--START-V93
+    FUNCTION "xnor"  ( l,r : std_logic_vector ) RETURN std_logic_vector IS
+        ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_logic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'xnor' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := not_table(xor_table (lv(i), rv(i)));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "xnor";
+    ---------------------------------------------------------------------
+    FUNCTION "xnor"  ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS
+        ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l;
+        ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r;
+        VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH );
+    BEGIN
+        IF ( l'LENGTH /= r'LENGTH ) THEN
+            ASSERT FALSE
+            REPORT "arguments of overloaded 'xnor' operator are not of the same length"
+            SEVERITY FAILURE;
+        ELSE
+            FOR i IN result'RANGE LOOP
+                result(i) := not_table(xor_table (lv(i), rv(i)));
+            END LOOP;
+        END IF;
+        RETURN result;
+    END "xnor";
+--END-V93
+    -------------------------------------------------------------------
+    -- not
+    -------------------------------------------------------------------
+    FUNCTION "not"  ( l : std_logic_vector ) RETURN std_logic_vector IS
+        ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l;
+        VARIABLE result : std_logic_vector ( 1 TO l'LENGTH ) := (OTHERS => 'X');
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := not_table( lv(i) );
+        END LOOP;
+        RETURN result;
+    END;
+    ---------------------------------------------------------------------
+    FUNCTION "not"  ( l : std_ulogic_vector ) RETURN std_ulogic_vector IS
+        ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l;
+        VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH ) := (OTHERS => 'X');
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := not_table( lv(i) );
+        END LOOP;
+        RETURN result;
+    END;
+    -------------------------------------------------------------------
+    -- conversion tables
+    -------------------------------------------------------------------
+    TYPE logic_x01_table IS ARRAY (std_ulogic'LOW TO std_ulogic'HIGH) OF X01;
+    TYPE logic_x01z_table IS ARRAY (std_ulogic'LOW TO std_ulogic'HIGH) OF X01Z;
+    TYPE logic_ux01_table IS ARRAY (std_ulogic'LOW TO std_ulogic'HIGH) OF UX01;
+    ----------------------------------------------------------
+    -- table name : cvt_to_x01
+    --
+    -- parameters :
+    --        in  :  std_ulogic  -- some logic value
+    -- returns    :  x01         -- state value of logic value
+    -- purpose    :  to convert state-strength to state only
+    --
+    -- example    : if (cvt_to_x01 (input_signal) = '1' ) then ...
+    --
+    ----------------------------------------------------------
+    CONSTANT cvt_to_x01 : logic_x01_table := (
+                         'X',  -- 'U'
+                         'X',  -- 'X'
+                         '0',  -- '0'
+                         '1',  -- '1'
+                         'X',  -- 'Z'
+                         'X',  -- 'W'
+                         '0',  -- 'L'
+                         '1',  -- 'H'
+                         'X'   -- '-'
+                        );
+
+    ----------------------------------------------------------
+    -- table name : cvt_to_x01z
+    --
+    -- parameters :
+    --        in  :  std_ulogic  -- some logic value
+    -- returns    :  x01z        -- state value of logic value
+    -- purpose    :  to convert state-strength to state only
+    --
+    -- example    : if (cvt_to_x01z (input_signal) = '1' ) then ...
+    --
+    ----------------------------------------------------------
+    CONSTANT cvt_to_x01z : logic_x01z_table := (
+                         'X',  -- 'U'
+                         'X',  -- 'X'
+                         '0',  -- '0'
+                         '1',  -- '1'
+                         'Z',  -- 'Z'
+                         'X',  -- 'W'
+                         '0',  -- 'L'
+                         '1',  -- 'H'
+                         'X'   -- '-'
+                        );
+
+    ----------------------------------------------------------
+    -- table name : cvt_to_ux01
+    --
+    -- parameters :
+    --        in  :  std_ulogic  -- some logic value
+    -- returns    :  ux01        -- state value of logic value
+    -- purpose    :  to convert state-strength to state only
+    --
+    -- example    : if (cvt_to_ux01 (input_signal) = '1' ) then ...
+    --
+    ----------------------------------------------------------
+    CONSTANT cvt_to_ux01 : logic_ux01_table := (
+                         'U',  -- 'U'
+                         'X',  -- 'X'
+                         '0',  -- '0'
+                         '1',  -- '1'
+                         'X',  -- 'Z'
+                         'X',  -- 'W'
+                         '0',  -- 'L'
+                         '1',  -- 'H'
+                         'X'   -- '-'
+                        );
+
+    -------------------------------------------------------------------
+    -- conversion functions
+    -------------------------------------------------------------------
+    FUNCTION To_bit ( s : std_ulogic; xmap : BIT := '0') RETURN BIT IS
+    BEGIN
+            CASE s IS
+                WHEN '0' | 'L' => RETURN ('0');
+                WHEN '1' | 'H' => RETURN ('1');
+                WHEN OTHERS => RETURN xmap;
+            END CASE;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_bitvector ( s : std_logic_vector ; xmap : BIT := '0') RETURN BIT_VECTOR IS
+        ALIAS sv : std_logic_vector ( s'LENGTH-1 DOWNTO 0 ) IS s;
+        VARIABLE result : BIT_VECTOR ( s'LENGTH-1 DOWNTO 0 );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE sv(i) IS
+                WHEN '0' | 'L' => result(i) := '0';
+                WHEN '1' | 'H' => result(i) := '1';
+                WHEN OTHERS => result(i) := xmap;
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_bitvector ( s : std_ulogic_vector; xmap : BIT := '0') RETURN BIT_VECTOR IS
+        ALIAS sv : std_ulogic_vector ( s'LENGTH-1 DOWNTO 0 ) IS s;
+        VARIABLE result : BIT_VECTOR ( s'LENGTH-1 DOWNTO 0 );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE sv(i) IS
+                WHEN '0' | 'L' => result(i) := '0';
+                WHEN '1' | 'H' => result(i) := '1';
+                WHEN OTHERS => result(i) := xmap;
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_StdULogic       ( b : BIT               ) RETURN std_ulogic IS
+    BEGIN
+        CASE b IS
+            WHEN '0' => RETURN '0';
+            WHEN '1' => RETURN '1';
+        END CASE;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_StdLogicVector  ( b : BIT_VECTOR        ) RETURN std_logic_vector IS
+        ALIAS bv : BIT_VECTOR ( b'LENGTH-1 DOWNTO 0 ) IS b;
+        VARIABLE result : std_logic_vector ( b'LENGTH-1 DOWNTO 0 );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE bv(i) IS
+                WHEN '0' => result(i) := '0';
+                WHEN '1' => result(i) := '1';
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_StdLogicVector  ( s : std_ulogic_vector ) RETURN std_logic_vector IS
+        ALIAS sv : std_ulogic_vector ( s'LENGTH-1 DOWNTO 0 ) IS s;
+        VARIABLE result : std_logic_vector ( s'LENGTH-1 DOWNTO 0 );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := sv(i);
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_StdULogicVector ( b : BIT_VECTOR        ) RETURN std_ulogic_vector IS
+        ALIAS bv : BIT_VECTOR ( b'LENGTH-1 DOWNTO 0 ) IS b;
+        VARIABLE result : std_ulogic_vector ( b'LENGTH-1 DOWNTO 0 );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE bv(i) IS
+                WHEN '0' => result(i) := '0';
+                WHEN '1' => result(i) := '1';
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_StdULogicVector ( s : std_logic_vector ) RETURN std_ulogic_vector IS
+        ALIAS sv : std_logic_vector ( s'LENGTH-1 DOWNTO 0 ) IS s;
+        VARIABLE result : std_ulogic_vector ( s'LENGTH-1 DOWNTO 0 );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := sv(i);
+        END LOOP;
+        RETURN result;
+    END;
+
+    -------------------------------------------------------------------
+    -- strength strippers and type convertors
+    -------------------------------------------------------------------
+    -- to_x01
+    -------------------------------------------------------------------
+    FUNCTION To_X01  ( s : std_logic_vector ) RETURN  std_logic_vector IS
+        ALIAS sv : std_logic_vector ( 1 TO s'LENGTH ) IS s;
+        VARIABLE result : std_logic_vector ( 1 TO s'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := cvt_to_x01 (sv(i));
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01  ( s : std_ulogic_vector ) RETURN  std_ulogic_vector IS
+        ALIAS sv : std_ulogic_vector ( 1 TO s'LENGTH ) IS s;
+        VARIABLE result : std_ulogic_vector ( 1 TO s'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := cvt_to_x01 (sv(i));
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01  ( s : std_ulogic ) RETURN  X01 IS
+    BEGIN
+        RETURN (cvt_to_x01(s));
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01  ( b : BIT_VECTOR ) RETURN  std_logic_vector IS
+        ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b;
+        VARIABLE result : std_logic_vector ( 1 TO b'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE bv(i) IS
+                WHEN '0' => result(i) := '0';
+                WHEN '1' => result(i) := '1';
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01  ( b : BIT_VECTOR ) RETURN  std_ulogic_vector IS
+        ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b;
+        VARIABLE result : std_ulogic_vector ( 1 TO b'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE bv(i) IS
+                WHEN '0' => result(i) := '0';
+                WHEN '1' => result(i) := '1';
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01  ( b : BIT ) RETURN  X01 IS
+    BEGIN
+            CASE b IS
+                WHEN '0' => RETURN('0');
+                WHEN '1' => RETURN('1');
+            END CASE;
+    END;
+    --------------------------------------------------------------------
+    -- to_x01z
+    -------------------------------------------------------------------
+    FUNCTION To_X01Z  ( s : std_logic_vector ) RETURN  std_logic_vector IS
+        ALIAS sv : std_logic_vector ( 1 TO s'LENGTH ) IS s;
+        VARIABLE result : std_logic_vector ( 1 TO s'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := cvt_to_x01z (sv(i));
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01Z  ( s : std_ulogic_vector ) RETURN  std_ulogic_vector IS
+        ALIAS sv : std_ulogic_vector ( 1 TO s'LENGTH ) IS s;
+        VARIABLE result : std_ulogic_vector ( 1 TO s'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := cvt_to_x01z (sv(i));
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01Z  ( s : std_ulogic ) RETURN  X01Z IS
+    BEGIN
+        RETURN (cvt_to_x01z(s));
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01Z  ( b : BIT_VECTOR ) RETURN  std_logic_vector IS
+        ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b;
+        VARIABLE result : std_logic_vector ( 1 TO b'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE bv(i) IS
+                WHEN '0' => result(i) := '0';
+                WHEN '1' => result(i) := '1';
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01Z  ( b : BIT_VECTOR ) RETURN  std_ulogic_vector IS
+        ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b;
+        VARIABLE result : std_ulogic_vector ( 1 TO b'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE bv(i) IS
+                WHEN '0' => result(i) := '0';
+                WHEN '1' => result(i) := '1';
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_X01Z  ( b : BIT ) RETURN  X01Z IS
+    BEGIN
+            CASE b IS
+                WHEN '0' => RETURN('0');
+                WHEN '1' => RETURN('1');
+            END CASE;
+    END;
+    --------------------------------------------------------------------
+    -- to_ux01
+    -------------------------------------------------------------------
+    FUNCTION To_UX01  ( s : std_logic_vector ) RETURN  std_logic_vector IS
+        ALIAS sv : std_logic_vector ( 1 TO s'LENGTH ) IS s;
+        VARIABLE result : std_logic_vector ( 1 TO s'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := cvt_to_ux01 (sv(i));
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_UX01  ( s : std_ulogic_vector ) RETURN  std_ulogic_vector IS
+        ALIAS sv : std_ulogic_vector ( 1 TO s'LENGTH ) IS s;
+        VARIABLE result : std_ulogic_vector ( 1 TO s'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            result(i) := cvt_to_ux01 (sv(i));
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_UX01  ( s : std_ulogic ) RETURN  UX01 IS
+    BEGIN
+        RETURN (cvt_to_ux01(s));
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_UX01  ( b : BIT_VECTOR ) RETURN  std_logic_vector IS
+        ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b;
+        VARIABLE result : std_logic_vector ( 1 TO b'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE bv(i) IS
+                WHEN '0' => result(i) := '0';
+                WHEN '1' => result(i) := '1';
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_UX01  ( b : BIT_VECTOR ) RETURN  std_ulogic_vector IS
+        ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b;
+        VARIABLE result : std_ulogic_vector ( 1 TO b'LENGTH );
+    BEGIN
+        FOR i IN result'RANGE LOOP
+            CASE bv(i) IS
+                WHEN '0' => result(i) := '0';
+                WHEN '1' => result(i) := '1';
+            END CASE;
+        END LOOP;
+        RETURN result;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION To_UX01  ( b : BIT ) RETURN  UX01 IS
+    BEGIN
+            CASE b IS
+                WHEN '0' => RETURN('0');
+                WHEN '1' => RETURN('1');
+            END CASE;
+    END;
+
+    -------------------------------------------------------------------
+    -- edge detection
+    -------------------------------------------------------------------
+    FUNCTION rising_edge  (SIGNAL s : std_ulogic) RETURN BOOLEAN IS
+    BEGIN
+        RETURN (s'EVENT AND (To_X01(s) = '1') AND
+                            (To_X01(s'LAST_VALUE) = '0'));
+    END;
+
+    FUNCTION falling_edge (SIGNAL s : std_ulogic) RETURN BOOLEAN IS
+    BEGIN
+        RETURN (s'EVENT AND (To_X01(s) = '0') AND
+                            (To_X01(s'LAST_VALUE) = '1'));
+    END;
+
+    -------------------------------------------------------------------
+    -- object contains an unknown
+    -------------------------------------------------------------------
+    FUNCTION Is_X ( s : std_ulogic_vector ) RETURN  BOOLEAN IS
+    BEGIN
+        FOR i IN s'RANGE LOOP
+            CASE s(i) IS
+                WHEN 'U' | 'X' | 'Z' | 'W' | '-' => RETURN TRUE;
+                WHEN OTHERS => NULL;
+            END CASE;
+        END LOOP;
+        RETURN FALSE;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION Is_X ( s : std_logic_vector  ) RETURN  BOOLEAN IS
+    BEGIN
+        FOR i IN s'RANGE LOOP
+            CASE s(i) IS
+                WHEN 'U' | 'X' | 'Z' | 'W' | '-' => RETURN TRUE;
+                WHEN OTHERS => NULL;
+            END CASE;
+        END LOOP;
+        RETURN FALSE;
+    END;
+    --------------------------------------------------------------------
+    FUNCTION Is_X ( s : std_ulogic        ) RETURN  BOOLEAN IS
+    BEGIN
+        CASE s IS
+            WHEN 'U' | 'X' | 'Z' | 'W' | '-' => RETURN TRUE;
+            WHEN OTHERS => NULL;
+        END CASE;
+        RETURN FALSE;
+    END;
+
+END std_logic_1164;
diff --git a/libraries/mentor/std_logic_arith.vhdl b/libraries/mentor/std_logic_arith.vhdl
new file mode 100644
index 000000000..7bbd1d80b
--- /dev/null
+++ b/libraries/mentor/std_logic_arith.vhdl
@@ -0,0 +1,254 @@
+----------------------------------------------------------------------------
+--                                                                        --
+--                   Copyright (c) 1993 by Mentor Graphics                --
+--                                                                        --
+--  This source file is proprietary information of Mentor Graphics,Inc.   --
+--  It may be distributed in whole without restriction provided that      --   
+--  this copyright statement is not removed from the file and that        --   
+--  any derivative work contains this copyright notice.                   --
+--                                                                        --
+--  Package Name : std_logic_arith                                        --
+--                                                                        --
+--  Purpose : This package is to allow the synthesis of the 1164 package. --
+--            This package add the capability of SIGNED/UNSIGNED math.    --
+--                                                                        --
+----------------------------------------------------------------------------
+
+LIBRARY ieee ;
+
+PACKAGE std_logic_arith IS
+   
+
+   USE ieee.std_logic_1164.ALL;
+
+   TYPE SIGNED   IS ARRAY (Natural RANGE <>) OF STD_LOGIC ;
+   TYPE UNSIGNED IS ARRAY (Natural RANGE <>) OF STD_LOGIC ;
+
+   FUNCTION std_ulogic_wired_or ( input : std_ulogic_vector ) RETURN std_ulogic;
+   FUNCTION std_ulogic_wired_and ( input : std_ulogic_vector ) RETURN std_ulogic;
+
+   -------------------------------------------------------------------------------
+   -- Note that all functions that take two vector arguments will
+   -- handle unequal argument lengths
+   -------------------------------------------------------------------------------
+
+   -------------------------------------------------------------------    
+   -- Conversion Functions 
+   -------------------------------------------------------------------    
+     
+   --  Except for the to_integer and conv_integer functions for the
+   --  signed argument all others assume the input vector to be of
+   --  magnitude representation. The signed functions assume
+   --  a 2's complement representation.
+   FUNCTION to_integer ( arg1 : STD_ULOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER;
+   FUNCTION to_integer ( arg1 : STD_LOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER;
+   FUNCTION to_integer ( arg1 : STD_LOGIC; x : INTEGER := 0 ) RETURN NATURAL;
+   FUNCTION to_integer ( arg1 : UNSIGNED; x : INTEGER := 0 ) RETURN NATURAL;
+   FUNCTION to_integer ( arg1 : SIGNED; x : INTEGER := 0 ) RETURN INTEGER;
+
+   FUNCTION conv_integer ( arg1 : STD_ULOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER;
+   FUNCTION conv_integer ( arg1 : STD_LOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER;
+   FUNCTION conv_integer ( arg1 : STD_LOGIC; x : INTEGER := 0 ) RETURN NATURAL;
+   FUNCTION conv_integer ( arg1 : UNSIGNED; x : INTEGER := 0 ) RETURN NATURAL;
+   FUNCTION conv_integer ( arg1 : SIGNED; x : INTEGER := 0 ) RETURN INTEGER;
+
+   --  Following functions will return the natural argument in magnitude representation.
+   FUNCTION to_stdlogic ( arg1 : BOOLEAN ) RETURN STD_LOGIC;
+   FUNCTION to_stdlogicvector ( arg1 : INTEGER; size : NATURAL ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION to_stdulogicvector ( arg1 : INTEGER; size : NATURAL ) RETURN STD_ULOGIC_VECTOR;
+
+   FUNCTION to_unsigned ( arg1 : NATURAL; size : NATURAL ) RETURN UNSIGNED;
+   FUNCTION conv_unsigned ( arg1 : NATURAL; size : NATURAL ) RETURN UNSIGNED;
+
+   --  The integer argument is returned in 2's complement representation.
+   FUNCTION to_signed ( arg1 : INTEGER; size : NATURAL ) RETURN SIGNED;
+   FUNCTION conv_signed ( arg1 : INTEGER; size : NATURAL ) RETURN SIGNED;
+
+     
+   -------------------------------------------------------------------------------
+   -- sign/zero extend FUNCTIONs
+   -------------------------------------------------------------------------------
+
+   --  The zero_extend functions will perform zero padding to the input vector,
+   --   returning a vector of length equal to size (the second argument). Note that
+   --   if size is less than the length of the input argument an assertion will occur.
+   FUNCTION zero_extend ( arg1 : STD_ULOGIC_VECTOR; size : NATURAL ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION zero_extend ( arg1 : STD_LOGIC_VECTOR; size : NATURAL ) RETURN STD_LOGIC_VECTOR;
+  FUNCTION zero_extend ( arg1 : STD_LOGIC; size : NATURAL ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION zero_extend ( arg1 : UNSIGNED; size : NATURAL ) RETURN UNSIGNED;
+   FUNCTION sign_extend ( arg1 : SIGNED; size : NATURAL ) RETURN SIGNED;
+
+     
+   -------------------------------------------------------------------------------
+   --  Arithmetic functions
+   -------------------------------------------------------------------------------
+     
+   --  All arithmetic functions except multiplication will return a vector
+   --     of size equal to the size of its largest argument. For multiplication,
+   --   the resulting vector has a size equal to the sum of the size of its inputs.
+   --   Note that arguments of unequal lengths are allowed.
+   FUNCTION "+" ( arg1, arg2 : STD_LOGIC ) RETURN STD_LOGIC;
+   FUNCTION "+" ( arg1, arg2 : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "+" ( arg1, arg2 : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION "+" ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED ;
+   FUNCTION "+" ( arg1, arg2 : SIGNED ) RETURN SIGNED ;
+
+   FUNCTION "-" ( arg1, arg2 : STD_LOGIC ) RETURN STD_LOGIC;
+   FUNCTION "-" ( arg1, arg2 : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "-" ( arg1, arg2 : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION "-" ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED;
+   FUNCTION "-" ( arg1, arg2 : SIGNED ) RETURN SIGNED;
+     
+   FUNCTION "+" ( arg1 : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "+" ( arg1 : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION "+" ( arg1 : UNSIGNED ) RETURN UNSIGNED;
+   FUNCTION "+" ( arg1 : SIGNED ) RETURN SIGNED;
+   FUNCTION "-" ( arg1 : SIGNED ) RETURN SIGNED;
+   
+   FUNCTION "*" ( arg1, arg2 : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "*" ( arg1, arg2 : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION "*" ( arg1, arg2 : UNSIGNED )         RETURN UNSIGNED ;
+   FUNCTION "*" ( arg1, arg2 : SIGNED )           RETURN SIGNED ;
+
+   FUNCTION "abs" ( arg1 : SIGNED) RETURN SIGNED;
+
+   -- Vectorized Overloaded Arithmetic Operators, not supported for synthesis.
+   -- The following operators are not supported for synthesis.
+   FUNCTION "/"   ( l, r : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "/"   ( l, r : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION "/"   ( l, r : UNSIGNED ) RETURN UNSIGNED;
+   FUNCTION "/"   ( l, r : SIGNED ) RETURN SIGNED;
+   FUNCTION "MOD"   ( l, r : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "MOD"   ( l, r : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION "MOD"   ( l, r : UNSIGNED ) RETURN UNSIGNED;
+   FUNCTION "REM"   ( l, r : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "REM"   ( l, r : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION "REM"   ( l, r : UNSIGNED ) RETURN UNSIGNED;
+   FUNCTION "**"   ( l, r : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "**"   ( l, r : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR;
+   FUNCTION "**"   ( l, r : UNSIGNED ) RETURN UNSIGNED;
+
+     
+   -------------------------------------------------------------------------------
+   --  Shift and rotate functions.
+   -------------------------------------------------------------------------------
+
+   --   Note that all the shift and rotate functions below will change to overloaded
+   --   operators in the train1 release.
+   FUNCTION "sla" (arg1:UNSIGNED          ; arg2:NATURAL)  RETURN UNSIGNED ;
+   FUNCTION "sla" (arg1:SIGNED            ; arg2:NATURAL)  RETURN SIGNED ;
+   FUNCTION "sla" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR ;
+   FUNCTION "sla" (arg1:STD_LOGIC_VECTOR  ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR ;
+
+   FUNCTION "sra" (arg1:UNSIGNED          ; arg2:NATURAL)  RETURN UNSIGNED ;
+   FUNCTION "sra" (arg1:SIGNED            ; arg2:NATURAL)  RETURN SIGNED ;
+   FUNCTION "sra" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR ;
+   FUNCTION "sra" (arg1:STD_LOGIC_VECTOR  ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR ;
+   
+   FUNCTION "sll" (arg1:UNSIGNED          ; arg2:NATURAL)  RETURN UNSIGNED ;
+   FUNCTION "sll" (arg1:SIGNED            ; arg2:NATURAL)  RETURN SIGNED ;
+   FUNCTION "sll" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR ;
+   FUNCTION "sll" (arg1:STD_LOGIC_VECTOR  ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR ;
+
+   FUNCTION "srl" (arg1:UNSIGNED          ; arg2:NATURAL)  RETURN UNSIGNED ;
+   FUNCTION "srl" (arg1:SIGNED            ; arg2:NATURAL)  RETURN SIGNED ;
+   FUNCTION "srl" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR ;
+   FUNCTION "srl" (arg1:STD_LOGIC_VECTOR  ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR ;
+
+   FUNCTION "rol" (arg1:UNSIGNED          ; arg2:NATURAL)  RETURN UNSIGNED ;
+   FUNCTION "rol" (arg1:SIGNED            ; arg2:NATURAL)  RETURN SIGNED ;
+   FUNCTION "rol" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR ; 
+   FUNCTION "rol" (arg1:STD_LOGIC_VECTOR  ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR ; 
+
+   FUNCTION "ror" (arg1:UNSIGNED          ; arg2:NATURAL)  RETURN UNSIGNED ;
+   FUNCTION "ror" (arg1:SIGNED            ; arg2:NATURAL)  RETURN SIGNED ;
+   FUNCTION "ror" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR ; 
+   FUNCTION "ror" (arg1:STD_LOGIC_VECTOR  ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR ; 
+
+     
+   -------------------------------------------------------------------------------
+   --  Comparision functions and operators.
+   -------------------------------------------------------------------------------
+
+   --  For all comparision operators, the default operator for signed and unsigned
+   --   types has been overloaded to perform logical comparisions. Note that for
+   --   other types the default operator is not overloaded and the use will result
+   --   in literal comparisions which is not supported for synthesis.
+   --
+   --  Unequal operator widths are supported for all the comparision functions.
+   FUNCTION eq ( l, r : STD_LOGIC )         RETURN BOOLEAN;
+   FUNCTION eq ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN;
+   FUNCTION eq ( l, r : STD_LOGIC_VECTOR )  RETURN BOOLEAN;
+   FUNCTION eq ( l, r : UNSIGNED )          RETURN BOOLEAN ;
+   FUNCTION eq ( l, r : SIGNED )            RETURN BOOLEAN ;
+   FUNCTION "=" ( l, r : UNSIGNED )         RETURN BOOLEAN ;
+   FUNCTION "=" ( l, r : SIGNED )           RETURN BOOLEAN ;
+
+   FUNCTION ne ( l, r : STD_LOGIC )         RETURN BOOLEAN;
+   FUNCTION ne ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN;
+   FUNCTION ne ( l, r : STD_LOGIC_VECTOR )  RETURN BOOLEAN;
+   FUNCTION ne ( l, r : UNSIGNED )          RETURN BOOLEAN ;
+   FUNCTION ne ( l, r : SIGNED )            RETURN BOOLEAN ;
+   FUNCTION "/=" ( l, r : UNSIGNED )         RETURN BOOLEAN ;
+   FUNCTION "/=" ( l, r : SIGNED )           RETURN BOOLEAN ;
+
+   FUNCTION lt ( l, r : STD_LOGIC )         RETURN BOOLEAN;
+   FUNCTION lt ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN;
+   FUNCTION lt ( l, r : STD_LOGIC_VECTOR )  RETURN BOOLEAN;
+   FUNCTION lt ( l, r : UNSIGNED )          RETURN BOOLEAN ;
+   FUNCTION lt ( l, r : SIGNED )            RETURN BOOLEAN ;
+   FUNCTION "<" ( l, r : UNSIGNED )         RETURN BOOLEAN ;
+   FUNCTION "<" ( l, r : SIGNED )           RETURN BOOLEAN ;
+
+   FUNCTION gt ( l, r : STD_LOGIC )         RETURN BOOLEAN;
+   FUNCTION gt ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN;
+   FUNCTION gt ( l, r : STD_LOGIC_VECTOR )  RETURN BOOLEAN;
+   FUNCTION gt ( l, r : UNSIGNED )          RETURN BOOLEAN ;
+   FUNCTION gt ( l, r : SIGNED )            RETURN BOOLEAN ;
+   FUNCTION ">" ( l, r : UNSIGNED )         RETURN BOOLEAN ;
+   FUNCTION ">" ( l, r : SIGNED )           RETURN BOOLEAN ;
+
+   FUNCTION le ( l, r : STD_LOGIC )         RETURN BOOLEAN;
+   FUNCTION le ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN;
+   FUNCTION le ( l, r : STD_LOGIC_VECTOR )  RETURN BOOLEAN;
+   FUNCTION le ( l, r : UNSIGNED )          RETURN BOOLEAN ;
+   FUNCTION le ( l, r : SIGNED )            RETURN BOOLEAN ;
+   FUNCTION "<=" ( l, r : UNSIGNED )         RETURN BOOLEAN ;
+   FUNCTION "<=" ( l, r : SIGNED )           RETURN BOOLEAN ;
+
+   FUNCTION ge ( l, r : STD_LOGIC )         RETURN BOOLEAN;
+   FUNCTION ge ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN;
+   FUNCTION ge ( l, r : STD_LOGIC_VECTOR )  RETURN BOOLEAN;
+   FUNCTION ge ( l, r : UNSIGNED )          RETURN BOOLEAN ;
+   FUNCTION ge ( l, r : SIGNED )            RETURN BOOLEAN ;
+   FUNCTION ">=" ( l, r : UNSIGNED )         RETURN BOOLEAN ;
+   FUNCTION ">=" ( l, r : SIGNED )           RETURN BOOLEAN ;
+
+   -------------------------------------------------------------------------------
+   --  Logical operators.
+   -------------------------------------------------------------------------------
+
+   --   allows operands of unequal lengths, return vector is
+   --   equal to the size of the largest argument.
+
+   FUNCTION "and"  (arg1, arg2:SIGNED)   RETURN SIGNED;
+   FUNCTION "and"  (arg1, arg2:UNSIGNED) RETURN UNSIGNED;
+   FUNCTION "nand" (arg1, arg2:SIGNED)   RETURN SIGNED;
+   FUNCTION "nand" (arg1, arg2:UNSIGNED) RETURN UNSIGNED;
+   FUNCTION "or"   (arg1, arg2:SIGNED)   RETURN SIGNED;
+   FUNCTION "or"   (arg1, arg2:UNSIGNED) RETURN UNSIGNED;
+   FUNCTION "nor"  (arg1, arg2:SIGNED)   RETURN SIGNED;
+   FUNCTION "nor"  (arg1, arg2:UNSIGNED) RETURN UNSIGNED;
+   FUNCTION "xor"  (arg1, arg2:SIGNED)   RETURN SIGNED;
+   FUNCTION "xor"  (arg1, arg2:UNSIGNED) RETURN UNSIGNED;
+   FUNCTION "not"  (arg1:SIGNED)         RETURN SIGNED;
+   FUNCTION "not"  (arg1:UNSIGNED)       RETURN UNSIGNED;
+
+   FUNCTION "xnor"  (arg1, arg2:STD_ULOGIC_VECTOR)  RETURN STD_ULOGIC_VECTOR;
+   FUNCTION "xnor"  (arg1, arg2:STD_LOGIC_VECTOR)   RETURN STD_LOGIC_VECTOR;
+   FUNCTION "xnor"  (arg1, arg2:SIGNED)   RETURN SIGNED;
+   FUNCTION "xnor"  (arg1, arg2:UNSIGNED) RETURN UNSIGNED;
+     
+END std_logic_arith ;
+
+
diff --git a/libraries/mentor/std_logic_arith_body.vhdl b/libraries/mentor/std_logic_arith_body.vhdl
new file mode 100644
index 000000000..36f76cb7d
--- /dev/null
+++ b/libraries/mentor/std_logic_arith_body.vhdl
@@ -0,0 +1,2915 @@
+LIBRARY ieee;
+-- LIBRARY arithmetic;
+
+PACKAGE BODY std_logic_arith IS
+
+    USE ieee.std_logic_1164.ALL;
+   -- USE arithmetic.utils.all; 
+    
+    -------------------------------------------------------------------    
+    -- Local Types
+    -------------------------------------------------------------------    
+    TYPE stdlogic_1d IS ARRAY (std_ulogic) OF std_ulogic;
+    TYPE stdlogic_table IS ARRAY(std_ulogic, std_ulogic) OF std_ulogic;
+    TYPE stdlogic_boolean_table IS ARRAY(std_ulogic, std_ulogic) OF BOOLEAN;
+
+    --------------------------------------------------------------------
+    --------------------------------------------------------------------
+    -- FUNCTIONS DEFINED FOR SYNTHESIS
+    --------------------------------------------------------------------
+    --------------------------------------------------------------------
+
+    FUNCTION std_ulogic_wired_or ( input : std_ulogic_vector ) RETURN std_ulogic IS
+        VARIABLE result : std_ulogic := '-';  -- weakest state default
+        CONSTANT resolution_table : stdlogic_table := (
+	    --  ---------------------------------------------------------
+            --  |  U    X    0    1    Z    W    L    H    D 	    |   |  
+	    --  ---------------------------------------------------------
+                ( 'X', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | U |
+                ( 'X', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | X |
+                ( 'X', 'X', '0', '1', '0', 'X', '0', '1', '0' ), -- | 0 |
+                ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ), -- | 1 |
+                ( 'X', 'X', '0', '1', 'Z', 'X', '0', '1', 'Z' ), -- | Z |
+                ( 'X', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | W |
+                ( 'X', 'X', '0', '1', '0', 'X', '0', '1', '0' ), -- | L |
+                ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ), -- | H |
+                ( 'X', 'X', '0', '1', 'Z', 'X', '0', '1', 'Z' )  -- | D |
+            );
+        
+    BEGIN
+         -- Iterate through all inputs
+         FOR i IN input'range LOOP
+             result := resolution_table(result, input(i));
+         END LOOP;
+         -- Return the resultant value 
+         RETURN result;
+    END std_ulogic_wired_or;
+
+    FUNCTION std_ulogic_wired_and ( input : std_ulogic_vector ) RETURN std_ulogic IS
+        VARIABLE result : std_ulogic := '-';  -- weakest state default
+        CONSTANT resolution_table : stdlogic_table := (
+	    --  ---------------------------------------------------------
+            --  |  U    X    0    1    Z    W    L    H    D 	    |   |  
+	    --  ---------------------------------------------------------
+                ( 'X', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | U |
+                ( 'X', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | X |
+                ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ), -- | 0 |
+                ( 'X', 'X', '0', '1', '1', 'X', '0', '1', '1' ), -- | 1 |
+                ( 'X', 'X', '0', '1', 'Z', 'X', '0', '1', 'Z' ), -- | Z |
+                ( 'X', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | W |
+                ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ), -- | L |
+                ( 'X', 'X', '0', '1', '1', 'X', '0', '1', '1' ), -- | H |
+                ( 'X', 'X', '0', '1', 'Z', 'X', '0', '1', 'Z' )  -- | D |
+            );
+        
+    BEGIN
+         -- Iterate through all inputs
+         FOR i IN input'range LOOP
+             result := resolution_table(result, input(i));
+         END LOOP;
+         -- Return the resultant value 
+         RETURN result;
+    END std_ulogic_wired_and;
+
+--
+-- MGC base level functions
+--
+--
+-- Convert Base Type to Integer
+--
+      FUNCTION to_integer (arg1 : STD_ULOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER IS
+         VARIABLE tmp : SIGNED( arg1'length - 1 DOWNTO 0 ) := (OTHERS => '0');
+         VARIABLE       result   : INTEGER;
+      BEGIN
+         tmp := SIGNED(arg1);
+         result := TO_INTEGER( tmp, x );
+         RETURN (result);
+      END to_integer;
+
+      FUNCTION to_integer (arg1 : STD_LOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER IS
+         VARIABLE tmp : SIGNED( arg1'length - 1 DOWNTO 0 ) := (OTHERS => '0');
+         VARIABLE       result   : INTEGER;
+      BEGIN
+         tmp := SIGNED(arg1);
+         result := TO_INTEGER( tmp, x );
+         RETURN (result);
+      END to_integer;
+
+      FUNCTION to_integer (arg1 : UNSIGNED; x : INTEGER := 0 ) RETURN NATURAL IS
+         VARIABLE tmp : SIGNED( arg1'length DOWNTO 0 ) := (OTHERS => '0');
+         VARIABLE       result   : NATURAL;
+      BEGIN
+         tmp := '0' & SIGNED(arg1);
+         result := TO_INTEGER( tmp, x );
+         RETURN (result);
+      END to_integer;
+
+      FUNCTION TO_INTEGER (arg1 : SIGNED; x : INTEGER := 0 ) RETURN INTEGER IS
+         VARIABLE return_int,x_tmp : INTEGER := 0;
+      BEGIN
+         ASSERT arg1'length > 0
+            REPORT "NULL vector, returning 0"
+            SEVERITY NOTE;
+         assert arg1'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+         ASSERT arg1'length <= 32     -- implementation dependent limit
+            REPORT "vector too large, conversion may cause overflow"
+            SEVERITY WARNING;
+         IF x /= 0 THEN 
+            x_tmp := 1;
+         END IF;
+         IF arg1(arg1'left) = '0' OR arg1(arg1'left) = 'L' OR  -- positive value
+            ( x_tmp = 0 AND arg1(arg1'left) /= '1' AND arg1(arg1'left) /= 'H') THEN 
+            FOR i IN arg1'range LOOP
+               return_int := return_int * 2;
+               CASE arg1(i) IS
+                  WHEN '0'|'L' =>     NULL;
+                  WHEN '1'|'H' =>     return_int := return_int + 1;
+                  WHEN OTHERS  =>     return_int := return_int + x_tmp;
+               END CASE;
+            END LOOP;
+         ELSE                                 -- negative value
+           IF (x_tmp = 0) THEN
+             x_tmp := 1;
+           ELSE
+             x_tmp := 0;
+           END IF;
+            FOR i IN arg1'range LOOP
+               return_int := return_int * 2;
+               CASE arg1(i) IS
+                  WHEN '0'|'L' =>     return_int := return_int + 1;
+                  WHEN '1'|'H' =>     NULL;
+                  WHEN OTHERS  =>     return_int := return_int + x_tmp;
+               END CASE;
+            END LOOP;
+            return_int := (-return_int) - 1;
+         END IF;
+         RETURN return_int;
+      END TO_INTEGER;
+
+      FUNCTION to_integer (arg1:STD_LOGIC; x : INTEGER := 0 )        RETURN NATURAL IS
+      BEGIN
+          IF(arg1 = '0' OR arg1 = 'L' OR (x = 0 AND arg1 /= '1' AND arg1 /= 'H')) THEN
+            RETURN(0);
+          ELSE
+            RETURN(1) ;
+          END IF ;
+      END ;
+
+      FUNCTION conv_integer (arg1 : STD_ULOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER IS
+         VARIABLE tmp : SIGNED( arg1'length - 1 DOWNTO 0 ) := (OTHERS => '0');
+         VARIABLE       result   : INTEGER;
+      BEGIN
+         tmp := SIGNED(arg1);
+         result := TO_INTEGER( tmp, x );
+         RETURN (result);
+      END ;
+
+      FUNCTION conv_integer (arg1 : STD_LOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER IS
+         VARIABLE tmp : SIGNED( arg1'length -1 DOWNTO 0 ) := (OTHERS => '0');
+         VARIABLE       result   : INTEGER;
+      BEGIN
+         tmp := SIGNED(arg1);
+         result := TO_INTEGER( tmp, x );
+         RETURN (result);
+      END ;
+
+      FUNCTION conv_integer (arg1 : UNSIGNED; x : INTEGER := 0 ) RETURN NATURAL IS
+         VARIABLE tmp : SIGNED( arg1'length DOWNTO 0 ) := (OTHERS => '0');
+         VARIABLE       result   : NATURAL;
+      BEGIN
+         tmp := '0' & SIGNED(arg1);
+         result := TO_INTEGER( tmp, x );
+         RETURN (result);
+      END ;
+
+      FUNCTION conv_INTEGER (arg1 : SIGNED; x : INTEGER := 0 ) RETURN INTEGER IS
+         VARIABLE return_int,x_tmp : INTEGER := 0;
+      BEGIN
+         ASSERT arg1'length > 0
+            REPORT "NULL vector, returning 0"
+            SEVERITY NOTE;
+         assert arg1'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+         ASSERT arg1'length <= 32     -- implementation dependent limit
+            REPORT "vector too large, conversion may cause overflow"
+            SEVERITY WARNING;
+         IF x /= 0 THEN 
+            x_tmp := 1;
+         END IF;
+         IF arg1(arg1'left) = '0' OR arg1(arg1'left) = 'L' OR  -- positive value
+            ( x_tmp = 0 AND arg1(arg1'left) /= '1' AND arg1(arg1'left) /= 'H') THEN 
+            FOR i IN arg1'range LOOP
+               return_int := return_int * 2;
+               CASE arg1(i) IS
+                  WHEN '0'|'L' =>     NULL;
+                  WHEN '1'|'H' =>     return_int := return_int + 1;
+                  WHEN OTHERS  =>     return_int := return_int + x_tmp;
+               END CASE;
+            END LOOP;
+         ELSE                                 -- negative value
+           IF (x_tmp = 0) THEN
+             x_tmp := 1;
+           ELSE
+             x_tmp := 0;
+           END IF;
+            FOR i IN arg1'range LOOP
+               return_int := return_int * 2;
+               CASE arg1(i) IS
+                  WHEN '0'|'L' =>     return_int := return_int + 1;
+                  WHEN '1'|'H' =>     NULL;
+                  WHEN OTHERS  =>     return_int := return_int + x_tmp;
+               END CASE;
+            END LOOP;
+            return_int := (-return_int) - 1;
+         END IF;
+         RETURN return_int;
+      END ;
+
+      FUNCTION conv_integer (arg1:STD_LOGIC; x : INTEGER := 0 )        RETURN NATURAL IS
+      BEGIN
+          IF(arg1 = '0' OR arg1 = 'L' OR (x = 0 AND arg1 /= '1' AND arg1 /= 'H')) THEN
+            RETURN(0);
+          ELSE
+            RETURN(1) ;
+          END IF ;
+      END ;
+
+--
+-- Convert Base Type to STD_LOGIC
+--
+   
+  FUNCTION to_stdlogic (arg1:BOOLEAN)  RETURN STD_LOGIC IS
+      BEGIN
+      IF(arg1) THEN
+        RETURN('1') ;
+      ELSE
+        RETURN('0') ;
+      END IF ;
+  END ;
+
+--
+-- Convert Base Type to STD_LOGIC_VECTOR
+--
+      FUNCTION To_StdlogicVector (arg1 : integer; size : NATURAL) RETURN std_logic_vector IS
+         VARIABLE vector : std_logic_vector(0 TO size-1);
+         VARIABLE tmp_int : integer := arg1;
+         VARIABLE carry   : std_logic := '1';   -- setup to add 1 if needed
+         VARIABLE carry2  : std_logic;
+      BEGIN    
+         FOR i IN size-1 DOWNTO 0 LOOP
+             IF tmp_int MOD 2 = 1 THEN
+                vector(i) := '1';
+             ELSE
+                vector(i) := '0';
+             END IF;
+             tmp_int := tmp_int / 2;
+         END LOOP; 
+
+         IF arg1 < 0 THEN
+            FOR i IN size-1 DOWNTO 0 LOOP
+          	carry2    := (NOT vector(i)) AND carry;
+          	vector(i) := (NOT vector(i)) XOR carry;
+                carry     := carry2;
+            END LOOP; 
+         END IF;
+         RETURN vector;
+      END To_StdlogicVector; 
+
+      FUNCTION To_StdUlogicVector (arg1 : integer; size : NATURAL) RETURN std_ulogic_vector IS
+         VARIABLE vector : std_ulogic_vector(0 TO size-1);
+         VARIABLE tmp_int : integer := arg1;
+         VARIABLE carry   : std_ulogic := '1';   -- setup to add 1 if needed
+         VARIABLE carry2  : std_ulogic;
+      BEGIN    
+         FOR i IN size-1 DOWNTO 0 LOOP
+             IF tmp_int MOD 2 = 1 THEN
+                vector(i) := '1';
+             ELSE
+                vector(i) := '0';
+             END IF;
+             tmp_int := tmp_int / 2;
+         END LOOP; 
+
+         IF arg1 < 0 THEN
+            FOR i IN size-1 DOWNTO 0 LOOP
+          	carry2    := (NOT vector(i)) AND carry;
+          	vector(i) := (NOT vector(i)) XOR carry;
+                carry     := carry2;
+            END LOOP; 
+         END IF;
+         RETURN vector;
+      END To_StdUlogicVector; 
+      
+
+--
+-- Convert Base Type to UNSIGNED
+--
+ 
+  FUNCTION to_unsigned (arg1:NATURAL          ; size:NATURAL) RETURN UNSIGNED IS
+         VARIABLE vector : UNSIGNED(0 TO size-1) := (OTHERS => '0');
+         VARIABLE tmp_int : INTEGER := arg1;
+      BEGIN    
+         FOR i IN size-1 DOWNTO 0 LOOP
+             IF tmp_int MOD 2 = 1 THEN
+                vector(i) := '1';
+             ELSE
+                vector(i) := '0';
+             END IF;
+             tmp_int := tmp_int / 2;
+         END LOOP; 
+
+         RETURN vector;
+  END ;
+
+  FUNCTION conv_unsigned (arg1:NATURAL          ; size:NATURAL) RETURN UNSIGNED IS
+         VARIABLE vector : UNSIGNED(0 TO size-1) := (OTHERS => '0');
+         VARIABLE tmp_int : INTEGER := arg1;
+      BEGIN    
+         FOR i IN size-1 DOWNTO 0 LOOP
+             IF tmp_int MOD 2 = 1 THEN
+                vector(i) := '1';
+             ELSE
+                vector(i) := '0';
+             END IF;
+             tmp_int := tmp_int / 2;
+         END LOOP; 
+
+         RETURN vector;
+  END ;
+
+--
+-- Convert Base Type to SIGNED
+--
+
+  FUNCTION to_signed (arg1:INTEGER          ; size : NATURAL) RETURN SIGNED IS
+         VARIABLE vector : SIGNED(0 TO size-1) := (OTHERS => '0');
+         VARIABLE tmp_int : INTEGER := arg1;
+         VARIABLE carry   : STD_LOGIC := '1';   -- setup to add 1 if needed
+         VARIABLE carry2  : STD_LOGIC := '0';
+      BEGIN    
+         FOR i IN size-1 DOWNTO 0 LOOP
+             IF tmp_int MOD 2 = 1 THEN
+                vector(i) := '1';
+             ELSE
+                vector(i) := '0';
+             END IF;
+             tmp_int := tmp_int / 2;
+         END LOOP; 
+
+         IF arg1 < 0 THEN
+            FOR i IN size-1 DOWNTO 0 LOOP
+          	carry2    := (NOT vector(i)) AND carry;
+          	vector(i) := (NOT vector(i)) XOR carry;
+                carry     := carry2;
+            END LOOP; 
+         END IF;
+         RETURN vector;
+      END ; 
+
+  FUNCTION conv_signed (arg1:INTEGER          ; size : NATURAL) RETURN SIGNED IS
+         VARIABLE vector : SIGNED(0 TO size-1) := (OTHERS => '0');
+         VARIABLE tmp_int : INTEGER := arg1;
+         VARIABLE carry   : STD_LOGIC := '1';   -- setup to add 1 if needed
+         VARIABLE carry2  : STD_LOGIC := '0';
+      BEGIN    
+         FOR i IN size-1 DOWNTO 0 LOOP
+             IF tmp_int MOD 2 = 1 THEN
+                vector(i) := '1';
+             ELSE
+                vector(i) := '0';
+             END IF;
+             tmp_int := tmp_int / 2;
+         END LOOP; 
+
+         IF arg1 < 0 THEN
+            FOR i IN size-1 DOWNTO 0 LOOP
+          	carry2    := (NOT vector(i)) AND carry;
+          	vector(i) := (NOT vector(i)) XOR carry;
+                carry     := carry2;
+            END LOOP; 
+         END IF;
+         RETURN vector;
+      END ; 
+
+  -- sign/zero extend functions
+  --
+
+   FUNCTION zero_extend ( arg1 : STD_ULOGIC_VECTOR; size : NATURAL ) RETURN STD_ULOGIC_VECTOR
+     IS 
+     VARIABLE answer : STD_ULOGIC_VECTOR(size-1 DOWNTO 0) := (OTHERS => '0') ;
+    BEGIN
+       ASSERT arg1'length <= size
+         REPORT "Vector is already larger then size."
+         SEVERITY WARNING ;
+      answer := (OTHERS => '0') ;
+      answer(arg1'length-1 DOWNTO 0) := arg1;
+      RETURN(answer) ;     
+  END ;
+
+   FUNCTION zero_extend ( arg1 : STD_LOGIC_VECTOR; size : NATURAL ) RETURN STD_LOGIC_VECTOR
+     IS 
+     VARIABLE answer : STD_LOGIC_VECTOR(size-1 DOWNTO 0) := (OTHERS => '0') ;
+    BEGIN
+       ASSERT arg1'length <= size
+         REPORT "Vector is already larger then size."
+         SEVERITY WARNING ;
+      answer := (OTHERS => '0') ;
+      answer(arg1'length-1 DOWNTO 0) := arg1;
+      RETURN(answer) ;     
+  END ;
+
+   FUNCTION zero_extend ( arg1 : STD_LOGIC; size : NATURAL ) RETURN STD_LOGIC_VECTOR
+     IS
+    VARIABLE answer : STD_LOGIC_VECTOR(size-1 DOWNTO 0) := (OTHERS => '0') ;
+    BEGIN
+      answer := (OTHERS => '0') ;
+      answer(0) := arg1;
+      RETURN(answer) ;     
+  END ;
+
+  FUNCTION zero_extend ( arg1 : UNSIGNED; size : NATURAL ) RETURN UNSIGNED IS 
+    VARIABLE answer : UNSIGNED(size-1 DOWNTO 0) := (OTHERS => '0') ;
+    BEGIN
+       ASSERT arg1'length <= size
+         REPORT "Vector is already larger then size."
+         SEVERITY WARNING ;
+      answer := (OTHERS => '0') ;
+      answer(arg1'length - 1 DOWNTO 0) := arg1;
+      RETURN(answer) ;     
+  END ;
+
+  FUNCTION sign_extend ( arg1 : SIGNED; size : NATURAL ) RETURN SIGNED IS
+    VARIABLE answer : SIGNED(size-1 DOWNTO 0) := (OTHERS => '0') ;
+    BEGIN
+       ASSERT arg1'length <= size
+         REPORT "Vector is already larger then size."
+         SEVERITY WARNING ;
+      answer := (OTHERS => arg1(arg1'left)) ;
+      answer(arg1'length - 1 DOWNTO 0) := arg1;
+      RETURN(answer) ;     
+  END ;
+
+
+
+    -- Some useful generic functions
+    
+    --//// Zero Extend ////
+    --
+    -- Function zxt
+    --
+    FUNCTION zxt( q : STD_ULOGIC_VECTOR; i : INTEGER ) RETURN STD_ULOGIC_VECTOR IS
+        VARIABLE qs : STD_ULOGIC_VECTOR (1 TO i);
+        VARIABLE qt : STD_ULOGIC_VECTOR (1 TO q'length);
+    BEGIN
+        qt := q;
+        IF i < q'length THEN
+            qs := qt( (q'length-i+1) TO qt'right);
+        ELSIF i > q'length THEN
+            qs := (OTHERS=>'0');
+            qs := qs(1 TO (i-q'length)) & qt;
+        ELSE
+            qs := qt;
+        END IF;
+        RETURN qs;
+    END;
+    
+    --//// Zero Extend ////
+    --
+    -- Function zxt
+    --
+    FUNCTION zxt( q : STD_LOGIC_VECTOR; i : INTEGER ) RETURN STD_LOGIC_VECTOR IS
+        VARIABLE qs : STD_LOGIC_VECTOR (1 TO i);
+        VARIABLE qt : STD_LOGIC_VECTOR (1 TO q'length);
+    BEGIN
+        qt := q;
+        IF i < q'length THEN
+            qs := qt( (q'length-i+1) TO qt'right);
+        ELSIF i > q'length THEN
+            qs := (OTHERS=>'0');
+            qs := qs(1 TO (i-q'length)) & qt;
+        ELSE
+            qs := qt;
+        END IF;
+        RETURN qs;
+    END;
+    
+    --//// Zero Extend ////
+    --
+    -- Function zxt
+    --
+    FUNCTION zxt( q : UNSIGNED; i : INTEGER ) RETURN UNSIGNED IS
+        VARIABLE qs : UNSIGNED (1 TO i);
+        VARIABLE qt : UNSIGNED (1 TO q'length);
+    BEGIN
+        qt := q;
+        IF i < q'length THEN
+            qs := qt( (q'length-i+1) TO qt'right);
+        ELSIF i > q'length THEN
+            qs := (OTHERS=>'0');
+            qs := qs(1 TO (i-q'length)) & qt;
+        ELSE
+            qs := qt;
+        END IF;
+        RETURN qs;
+    END;
+    
+--------------------------------------
+-- Synthesizable addition Functions --
+--------------------------------------
+
+    FUNCTION "+"  ( arg1, arg2 : STD_LOGIC ) RETURN STD_LOGIC IS
+	-- truth table for "xor" function
+	CONSTANT xor_table : stdlogic_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+                ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ),  -- | U |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | X |
+	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | 0 |
+	        ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ),  -- | 1 |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | Z |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | W |
+	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | L |
+	        ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ),  -- | H |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' )   -- | D |
+    );
+    BEGIN
+        RETURN xor_table( arg1, arg2 );
+    END "+";
+
+  function maximum (arg1, arg2: integer) return integer is
+  begin
+   if arg1 > arg2 then
+     return arg1;
+   else
+     return arg2;
+   end if;
+  end;
+
+  FUNCTION "+" (arg1, arg2 :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS
+        CONSTANT ml     : INTEGER := maximum(arg1'length,arg2'length);
+        VARIABLE lt     : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE rt     : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE res    : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE carry  : STD_ULOGIC := '0';
+        VARIABLE a,b,s1 : STD_ULOGIC;
+    BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+      
+        FOR i IN res'reverse_range LOOP
+          a := lt(i);
+          b := rt(i);
+          s1 := a + b;
+          res(i) := s1 + carry;
+          carry := (a AND b) OR (s1 AND carry);
+        END LOOP;           
+        RETURN res;
+      END;
+      
+  FUNCTION "+" (arg1, arg2 :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+        CONSTANT ml     : INTEGER := maximum(arg1'length,arg2'length);
+        VARIABLE lt     : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE rt     : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE res    : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE carry  : STD_LOGIC := '0';
+        VARIABLE a,b,s1 : STD_LOGIC;
+    BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+      
+        FOR i IN res'reverse_range LOOP
+          a := lt(i);
+          b := rt(i);
+          s1 := a + b;
+          res(i) := s1 + carry;
+          carry := (a AND b) OR (s1 AND carry);
+        END LOOP;           
+        RETURN res;
+      END;
+      
+  FUNCTION "+" (arg1, arg2:UNSIGNED)         RETURN UNSIGNED IS
+        CONSTANT ml     : INTEGER := maximum(arg1'length,arg2'length);
+        VARIABLE lt     : UNSIGNED(1 TO ml);
+        VARIABLE rt     : UNSIGNED(1 TO ml);
+        VARIABLE res    : UNSIGNED(1 TO ml);
+        VARIABLE carry  : STD_LOGIC := '0';
+        VARIABLE a,b,s1 : STD_LOGIC;
+    BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+      
+        FOR i IN res'reverse_range LOOP
+          a := lt(i);
+          b := rt(i);
+          s1 := a + b;
+          res(i) := s1 + carry;
+          carry := (a AND b) OR (s1 AND carry);
+        END LOOP;           
+        RETURN res;
+      END;
+      
+  FUNCTION "+" (arg1, arg2:SIGNED)           RETURN SIGNED IS
+    CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ;
+    VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+    VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+      BEGIN
+         assert arg1'length > 1 AND arg2'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      a := (OTHERS => arg1(arg1'left)) ;
+      a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1);
+      b := (OTHERS => arg2(arg2'left)) ;
+      b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2);
+      answer := SIGNED(a + b);
+      RETURN (answer);
+  END ;
+
+-----------------------------------------
+-- Synthesizable subtraction Functions --
+-----------------------------------------
+
+    FUNCTION "-"  ( arg1, arg2 : std_logic ) RETURN std_logic IS
+	-- truth table for "xor" function
+	CONSTANT xor_table : stdlogic_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+                ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ),  -- | U |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | X |
+	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | 0 |
+	        ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ),  -- | 1 |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | Z |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | W |
+	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | L |
+	        ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ),  -- | H |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' )   -- | D |
+    );
+    BEGIN
+        RETURN xor_table( arg1, arg2 );
+    END "-";
+
+  FUNCTION "-" (arg1, arg2:STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS
+        CONSTANT ml     : INTEGER := maximum(arg1'length,arg2'length);
+        VARIABLE lt     : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE rt     : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE res    : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE borrow : STD_ULOGIC := '1';
+        VARIABLE a,b,s1 : STD_ULOGIC;
+      BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+      
+        FOR i IN res'reverse_range LOOP
+          a := lt(i);
+          b := NOT rt(i);
+          s1 := a + b;
+          res(i) := s1 + borrow;
+          borrow := (a AND b) OR (s1 AND borrow);
+        END LOOP;           
+        RETURN res;                
+      END "-";  
+
+  FUNCTION "-" (arg1, arg2:STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+        CONSTANT ml     : INTEGER := maximum(arg1'length,arg2'length);
+        VARIABLE lt     : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE rt     : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE res    : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE borrow : STD_LOGIC := '1';
+        VARIABLE a,b,s1 : STD_LOGIC;
+      BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+      
+        FOR i IN res'reverse_range LOOP
+          a := lt(i);
+          b := NOT rt(i);
+          s1 := a + b;
+          res(i) := s1 + borrow;
+          borrow := (a AND b) OR (s1 AND borrow);
+        END LOOP;           
+        RETURN res;                
+      END "-";  
+
+  FUNCTION "-" (arg1, arg2:UNSIGNED)         RETURN UNSIGNED IS
+        CONSTANT ml     : INTEGER := maximum(arg1'length,arg2'length);
+        VARIABLE lt     : UNSIGNED(1 TO ml);
+        VARIABLE rt     : UNSIGNED(1 TO ml);
+        VARIABLE res    : UNSIGNED(1 TO ml);
+        VARIABLE borrow : STD_LOGIC := '1';
+        VARIABLE a,b,s1 : STD_LOGIC;
+      BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+      
+        FOR i IN res'reverse_range LOOP
+          a := lt(i);
+          b := NOT rt(i);
+          s1 := a + b;
+          res(i) := s1 + borrow;
+          borrow := (a AND b) OR (s1 AND borrow);
+        END LOOP;           
+        RETURN res;                
+      END "-";  
+
+
+  FUNCTION "-" (arg1, arg2:SIGNED)           RETURN SIGNED IS
+    CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ;
+    VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+    VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+      BEGIN
+         assert arg1'length > 1 AND arg2'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      a := (OTHERS => arg1(arg1'left)) ;
+      a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1);
+      b := (OTHERS => arg2(arg2'left)) ;
+      b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2);
+      answer := SIGNED( a - b );
+      RETURN (answer);
+  END ;
+
+-----------------------------------------
+-- Unary subtract and add Functions --
+-----------------------------------------
+  FUNCTION "+" (arg1:STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS
+  BEGIN
+    RETURN (arg1);
+  END;
+      
+  FUNCTION "+" (arg1:STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+  BEGIN
+    RETURN (arg1);
+  END;
+      
+  FUNCTION "+" (arg1:UNSIGNED) RETURN UNSIGNED IS
+  BEGIN
+    RETURN (arg1);
+  END;
+      
+  FUNCTION "+" (arg1:SIGNED) RETURN SIGNED IS
+  BEGIN
+    RETURN (arg1);
+  END;
+      
+      FUNCTION hasx( v : SIGNED ) RETURN BOOLEAN IS
+      BEGIN
+         FOR i IN v'range LOOP
+             IF v(i) = '0' OR v(i) = '1' OR v(i) = 'L' OR v(i) = 'H'THEN 
+                 NULL;
+             ELSE
+                 RETURN TRUE;
+             END IF;
+         END LOOP;
+         RETURN FALSE;
+      END hasx;
+      
+  FUNCTION "-" (arg1:SIGNED)           RETURN SIGNED IS
+    constant    len      : integer := arg1'length;
+    VARIABLE    answer, tmp   : SIGNED( len-1 downto 0 ) := (others=>'0');
+    VARIABLE    index    : integer := len;
+  BEGIN
+         assert arg1'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+    IF hasx(arg1) THEN
+      answer := (OTHERS => 'X');
+    ELSE
+      tmp := arg1;
+      lp1 : FOR i IN answer'REVERSE_RANGE LOOP
+         IF (tmp(i) = '1' OR tmp(i) = 'H') THEN
+           index := i+1;
+           answer(i downto 0) := tmp(i downto 0);
+           exit;
+         END IF;
+       END LOOP lp1;
+       answer(len-1 downto index) := NOT tmp(len-1 downto index);
+     end if;
+   RETURN (answer);
+  END ;
+
+--------------------------------------------
+-- Synthesizable multiplication Functions --
+--------------------------------------------
+      FUNCTION shift( v : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR IS
+         VARIABLE v1 : STD_ULOGIC_VECTOR( v'range );
+      BEGIN
+         FOR i IN (v'left+1) TO v'right LOOP
+             v1(i-1) := v(i);
+         END LOOP;
+         v1(v1'right) := '0';
+         RETURN v1;
+      END shift;
+      
+      PROCEDURE copy(a : IN STD_ULOGIC_VECTOR; b : OUT STD_ULOGIC_VECTOR) IS
+         VARIABLE bi : INTEGER := b'right;
+      BEGIN
+         FOR i IN a'reverse_range LOOP
+             b(bi) := a(i);
+             bi := bi - 1;
+         END LOOP;
+      END copy;
+
+      FUNCTION shift( v : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR IS
+         VARIABLE v1 : STD_LOGIC_VECTOR( v'range );
+      BEGIN
+         FOR i IN (v'left+1) TO v'right LOOP
+             v1(i-1) := v(i);
+         END LOOP;
+         v1(v1'right) := '0';
+         RETURN v1;
+      END shift;
+      
+      PROCEDURE copy(a : IN STD_LOGIC_VECTOR; b : OUT STD_LOGIC_VECTOR) IS
+         VARIABLE bi : INTEGER := b'right;
+      BEGIN
+         FOR i IN a'reverse_range LOOP
+             b(bi) := a(i);
+             bi := bi - 1;
+         END LOOP;
+      END copy;
+
+      FUNCTION shift( v : SIGNED ) RETURN SIGNED IS
+         VARIABLE v1 : SIGNED( v'range );
+      BEGIN
+         FOR i IN (v'left+1) TO v'right LOOP
+             v1(i-1) := v(i);
+         END LOOP;
+         v1(v1'right) := '0';
+         RETURN v1;
+      END shift;
+      
+      PROCEDURE copy(a : IN SIGNED; b : OUT SIGNED) IS
+         VARIABLE bi : INTEGER := b'right;
+      BEGIN
+         FOR i IN a'reverse_range LOOP
+             b(bi) := a(i);
+             bi := bi - 1;
+         END LOOP;
+      END copy;
+
+      FUNCTION shift( v : UNSIGNED ) RETURN UNSIGNED IS
+         VARIABLE v1 : UNSIGNED( v'range );
+      BEGIN
+         FOR i IN (v'left+1) TO v'right LOOP
+             v1(i-1) := v(i);
+         END LOOP;
+         v1(v1'right) := '0';
+         RETURN v1;
+      END shift;
+      
+      PROCEDURE copy(a : IN UNSIGNED; b : OUT UNSIGNED) IS
+         VARIABLE bi : INTEGER := b'right;
+      BEGIN
+         FOR i IN a'reverse_range LOOP
+             b(bi) := a(i);
+             bi := bi - 1;
+         END LOOP;
+      END copy;
+      
+  FUNCTION "*" (arg1, arg2:STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS
+        VARIABLE ml     : INTEGER := arg1'length + arg2'length;
+        VARIABLE lt     : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE rt     : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE prod   : STD_ULOGIC_VECTOR(1 TO ml) := (OTHERS=>'0');
+      BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+        FOR i IN rt'reverse_range LOOP
+          IF rt(i) = '1' THEN 
+            prod := prod + lt;
+          END IF;
+          lt := shift(lt);
+        END LOOP;
+        RETURN prod;
+      END "*";  
+
+  FUNCTION "*" (arg1, arg2:STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+        VARIABLE ml     : INTEGER := arg1'length + arg2'length;
+        VARIABLE lt     : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE rt     : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE prod   : STD_LOGIC_VECTOR(1 TO ml) := (OTHERS=>'0');
+      BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+        FOR i IN rt'reverse_range LOOP
+          IF rt(i) = '1' THEN 
+            prod := prod + lt;
+          END IF;
+          lt := shift(lt);
+        END LOOP;
+        RETURN prod;
+      END "*";  
+
+  FUNCTION "*" (arg1, arg2:UNSIGNED)         RETURN UNSIGNED IS
+        VARIABLE ml     : INTEGER := arg1'length + arg2'length;
+        VARIABLE lt     : UNSIGNED(1 TO ml);
+        VARIABLE rt     : UNSIGNED(1 TO ml);
+        VARIABLE prod   : UNSIGNED(1 TO ml) := (OTHERS=>'0');
+      BEGIN       
+        lt := zxt( arg1, ml );
+        rt := zxt( arg2, ml );
+        FOR i IN rt'reverse_range LOOP
+          IF rt(i) = '1' THEN 
+            prod := prod + lt;
+          END IF;
+          lt := shift(lt);
+        END LOOP;
+        RETURN prod;
+      END "*";  
+ 
+    --//// Sign Extend ////
+    --
+    -- Function sxt
+    --
+    FUNCTION sxt( q : SIGNED; i : INTEGER ) RETURN SIGNED IS
+        VARIABLE qs : SIGNED (1 TO i);
+        VARIABLE qt : SIGNED (1 TO q'length);
+    BEGIN
+        qt := q;
+        IF i < q'length THEN
+            qs := qt( (q'length-i+1) TO qt'right);
+        ELSIF i > q'length THEN
+            qs := (OTHERS=>q(q'left));
+            qs := qs(1 TO (i-q'length)) & qt;
+        ELSE
+            qs := qt;
+        END IF;
+        RETURN qs;
+    END;
+    
+    FUNCTION "*" (arg1, arg2:SIGNED)           RETURN SIGNED IS
+        VARIABLE ml     : INTEGER := arg1'length + arg2'length;
+        VARIABLE lt     : SIGNED(1 TO ml);
+        VARIABLE rt     : SIGNED(1 TO ml);
+        VARIABLE prod   : SIGNED(1 TO ml) := (OTHERS=>'0');
+      BEGIN       
+         assert arg1'length > 1 AND arg2'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+        lt := sxt( arg1, ml );
+        rt := sxt( arg2, ml );
+        FOR i IN rt'reverse_range LOOP
+          IF rt(i) = '1' THEN 
+            prod := prod + lt;
+          END IF;
+          lt := shift(lt);
+        END LOOP;
+        RETURN prod;
+      END "*";  
+
+      FUNCTION rshift( v : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR IS
+         VARIABLE v1 : STD_ULOGIC_VECTOR( v'range );
+      BEGIN
+         FOR i IN v'left TO v'right-1 LOOP
+             v1(i+1) := v(i);
+         END LOOP;
+         v1(v1'left) := '0';
+         RETURN v1;
+      END rshift;
+      
+      FUNCTION hasx( v : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS
+      BEGIN
+         FOR i IN v'range LOOP
+             IF v(i) = '0' OR v(i) = '1' OR v(i) = 'L' OR v(i) = 'H'THEN 
+                 NULL;
+             ELSE
+                 RETURN TRUE;
+             END IF;
+         END LOOP;
+         RETURN FALSE;
+      END hasx;
+      
+      FUNCTION rshift( v : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR IS
+         VARIABLE v1 : STD_LOGIC_VECTOR( v'range );
+      BEGIN
+         FOR i IN v'left TO v'right-1 LOOP
+             v1(i+1) := v(i);
+         END LOOP;
+         v1(v1'left) := '0';
+         RETURN v1;
+      END rshift;
+      
+      FUNCTION hasx( v : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS
+      BEGIN
+         FOR i IN v'range LOOP
+             IF v(i) = '0' OR v(i) = '1' OR v(i) = 'L' OR v(i) = 'H'THEN 
+                 NULL;
+             ELSE
+                 RETURN TRUE;
+             END IF;
+         END LOOP;
+         RETURN FALSE;
+      END hasx;
+      
+      FUNCTION rshift( v : UNSIGNED ) RETURN UNSIGNED IS
+         VARIABLE v1 : UNSIGNED( v'range );
+      BEGIN
+         FOR i IN v'left TO v'right-1 LOOP
+             v1(i+1) := v(i);
+         END LOOP;
+         v1(v1'left) := '0';
+         RETURN v1;
+      END rshift;
+      
+      FUNCTION hasx( v : UNSIGNED ) RETURN BOOLEAN IS
+      BEGIN
+         FOR i IN v'range LOOP
+             IF v(i) = '0' OR v(i) = '1' OR v(i) = 'L' OR v(i) = 'H'THEN 
+                 NULL;
+             ELSE
+                 RETURN TRUE;
+             END IF;
+         END LOOP;
+         RETURN FALSE;
+      END hasx;
+      
+      FUNCTION rshift( v : SIGNED ) RETURN SIGNED IS
+         VARIABLE v1 : SIGNED( v'range );
+      BEGIN
+         FOR i IN v'left TO v'right-1 LOOP
+             v1(i+1) := v(i);
+         END LOOP;
+         v1(v1'left) := '0';
+         RETURN v1;
+      END rshift;
+      
+      FUNCTION "/" (l, r :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : STD_ULOGIC_VECTOR(0 TO ml+1);
+        VARIABLE rt     : STD_ULOGIC_VECTOR(0 TO ml+1);
+        VARIABLE quote  : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE tmp    : STD_ULOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : STD_ULOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0');
+      
+      BEGIN
+         ASSERT NOT (r = "0")
+             REPORT "Attempted divide by ZERO"
+             SEVERITY ERROR;
+         IF hasx(l) OR hasx(r) THEN
+           FOR i IN quote'range LOOP
+             quote(i) := 'X';
+           END LOOP;
+         ELSE
+           lt := zxt( l, ml+2 );
+           WHILE lt >= r LOOP
+             rt := zxt( r, ml+2 );
+             n := (OTHERS=>'0');
+             n(n'right) := '1';
+             WHILE rt <= lt LOOP
+               rt := shift(rt);
+               n  := shift(n);
+             END LOOP;
+             rt := rshift(rt);
+             lt := lt - rt;
+             n := rshift(n);
+             tmp := tmp + n;
+           END LOOP;
+         END IF;
+         quote := tmp(2 TO ml+1);
+         RETURN quote;
+      END "/";
+
+      FUNCTION "/" (l, r :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : STD_LOGIC_VECTOR(0 TO ml+1);
+        VARIABLE rt     : STD_LOGIC_VECTOR(0 TO ml+1);
+        VARIABLE quote  : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE tmp    : STD_LOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : STD_LOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0');
+      
+      BEGIN
+         ASSERT NOT (r = "0")
+             REPORT "Attempted divide by ZERO"
+             SEVERITY ERROR;
+         IF hasx(l) OR hasx(r) THEN
+           FOR i IN quote'range LOOP
+             quote(i) := 'X';
+           END LOOP;
+         ELSE
+           lt := zxt( l, ml+2 );
+           WHILE lt >= r LOOP
+             rt := zxt( r, ml+2 );
+             n := (OTHERS=>'0');
+             n(n'right) := '1';
+             WHILE rt <= lt LOOP
+               rt := shift(rt);
+               n  := shift(n);
+             END LOOP;
+             rt := rshift(rt);
+             lt := lt - rt;
+             n := rshift(n);
+             tmp := tmp + n;
+           END LOOP;
+         END IF;
+         quote := tmp(2 TO ml+1);
+         RETURN quote;
+      END "/";
+
+      FUNCTION "/" (l, r :UNSIGNED) RETURN UNSIGNED IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : UNSIGNED(0 TO ml+1);
+        VARIABLE rt     : UNSIGNED(0 TO ml+1);
+        VARIABLE quote  : UNSIGNED(1 TO ml);
+        VARIABLE tmp    : UNSIGNED(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : UNSIGNED(0 TO ml+1) := (OTHERS=>'0');
+      
+      BEGIN
+         ASSERT NOT (r = "0")
+             REPORT "Attempted divide by ZERO"
+             SEVERITY ERROR;
+         IF hasx(l) OR hasx(r) THEN
+           FOR i IN quote'range LOOP
+             quote(i) := 'X';
+           END LOOP;
+         ELSE
+           lt := zxt( l, ml+2 );
+           WHILE lt >= r LOOP
+             rt := zxt( r, ml+2 );
+             n := (OTHERS=>'0');
+             n(n'right) := '1';
+             WHILE rt <= lt LOOP
+               rt := shift(rt);
+               n  := shift(n);
+             END LOOP;
+             rt := rshift(rt);
+             lt := lt - rt;
+             n := rshift(n);
+             tmp := tmp + n;
+           END LOOP;
+         END IF;
+         quote := tmp(2 TO ml+1);
+         RETURN quote;
+      END "/";
+
+      FUNCTION "/" (l, r :SIGNED) RETURN SIGNED IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : SIGNED(0 TO ml+1);
+        VARIABLE rt     : SIGNED(0 TO ml+1);
+        VARIABLE quote  : SIGNED(1 TO ml);
+        VARIABLE tmp    : SIGNED(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : SIGNED(0 TO ml+1) := (OTHERS=>'0');
+      
+      BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+         ASSERT NOT (r = "0")
+             REPORT "Attempted divide by ZERO"
+             SEVERITY ERROR;
+         IF hasx(l) OR hasx(r) THEN
+           FOR i IN quote'range LOOP
+             quote(i) := 'X';
+           END LOOP;
+         ELSE
+           lt := sxt( l, ml+2 );
+           WHILE lt >= r LOOP
+             rt := sxt( r, ml+2 );
+             n := (OTHERS=>'0');
+             n(n'right) := '1';
+             WHILE rt <= lt LOOP
+               rt := shift(rt);
+               n  := shift(n);
+             END LOOP;
+             rt := rshift(rt);
+             lt := lt - rt;
+             n := rshift(n);
+             tmp := tmp + n;
+           END LOOP;
+         END IF;
+         quote := tmp(2 TO ml+1);
+         RETURN quote;
+      END "/";
+
+      FUNCTION "MOD" (l, r :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : STD_ULOGIC_VECTOR(0 TO ml+1);
+        VARIABLE rt     : STD_ULOGIC_VECTOR(0 TO ml+1);
+        VARIABLE quote  : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE tmp    : STD_ULOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : STD_ULOGIC_VECTOR(0 TO ml) := (OTHERS=>'0');
+      
+      BEGIN                              
+        ASSERT NOT (r = "0")
+          REPORT "Attempted divide by ZERO"
+          SEVERITY ERROR;
+        IF hasx(l) OR hasx(r) THEN
+          FOR i IN lt'range LOOP
+            lt(i) := 'X';
+          END LOOP;
+        ELSE
+          lt := zxt( l, ml+2 );
+          WHILE lt >= r LOOP
+            rt := zxt( r, ml+2 );
+            WHILE rt <= lt LOOP
+              rt := shift(rt);
+            END LOOP;
+            rt := rshift(rt);
+            lt := lt - rt;
+          END LOOP;
+        END IF;
+        RETURN lt(2 TO ml+1);
+      END "MOD";
+      
+      FUNCTION "MOD" (l, r :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : STD_LOGIC_VECTOR(0 TO ml+1);
+        VARIABLE rt     : STD_LOGIC_VECTOR(0 TO ml+1);
+        VARIABLE quote  : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE tmp    : STD_LOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : STD_LOGIC_VECTOR(0 TO ml) := (OTHERS=>'0');
+      
+      BEGIN                              
+        ASSERT NOT (r = "0")
+          REPORT "Attempted divide by ZERO"
+          SEVERITY ERROR;
+        IF hasx(l) OR hasx(r) THEN
+          FOR i IN lt'range LOOP
+            lt(i) := 'X';
+          END LOOP;
+        ELSE
+          lt := zxt( l, ml+2 );
+          WHILE lt >= r LOOP
+            rt := zxt( r, ml+2 );
+            WHILE rt <= lt LOOP
+              rt := shift(rt);
+            END LOOP;
+            rt := rshift(rt);
+            lt := lt - rt;
+          END LOOP;
+        END IF;
+        RETURN lt(2 TO ml+1);
+      END "MOD";
+      
+      FUNCTION "MOD" (l, r :UNSIGNED) RETURN UNSIGNED IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : UNSIGNED(0 TO ml+1);
+        VARIABLE rt     : UNSIGNED(0 TO ml+1);
+        VARIABLE quote  : UNSIGNED(1 TO ml);
+        VARIABLE tmp    : UNSIGNED(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : UNSIGNED(0 TO ml) := (OTHERS=>'0');
+      
+      BEGIN                              
+        ASSERT NOT (r = "0")
+          REPORT "Attempted divide by ZERO"
+          SEVERITY ERROR;
+        IF hasx(l) OR hasx(r) THEN
+          FOR i IN lt'range LOOP
+            lt(i) := 'X';
+          END LOOP;
+        ELSE
+          lt := zxt( l, ml+2 );
+          WHILE lt >= r LOOP
+            rt := zxt( r, ml+2 );
+            WHILE rt <= lt LOOP
+              rt := shift(rt);
+            END LOOP;
+            rt := rshift(rt);
+            lt := lt - rt;
+          END LOOP;
+        END IF;
+        RETURN lt(2 TO ml+1);
+      END "MOD";
+      
+      FUNCTION "REM" (l, r :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : STD_ULOGIC_VECTOR(0 TO ml+1);
+        VARIABLE rt     : STD_ULOGIC_VECTOR(0 TO ml+1);
+        VARIABLE quote  : STD_ULOGIC_VECTOR(1 TO ml);
+        VARIABLE tmp    : STD_ULOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : STD_ULOGIC_VECTOR(0 TO ml) := (OTHERS=>'0');
+      
+      BEGIN                              
+        ASSERT NOT (r = "0")
+          REPORT "Attempted divide by ZERO"
+          SEVERITY ERROR;
+        IF hasx(l) OR hasx(r) THEN
+          FOR i IN lt'range LOOP
+            lt(i) := 'X';
+          END LOOP;
+        ELSE
+          lt := zxt( l, ml+2 );
+          WHILE lt >= r LOOP
+            rt := zxt( r, ml+2 );
+            WHILE rt <= lt LOOP
+              rt := shift(rt);
+            END LOOP;
+            rt := rshift(rt);
+            lt := lt - rt;
+          END LOOP;
+        END IF;
+        RETURN lt(2 TO ml+1);
+      END "REM";
+      
+      FUNCTION "REM" (l, r :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : STD_LOGIC_VECTOR(0 TO ml+1);
+        VARIABLE rt     : STD_LOGIC_VECTOR(0 TO ml+1);
+        VARIABLE quote  : STD_LOGIC_VECTOR(1 TO ml);
+        VARIABLE tmp    : STD_LOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : STD_LOGIC_VECTOR(0 TO ml) := (OTHERS=>'0');
+      
+      BEGIN                              
+        ASSERT NOT (r = "0")
+          REPORT "Attempted divide by ZERO"
+          SEVERITY ERROR;
+        IF hasx(l) OR hasx(r) THEN
+          FOR i IN lt'range LOOP
+            lt(i) := 'X';
+          END LOOP;
+        ELSE
+          lt := zxt( l, ml+2 );
+          WHILE lt >= r LOOP
+            rt := zxt( r, ml+2 );
+            WHILE rt <= lt LOOP
+              rt := shift(rt);
+            END LOOP;
+            rt := rshift(rt);
+            lt := lt - rt;
+          END LOOP;
+        END IF;
+        RETURN lt(2 TO ml+1);
+      END "REM";
+      
+      FUNCTION "REM" (l, r :UNSIGNED) RETURN UNSIGNED IS
+      
+        CONSTANT ml     : INTEGER := maximum(l'length,r'length);
+        VARIABLE lt     : UNSIGNED(0 TO ml+1);
+        VARIABLE rt     : UNSIGNED(0 TO ml+1);
+        VARIABLE quote  : UNSIGNED(1 TO ml);
+        VARIABLE tmp    : UNSIGNED(0 TO ml+1) := (OTHERS=>'0');
+        VARIABLE n      : UNSIGNED(0 TO ml) := (OTHERS=>'0');
+      
+      BEGIN                              
+        ASSERT NOT (r = "0")
+          REPORT "Attempted divide by ZERO"
+          SEVERITY ERROR;
+        IF hasx(l) OR hasx(r) THEN
+          FOR i IN lt'range LOOP
+            lt(i) := 'X';
+          END LOOP;
+        ELSE
+          lt := zxt( l, ml+2 );
+          WHILE lt >= r LOOP
+            rt := zxt( r, ml+2 );
+            WHILE rt <= lt LOOP
+              rt := shift(rt);
+            END LOOP;
+            rt := rshift(rt);
+            lt := lt - rt;
+          END LOOP;
+        END IF;
+        RETURN lt(2 TO ml+1);
+      END "REM";
+      
+      FUNCTION "**" (l, r :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS
+      
+        VARIABLE return_vector : STD_ULOGIC_VECTOR(l'range) := (OTHERS=>'0');
+        VARIABLE tmp           : STD_ULOGIC_VECTOR(1 TO (2 * l'length)) := (OTHERS=>'0');
+        CONSTANT lsh_l         : INTEGER := l'length+1;
+        CONSTANT lsh_r         : INTEGER := 2 * l'length;
+        VARIABLE pow           : INTEGER;
+      
+      BEGIN                              
+         IF (hasx(l) OR hasx(r)) THEN
+             FOR i IN return_vector'range LOOP
+                 return_vector(i) := 'X';
+             END LOOP;
+         ELSE
+             pow := to_integer( r, 0 );
+             tmp( tmp'right ) := '1';
+             FOR i IN 1 TO pow LOOP
+                 tmp := tmp(lsh_l TO lsh_r) * l;
+             END LOOP;
+             return_vector := tmp(lsh_l TO lsh_r);
+         END IF;
+         RETURN return_vector;
+      END "**";  
+
+      FUNCTION "**" (l, r :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+      
+        VARIABLE return_vector : STD_LOGIC_VECTOR(l'range) := (OTHERS=>'0');
+        VARIABLE tmp           : STD_LOGIC_VECTOR(1 TO (2 * l'length)) := (OTHERS=>'0');
+        CONSTANT lsh_l         : INTEGER := l'length+1;
+        CONSTANT lsh_r         : INTEGER := 2 * l'length;
+        VARIABLE pow           : INTEGER;
+      
+      BEGIN                              
+         IF (hasx(l) OR hasx(r)) THEN
+             FOR i IN return_vector'range LOOP
+                 return_vector(i) := 'X';
+             END LOOP;
+         ELSE
+             pow := to_integer( r, 0 );
+             tmp( tmp'right ) := '1';
+             FOR i IN 1 TO pow LOOP
+                 tmp := tmp(lsh_l TO lsh_r) * l;
+             END LOOP;
+             return_vector := tmp(lsh_l TO lsh_r);
+         END IF;
+         RETURN return_vector;
+      END "**";  
+
+      FUNCTION "**" (l, r :UNSIGNED) RETURN UNSIGNED IS
+      
+        VARIABLE return_vector : UNSIGNED(l'range) := (OTHERS=>'0');
+        VARIABLE tmp           : UNSIGNED(1 TO (2 * l'length)) := (OTHERS=>'0');
+        CONSTANT lsh_l         : INTEGER := l'length+1;
+        CONSTANT lsh_r         : INTEGER := 2 * l'length;
+        VARIABLE pow           : INTEGER;
+      
+      BEGIN                              
+         IF (hasx(l) OR hasx(r)) THEN
+             FOR i IN return_vector'range LOOP
+                 return_vector(i) := 'X';
+             END LOOP;
+         ELSE
+             pow := to_integer( r, 0 );
+             tmp( tmp'right ) := '1';
+             FOR i IN 1 TO pow LOOP
+                 tmp := tmp(lsh_l TO lsh_r) * l;
+             END LOOP;
+             return_vector := tmp(lsh_l TO lsh_r);
+         END IF;
+         RETURN return_vector;
+      END "**";  
+
+--
+-- Absolute Value Functions
+--
+  FUNCTION "abs" (arg1:SIGNED)  RETURN SIGNED IS
+    constant    len      : integer := arg1'length;
+    VARIABLE    answer, tmp   : SIGNED( len-1 downto 0 ) := (others=>'0');
+    VARIABLE    index    : integer := len;
+  BEGIN
+         assert arg1'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+    IF hasx(arg1) THEN
+      answer := (OTHERS => 'X');
+    ELSIF (arg1(arg1'left) = '0' OR arg1(arg1'left) = 'L') THEN
+        answer := arg1;
+    ELSE
+      tmp := arg1;
+      lp1 : FOR i IN answer'REVERSE_RANGE LOOP
+         IF (tmp(i) = '1' OR tmp(i) = 'H') THEN
+           index := i+1;
+           answer(i downto 0) := tmp(i downto 0);
+           exit;
+         END IF;
+       END LOOP lp1;
+       answer(len-1 downto index) := NOT tmp(len-1 downto index);
+     end if;
+   RETURN (answer);
+  END ;
+
+--
+-- Shift Left (arithmetic) Functions
+--
+
+  FUNCTION "sla" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : std_ulogic_vector(1 to len) := (others => arg1(arg1'right));
+     VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(arg2+1 to len) & se(1 to arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sla" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : std_logic_vector(1 to len) := (others => arg1(arg1'right));
+     VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(arg2+1 to len) & se(1 to arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sla" (arg1:UNSIGNED ; arg2:NATURAL)  RETURN UNSIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : UNSIGNED(1 to len) := (others => arg1(arg1'right));
+     VARIABLE ans : UNSIGNED(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(arg2+1 to len) & se(1 to arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sla" (arg1:SIGNED   ; arg2:NATURAL)  RETURN SIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : SIGNED(1 to len) := (others => arg1(arg1'right));
+     VARIABLE ans : SIGNED(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(arg2+1 to len) & se(1 to arg2));
+    END IF;
+  END ;
+
+--
+-- Shift Right (arithmetics) Functions
+--
+  FUNCTION "sra" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : std_ulogic_vector(1 to len) := (others => arg1(arg1'left));
+     VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (se(1 to arg2) & ans(1 to len-arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sra" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : std_logic_vector(1 to len) := (others => arg1(arg1'left));
+     VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (se(1 to arg2) & ans(1 to len-arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sra" (arg1:UNSIGNED ; arg2:NATURAL)  RETURN UNSIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : UNSIGNED(1 to len) := (others => arg1(arg1'left));
+     VARIABLE ans : UNSIGNED(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (se(1 to arg2) & ans(1 to len-arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sra" (arg1:SIGNED   ; arg2:NATURAL)  RETURN SIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : SIGNED(1 to len) := (others => arg1(arg1'left));
+     VARIABLE ans : SIGNED(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (se(1 to arg2) & ans(1 to len-arg2));
+    END IF;
+  END ;
+
+--
+-- Shift Left (logical) Functions
+--
+
+  FUNCTION "sll" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : std_ulogic_vector(1 to len) := (others =>'0');
+     VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(arg2+1 to len) & se(1 to arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sll" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : std_logic_vector(1 to len) := (others =>'0');
+     VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(arg2+1 to len) & se(1 to arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sll" (arg1:UNSIGNED ; arg2:NATURAL)  RETURN UNSIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : UNSIGNED(1 to len) := (others =>'0');
+     VARIABLE ans : UNSIGNED(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(arg2+1 to len) & se(1 to arg2));
+    END IF;
+  END ;
+
+  FUNCTION "sll" (arg1:SIGNED   ; arg2:NATURAL)  RETURN SIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : SIGNED(1 to len) := (others =>'0');
+     VARIABLE ans : SIGNED(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(arg2+1 to len) & se(1 to arg2));
+    END IF;
+  END ;
+
+--
+-- Shift Right (logical) Functions
+--
+  FUNCTION "srl" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : std_ulogic_vector(1 to len) := (others => '0');
+     VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (se(1 to arg2) & ans(1 to len-arg2));
+    END IF;
+  END ;
+
+  FUNCTION "srl" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : std_logic_vector(1 to len) := (others => '0');
+     VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (se(1 to arg2) & ans(1 to len-arg2));
+    END IF;
+  END ;
+
+  FUNCTION "srl" (arg1:UNSIGNED ; arg2:NATURAL)  RETURN UNSIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : UNSIGNED(1 to len) := (others => '0');
+     VARIABLE ans : UNSIGNED(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (se(1 to arg2) & ans(1 to len-arg2));
+    END IF;
+  END ;
+
+  FUNCTION "srl" (arg1:SIGNED   ; arg2:NATURAL)  RETURN SIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT se : SIGNED(1 to len) := (others => '0');
+     VARIABLE ans : SIGNED(1 to len) := arg1;
+  BEGIN
+    IF (arg2 >= len) THEN
+      RETURN (se);
+    ELSIF (arg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (se(1 to arg2) & ans(1 to len-arg2));
+    END IF;
+  END ;
+
+--
+-- Rotate Left (Logical) Functions
+--
+  FUNCTION "rol" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT marg2 : integer := arg2 mod len;
+     VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (marg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(marg2+1 to len) & ans(1 to marg2));
+    END IF;
+  END ;
+
+  FUNCTION "rol" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT marg2 : integer := arg2 mod len;
+     VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (marg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(marg2+1 to len) & ans(1 to marg2));
+    END IF;
+  END ;
+
+  FUNCTION "rol" (arg1:UNSIGNED ; arg2:NATURAL)  RETURN UNSIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT marg2 : integer := arg2 mod len;
+     VARIABLE ans : UNSIGNED(1 to len) := arg1;
+  BEGIN
+    IF (marg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(marg2+1 to len) & ans(1 to marg2));
+    END IF;
+  END ;
+
+  FUNCTION "rol" (arg1:SIGNED   ; arg2:NATURAL)  RETURN SIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT marg2 : integer := arg2 mod len;
+     VARIABLE ans : SIGNED(1 to len) := arg1;
+  BEGIN
+    IF (marg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(marg2+1 to len) & ans(1 to marg2));
+    END IF;
+  END ;
+
+--
+-- Rotate Right (Logical) Functions
+--
+  FUNCTION "ror" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_ULOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT marg2 : integer := arg2 mod len;
+     VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (marg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(len-marg2+1 to len) & ans(1 to len-marg2));
+    END IF;
+  END ;
+
+  FUNCTION "ror" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL)  RETURN STD_LOGIC_VECTOR IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT marg2 : integer := arg2 mod len;
+     VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1;
+  BEGIN
+    IF (marg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(len-marg2+1 to len) & ans(1 to len-marg2));
+    END IF;
+  END ;
+
+  FUNCTION "ror" (arg1:UNSIGNED ; arg2:NATURAL)  RETURN UNSIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT marg2 : integer := arg2 mod len;
+     VARIABLE ans : UNSIGNED(1 to len) := arg1;
+  BEGIN
+    IF (marg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(len-marg2+1 to len) & ans(1 to len-marg2));
+    END IF;
+  END ;
+
+  FUNCTION "ror" (arg1:SIGNED   ; arg2:NATURAL)  RETURN SIGNED IS
+     CONSTANT len : INTEGER := arg1'length ;
+     CONSTANT marg2 : integer := arg2 mod len;
+     VARIABLE ans : SIGNED(1 to len) := arg1;
+  BEGIN
+    IF (marg2 = 0) THEN
+      RETURN (arg1);
+    ELSE
+      RETURN (ans(len-marg2+1 to len) & ans(1 to len-marg2));
+    END IF;
+  END ;
+
+--
+-- Equal functions.
+--
+    CONSTANT eq_table : stdlogic_boolean_table := (
+    --      ----------------------------------------------------------------------------
+    --      |  U       X      0     1      Z      W      L      H      D         |   |  
+    --      ----------------------------------------------------------------------------
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | U |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | X |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | 0 |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | 1 |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | Z |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | W |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | L |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | H |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE )   -- | D |
+    );
+
+    FUNCTION eq  ( l, r : STD_LOGIC ) RETURN BOOLEAN IS
+    BEGIN
+        RETURN eq_table( l, r );
+    END;
+
+    FUNCTION eq  ( l,r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : STD_ULOGIC_VECTOR ( 1 TO ml );
+        VARIABLE rt  : STD_ULOGIC_VECTOR ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF NOT eq( lt(i), rt(i) ) THEN
+               RETURN FALSE;
+            END IF;
+        END LOOP;
+        RETURN TRUE;
+    END;
+
+    FUNCTION eq  ( l,r : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : STD_LOGIC_VECTOR ( 1 TO ml );
+        VARIABLE rt  : STD_LOGIC_VECTOR ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF NOT eq( lt(i), rt(i) ) THEN
+               RETURN FALSE;
+            END IF;
+        END LOOP;
+        RETURN TRUE;
+    END;
+
+    FUNCTION eq  ( l,r : UNSIGNED ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : UNSIGNED ( 1 TO ml );
+        VARIABLE rt  : UNSIGNED ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF NOT eq( lt(i), rt(i) ) THEN
+               RETURN FALSE;
+            END IF;
+        END LOOP;
+        RETURN TRUE;
+    END;
+
+    FUNCTION eq  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      RETURN (eq( lt, rt ));
+    END;
+
+    FUNCTION "="  ( l,r : UNSIGNED ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : UNSIGNED ( 1 TO ml );
+        VARIABLE rt  : UNSIGNED ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF NOT eq( lt(i), rt(i) ) THEN
+               RETURN FALSE;
+            END IF;
+        END LOOP;
+        RETURN TRUE;
+    END;
+
+    FUNCTION "="  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      RETURN (eq( lt, rt ));
+    END;
+
+--
+-- Not Equal function.
+--
+  CONSTANT neq_table : stdlogic_boolean_table := (
+  --      ----------------------------------------------------------------------------
+  --      |  U       X      0     1      Z      W      L      H      D         |   |  
+  --      ----------------------------------------------------------------------------
+  ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | U |
+  ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | X |
+  ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | 0 |
+  ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | 1 |
+  ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | Z |
+  ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | W |
+  ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | L |
+  ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | H |
+  ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE )   -- | D |
+  );
+
+
+    FUNCTION ne  ( l, r : STD_LOGIC ) RETURN BOOLEAN IS
+    BEGIN
+        RETURN neq_table( l, r );
+    END;
+
+    FUNCTION ne  ( l,r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : STD_ULOGIC_VECTOR ( 1 TO ml );
+        VARIABLE rt  : STD_ULOGIC_VECTOR ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF ne( lt(i), rt(i) ) THEN
+               RETURN TRUE;
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION ne  ( l,r : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : STD_LOGIC_VECTOR ( 1 TO ml );
+        VARIABLE rt  : STD_LOGIC_VECTOR ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF ne( lt(i), rt(i) ) THEN
+               RETURN TRUE;
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION ne  ( l,r : UNSIGNED ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : UNSIGNED ( 1 TO ml );
+        VARIABLE rt  : UNSIGNED ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF ne( lt(i), rt(i) ) THEN
+               RETURN TRUE;
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION ne  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      RETURN (ne( lt, rt ));
+    END;
+
+    FUNCTION "/=" ( l,r : UNSIGNED ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : UNSIGNED ( 1 TO ml );
+        VARIABLE rt  : UNSIGNED ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF ne( lt(i), rt(i) ) THEN
+               RETURN TRUE;
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION "/="  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      RETURN (ne( lt, rt ));
+    END;
+
+--
+-- Less Than functions.
+--
+    CONSTANT ltb_table : stdlogic_boolean_table := (
+    --      ----------------------------------------------------------------------------
+    --      |  U       X      0     1      Z      W      L      H      D         |   |  
+    --      ----------------------------------------------------------------------------
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | U |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | X |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | 0 |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | 1 |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | Z |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | W |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | L |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | H |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE )   -- | D |
+    );
+
+    FUNCTION lt  ( l, r : STD_LOGIC ) RETURN BOOLEAN IS
+    BEGIN
+        RETURN ltb_table( l, r );
+    END;
+
+    FUNCTION lt  ( l,r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE ltt  : STD_ULOGIC_VECTOR ( 1 TO ml );
+        VARIABLE rtt  : STD_ULOGIC_VECTOR ( 1 TO ml );
+    BEGIN
+        ltt := zxt( l, ml );
+        rtt := zxt( r, ml );
+        FOR i IN ltt'range LOOP
+            IF NOT eq( ltt(i), rtt(i) ) THEN
+               RETURN lt( ltt(i), rtt(i) );
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION lt  ( l,r : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE ltt  : STD_LOGIC_VECTOR ( 1 TO ml );
+        VARIABLE rtt  : STD_LOGIC_VECTOR ( 1 TO ml );
+    BEGIN
+        ltt := zxt( l, ml );
+        rtt := zxt( r, ml );
+        FOR i IN ltt'range LOOP
+            IF NOT eq( ltt(i), rtt(i) ) THEN
+               RETURN lt( ltt(i), rtt(i) );
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION lt  ( l,r : UNSIGNED ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE ltt  : UNSIGNED ( 1 TO ml );
+        VARIABLE rtt  : UNSIGNED ( 1 TO ml );
+    BEGIN
+        ltt := zxt( l, ml );
+        rtt := zxt( r, ml );
+        FOR i IN ltt'range LOOP
+            IF NOT eq( ltt(i), rtt(i) ) THEN
+               RETURN lt( ltt(i), rtt(i) );
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION lt  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE ltt, rtt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      ltt := (OTHERS => l(l'left)) ;
+      ltt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rtt := (OTHERS => r(r'left)) ;
+      rtt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      IF(ltt(ltt'left) = '1' AND rtt(rtt'left) = '0') THEN
+        RETURN(TRUE) ;
+      ELSIF(ltt(ltt'left) = '0' AND rtt(rtt'left) = '1') THEN
+        RETURN(FALSE) ;
+      ELSE          
+        RETURN (lt( ltt, rtt ));
+      END IF ;
+    END;
+
+    FUNCTION "<"  ( l,r : UNSIGNED ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE ltt  : UNSIGNED ( 1 TO ml );
+        VARIABLE rtt  : UNSIGNED ( 1 TO ml );
+    BEGIN
+        ltt := zxt( l, ml );
+        rtt := zxt( r, ml );
+        FOR i IN ltt'range LOOP
+            IF NOT eq( ltt(i), rtt(i) ) THEN
+               RETURN lt( ltt(i), rtt(i) );
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION "<"  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE ltt, rtt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      ltt := (OTHERS => l(l'left)) ;
+      ltt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rtt := (OTHERS => r(r'left)) ;
+      rtt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      IF(ltt(ltt'left) = '1' AND rtt(rtt'left) = '0') THEN
+        RETURN(TRUE) ;
+      ELSIF(ltt(ltt'left) = '0' AND rtt(rtt'left) = '1') THEN
+        RETURN(FALSE) ;
+      ELSE          
+        RETURN (lt( ltt, rtt ));
+      END IF ;
+    END;
+
+--
+-- Greater Than functions.
+--
+    CONSTANT gtb_table : stdlogic_boolean_table := (
+    --      ----------------------------------------------------------------------------
+    --      |  U       X      0     1      Z      W      L      H      D         |   |  
+    --      ----------------------------------------------------------------------------
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | U |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | X |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | 0 |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | 1 |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | Z |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | W |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ),  -- | L |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | H |
+    ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE )   -- | D |
+    );
+
+    FUNCTION gt  ( l, r : std_logic ) RETURN BOOLEAN IS
+    BEGIN
+        RETURN gtb_table( l, r );
+    END ;
+
+    FUNCTION gt  ( l,r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : STD_ULOGIC_VECTOR ( 1 TO ml );
+        VARIABLE rt  : STD_ULOGIC_VECTOR ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF NOT eq( lt(i), rt(i) ) THEN
+               RETURN gt( lt(i), rt(i) );
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION gt  ( l,r : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : STD_LOGIC_VECTOR ( 1 TO ml );
+        VARIABLE rt  : STD_LOGIC_VECTOR ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF NOT eq( lt(i), rt(i) ) THEN
+               RETURN gt( lt(i), rt(i) );
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION gt  ( l,r : UNSIGNED ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : UNSIGNED ( 1 TO ml );
+        VARIABLE rt  : UNSIGNED ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF NOT eq( lt(i), rt(i) ) THEN
+               RETURN gt( lt(i), rt(i) );
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION gt  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN
+        RETURN(FALSE) ;
+      ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN
+        RETURN(TRUE) ;
+      ELSE          
+        RETURN (gt( lt, rt ));
+      END IF ;
+    END;
+
+    FUNCTION ">"  ( l,r : UNSIGNED ) RETURN BOOLEAN IS
+        CONSTANT ml  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt  : UNSIGNED ( 1 TO ml );
+        VARIABLE rt  : UNSIGNED ( 1 TO ml );
+    BEGIN
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'range LOOP
+            IF NOT eq( lt(i), rt(i) ) THEN
+               RETURN gt( lt(i), rt(i) );
+            END IF;
+        END LOOP;
+        RETURN FALSE;
+    END;
+
+    FUNCTION ">"  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN
+        RETURN(FALSE) ;
+      ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN
+        RETURN(TRUE) ;
+      ELSE          
+        RETURN (gt( lt, rt ));
+      END IF ;
+    END;
+
+--
+-- Less Than or Equal to  functions.
+--
+    CONSTANT leb_table : stdlogic_boolean_table := (
+    --      ----------------------------------------------------------------------------
+    --      |  U       X      0     1      Z      W      L      H      D         |   |  
+    --      ----------------------------------------------------------------------------
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | U |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | X |
+    ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE ),  -- | 0 |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | 1 |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | Z |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | W |
+    ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE ),  -- | L |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ),  -- | H |
+    ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE )   -- | D |
+    );
+
+    FUNCTION le  ( l, r : std_logic ) RETURN BOOLEAN IS
+    BEGIN
+        RETURN leb_table( l, r );
+    END ;
+
+    TYPE std_ulogic_fuzzy_state IS ('U', 'X', 'T', 'F', 'N');
+    TYPE std_ulogic_fuzzy_state_table IS ARRAY ( std_ulogic, std_ulogic ) OF std_ulogic_fuzzy_state;
+
+    CONSTANT le_fuzzy_table : std_ulogic_fuzzy_state_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+                ( 'U', 'U', 'U', 'N', 'U', 'U', 'U', 'N', 'U' ),  -- | U |
+	        ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ),  -- | X |
+	        ( 'N', 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N' ),  -- | 0 |
+	        ( 'U', 'X', 'F', 'N', 'X', 'X', 'F', 'N', 'X' ),  -- | 1 |
+	        ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ),  -- | Z |
+	        ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ),  -- | W |
+	        ( 'N', 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N' ),  -- | L |
+	        ( 'U', 'X', 'F', 'N', 'X', 'X', 'F', 'N', 'X' ),  -- | H |
+	        ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' )   -- | D |
+    );
+
+    FUNCTION le  ( L,R : std_ulogic_vector ) RETURN boolean IS
+        CONSTANT ml  : integer := maximum( L'LENGTH, R'LENGTH );
+        VARIABLE lt  : std_ulogic_vector ( 1 to ml );
+        VARIABLE rt  : std_ulogic_vector ( 1 to ml );
+        VARIABLE res : std_ulogic_fuzzy_state;
+    begin
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'RANGE LOOP
+            res := le_fuzzy_table( lt(i), rt(i) );
+            CASE res IS
+              WHEN 'U'          => RETURN FALSE;
+              WHEN 'X'          => RETURN FALSE;
+              WHEN 'T'          => RETURN TRUE;
+              WHEN 'F'          => RETURN FALSE;
+              WHEN OTHERS       => null;
+            END CASE;
+        END LOOP;
+        RETURN TRUE;
+    end ;
+
+    TYPE std_logic_fuzzy_state IS ('U', 'X', 'T', 'F', 'N');
+    TYPE std_logic_fuzzy_state_table IS ARRAY ( std_logic, std_logic ) OF std_logic_fuzzy_state;
+
+    CONSTANT le_lfuzzy_table : std_logic_fuzzy_state_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+                ( 'U', 'U', 'U', 'N', 'U', 'U', 'U', 'N', 'U' ),  -- | U |
+	        ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ),  -- | X |
+	        ( 'N', 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N' ),  -- | 0 |
+	        ( 'U', 'X', 'F', 'N', 'X', 'X', 'F', 'N', 'X' ),  -- | 1 |
+	        ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ),  -- | Z |
+	        ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ),  -- | W |
+	        ( 'N', 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N' ),  -- | L |
+	        ( 'U', 'X', 'F', 'N', 'X', 'X', 'F', 'N', 'X' ),  -- | H |
+	        ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' )   -- | D |
+    );
+
+    FUNCTION le  ( L,R : std_logic_vector ) RETURN boolean IS
+        CONSTANT ml  : integer := maximum( L'LENGTH, R'LENGTH );
+        VARIABLE lt  : std_logic_vector ( 1 to ml );
+        VARIABLE rt  : std_logic_vector ( 1 to ml );
+        VARIABLE res : std_logic_fuzzy_state;
+    begin
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'RANGE LOOP
+            res := le_lfuzzy_table( lt(i), rt(i) );
+            CASE res IS
+              WHEN 'U'          => RETURN FALSE;
+              WHEN 'X'          => RETURN FALSE;
+              WHEN 'T'          => RETURN TRUE;
+              WHEN 'F'          => RETURN FALSE;
+              WHEN OTHERS       => null;
+            END CASE;
+        END LOOP;
+        RETURN TRUE;
+    end ;
+
+    FUNCTION le  ( L,R : UNSIGNED ) RETURN boolean IS
+        CONSTANT ml  : integer := maximum( L'LENGTH, R'LENGTH );
+        VARIABLE lt  : UNSIGNED ( 1 to ml );
+        VARIABLE rt  : UNSIGNED ( 1 to ml );
+        VARIABLE res : std_logic_fuzzy_state;
+    begin
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'RANGE LOOP
+            res := le_lfuzzy_table( lt(i), rt(i) );
+            CASE res IS
+              WHEN 'U'          => RETURN FALSE;
+              WHEN 'X'          => RETURN FALSE;
+              WHEN 'T'          => RETURN TRUE;
+              WHEN 'F'          => RETURN FALSE;
+              WHEN OTHERS       => null;
+            END CASE;
+        END LOOP;
+        RETURN TRUE;
+    end ;
+
+  FUNCTION le (l, r:SIGNED)           RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN
+        RETURN(TRUE) ;
+      ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN
+        RETURN(FALSE) ;
+      ELSE          
+        RETURN (le( lt, rt ));
+      END IF ;
+    END;
+
+    FUNCTION "<="  ( L,R : UNSIGNED ) RETURN boolean IS
+        CONSTANT ml  : integer := maximum( L'LENGTH, R'LENGTH );
+        VARIABLE lt  : UNSIGNED ( 1 to ml );
+        VARIABLE rt  : UNSIGNED ( 1 to ml );
+        VARIABLE res : std_logic_fuzzy_state;
+    begin
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'RANGE LOOP
+            res := le_lfuzzy_table( lt(i), rt(i) );
+            CASE res IS
+              WHEN 'U'          => RETURN FALSE;
+              WHEN 'X'          => RETURN FALSE;
+              WHEN 'T'          => RETURN TRUE;
+              WHEN 'F'          => RETURN FALSE;
+              WHEN OTHERS       => null;
+            END CASE;
+        END LOOP;
+        RETURN TRUE;
+    end ;
+
+  FUNCTION "<=" (l, r:SIGNED)           RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN
+        RETURN(TRUE) ;
+      ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN
+        RETURN(FALSE) ;
+      ELSE          
+        RETURN (le( lt, rt ));
+      END IF ;
+    END;
+
+--
+-- Greater Than or Equal to  functions.
+--
+    CONSTANT geb_table : stdlogic_boolean_table := (
+    --      ----------------------------------------------------------------------------
+    --      |  U       X      0     1      Z      W      L      H      D         |   |  
+    --      ----------------------------------------------------------------------------
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | U |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | X |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | 0 |
+    ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE ),  -- | 1 |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | Z |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | W |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ),  -- | L |
+    ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE ),  -- | H |
+    ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE )   -- | D |
+    );
+
+    FUNCTION ge  ( l, r : std_logic ) RETURN BOOLEAN IS
+    BEGIN
+        RETURN geb_table( l, r );
+    END ;
+
+    CONSTANT ge_fuzzy_table : std_ulogic_fuzzy_state_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+                ( 'U', 'U', 'N', 'U', 'U', 'U', 'N', 'U', 'U' ),  -- | U |
+	        ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ),  -- | X |
+	        ( 'U', 'X', 'N', 'F', 'X', 'X', 'N', 'F', 'X' ),  -- | 0 |
+	        ( 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N', 'N' ),  -- | 1 |
+	        ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ),  -- | Z |
+	        ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ),  -- | W |
+	        ( 'U', 'X', 'N', 'F', 'X', 'X', 'N', 'F', 'X' ),  -- | L |
+	        ( 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N', 'N' ),  -- | H |
+	        ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' )   -- | D |
+    );
+
+    FUNCTION ge  ( L,R : std_ulogic_vector ) RETURN boolean IS
+        CONSTANT ml  : integer := maximum( L'LENGTH, R'LENGTH );
+        VARIABLE lt  : std_ulogic_vector ( 1 to ml );
+        VARIABLE rt  : std_ulogic_vector ( 1 to ml );
+        VARIABLE res : std_ulogic_fuzzy_state;
+    begin
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'RANGE LOOP
+            res := ge_fuzzy_table( lt(i), rt(i) );
+            CASE res IS
+              WHEN 'U'          => RETURN FALSE;
+              WHEN 'X'          => RETURN FALSE;
+              WHEN 'T'          => RETURN TRUE;
+              WHEN 'F'          => RETURN FALSE;
+              WHEN OTHERS       => null;
+            END CASE;
+        END LOOP;
+        RETURN TRUE;
+    end ;
+
+    CONSTANT ge_lfuzzy_table : std_logic_fuzzy_state_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+                ( 'U', 'U', 'N', 'U', 'U', 'U', 'N', 'U', 'U' ),  -- | U |
+	        ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ),  -- | X |
+	        ( 'U', 'X', 'N', 'F', 'X', 'X', 'N', 'F', 'X' ),  -- | 0 |
+	        ( 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N', 'N' ),  -- | 1 |
+	        ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ),  -- | Z |
+	        ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ),  -- | W |
+	        ( 'U', 'X', 'N', 'F', 'X', 'X', 'N', 'F', 'X' ),  -- | L |
+	        ( 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N', 'N' ),  -- | H |
+	        ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' )   -- | D |
+    );
+
+    FUNCTION ge  ( L,R : std_logic_vector ) RETURN boolean IS
+        CONSTANT ml  : integer := maximum( L'LENGTH, R'LENGTH );
+        VARIABLE lt  : std_logic_vector ( 1 to ml );
+        VARIABLE rt  : std_logic_vector ( 1 to ml );
+        VARIABLE res : std_logic_fuzzy_state;
+    begin
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'RANGE LOOP
+            res := ge_lfuzzy_table( lt(i), rt(i) );
+            CASE res IS
+              WHEN 'U'          => RETURN FALSE;
+              WHEN 'X'          => RETURN FALSE;
+              WHEN 'T'          => RETURN TRUE;
+              WHEN 'F'          => RETURN FALSE;
+              WHEN OTHERS       => null;
+            END CASE;
+        END LOOP;
+        RETURN TRUE;
+    end ;
+
+    FUNCTION ge  ( L,R : UNSIGNED ) RETURN boolean IS
+        CONSTANT ml  : integer := maximum( L'LENGTH, R'LENGTH );
+        VARIABLE lt  : UNSIGNED ( 1 to ml );
+        VARIABLE rt  : UNSIGNED ( 1 to ml );
+        VARIABLE res : std_logic_fuzzy_state;
+    begin
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'RANGE LOOP
+            res := ge_lfuzzy_table( lt(i), rt(i) );
+            CASE res IS
+              WHEN 'U'          => RETURN FALSE;
+              WHEN 'X'          => RETURN FALSE;
+              WHEN 'T'          => RETURN TRUE;
+              WHEN 'F'          => RETURN FALSE;
+              WHEN OTHERS       => null;
+            END CASE;
+        END LOOP;
+        RETURN TRUE;
+    end ;
+
+    FUNCTION ge  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN
+        RETURN(FALSE) ;
+      ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN
+        RETURN(TRUE) ;
+      ELSE          
+        RETURN (ge( lt, rt ));
+      END IF ;
+    END;
+
+    FUNCTION ">="  ( L,R : UNSIGNED ) RETURN boolean IS
+        CONSTANT ml  : integer := maximum( L'LENGTH, R'LENGTH );
+        VARIABLE lt  : UNSIGNED ( 1 to ml );
+        VARIABLE rt  : UNSIGNED ( 1 to ml );
+        VARIABLE res : std_logic_fuzzy_state;
+    begin
+        lt := zxt( l, ml );
+        rt := zxt( r, ml );
+        FOR i IN lt'RANGE LOOP
+            res := ge_lfuzzy_table( lt(i), rt(i) );
+            CASE res IS
+              WHEN 'U'          => RETURN FALSE;
+              WHEN 'X'          => RETURN FALSE;
+              WHEN 'T'          => RETURN TRUE;
+              WHEN 'F'          => RETURN FALSE;
+              WHEN OTHERS       => null;
+            END CASE;
+        END LOOP;
+        RETURN TRUE;
+    end ;
+
+    FUNCTION ">="  ( l,r : SIGNED ) RETURN BOOLEAN IS
+        CONSTANT len  : INTEGER := maximum( l'length, r'length );
+        VARIABLE lt, rt  : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0');
+    BEGIN
+         assert l'length > 1 AND r'length > 1
+           report "SIGNED vector must be atleast 2 bits wide"
+           severity ERROR;
+      lt := (OTHERS => l(l'left)) ;
+      lt(l'length - 1 DOWNTO 0) := UNSIGNED(l);
+      rt := (OTHERS => r(r'left)) ;
+      rt(r'length - 1 DOWNTO 0) := UNSIGNED(r);
+      IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN
+        RETURN(FALSE) ;
+      ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN
+        RETURN(TRUE) ;
+      ELSE          
+        RETURN (ge( lt, rt ));
+      END IF ;
+    END;
+
+   -------------------------------------------------------------------------------
+   --  Logical Operations
+   -------------------------------------------------------------------------------
+
+	-- truth table for "and" function
+    CONSTANT and_table : stdlogic_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+            ( 'U', 'U', '0', 'U', 'U', 'U', '0', 'U', 'U' ),  -- | U |
+            ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ),  -- | X |
+            ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ),  -- | 0 |
+            ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | 1 |
+   	        ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ),  -- | Z |
+   	        ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ),  -- | W |
+   	        ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ),  -- | L |
+   	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | H |
+   	        ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' )   -- | D |
+    );
+
+	-- truth table for "or" function
+	CONSTANT or_table : stdlogic_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+                ( 'U', 'U', 'U', '1', 'U', 'U', 'U', '1', 'U' ),  -- | U |
+	        ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ),  -- | X |
+	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | 0 |
+	        ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ),  -- | 1 |
+	        ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ),  -- | Z |
+	        ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ),  -- | W |
+	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | L |
+	        ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ),  -- | H |
+	        ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' )   -- | D |
+    );
+
+
+	-- truth table for "xor" function
+	CONSTANT xor_table : stdlogic_table := (
+	--      ----------------------------------------------------
+	--      |  U    X    0    1    Z    W    L    H    D         |   |  
+	--      ----------------------------------------------------
+                ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ),  -- | U |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | X |
+	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | 0 |
+	        ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ),  -- | 1 |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | Z |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ),  -- | W |
+	        ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ),  -- | L |
+	        ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ),  -- | H |
+	        ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' )   -- | D |
+    );
+
+	-- truth table for "not" function
+	CONSTANT not_table: stdlogic_1D := 
+	--  -------------------------------------------------
+	--  |   U    X    0    1    Z    W    L    H    D   |
+	--  -------------------------------------------------
+	     ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ); 
+
+     FUNCTION "and"  ( arg1,arg2 : UNSIGNED ) RETURN UNSIGNED IS
+         CONSTANT ml  : integer := maximum( arg1'LENGTH, arg2'LENGTH );
+         VARIABLE lt  : UNSIGNED ( 1 to ml );
+         VARIABLE rt  : UNSIGNED ( 1 to ml );
+         VARIABLE res : UNSIGNED ( 1 to ml );
+     begin
+         lt := zxt( arg1, ml );
+         rt := zxt( arg2, ml );
+         FOR i IN res'RANGE LOOP
+             res(i) := and_table( lt(i), rt(i) );
+         END LOOP;
+         RETURN res; 
+     end "and";
+
+     FUNCTION "nand"  ( arg1,arg2 : UNSIGNED ) RETURN UNSIGNED IS
+         CONSTANT ml  : integer := maximum( arg1'LENGTH, arg2'LENGTH );
+         VARIABLE lt  : UNSIGNED ( 1 to ml );
+         VARIABLE rt  : UNSIGNED ( 1 to ml );
+         VARIABLE res : UNSIGNED ( 1 to ml );
+     begin
+         lt := zxt( arg1, ml );
+         rt := zxt( arg2, ml );
+         FOR i IN res'RANGE LOOP
+             res(i) := not_table( and_table( lt(i), rt(i) ) );
+         END LOOP;
+         RETURN res; 
+     end "nand";
+
+     FUNCTION "or"  ( arg1,arg2 : UNSIGNED ) RETURN UNSIGNED IS
+         CONSTANT ml  : integer := maximum( arg1'LENGTH, arg2'LENGTH );
+         VARIABLE lt  : UNSIGNED ( 1 to ml );
+         VARIABLE rt  : UNSIGNED ( 1 to ml );
+         VARIABLE res : UNSIGNED ( 1 to ml );
+     begin
+         lt := zxt( arg1, ml );
+         rt := zxt( arg2, ml );
+         FOR i IN res'RANGE LOOP
+             res(i) := or_table( lt(i), rt(i) );
+         END LOOP;
+         RETURN res; 
+     end "or";
+
+     FUNCTION "nor"  ( arg1,arg2 : UNSIGNED ) RETURN UNSIGNED IS
+         CONSTANT ml  : integer := maximum( arg1'LENGTH, arg2'LENGTH );
+         VARIABLE lt  : UNSIGNED ( 1 to ml );
+         VARIABLE rt  : UNSIGNED ( 1 to ml );
+         VARIABLE res : UNSIGNED ( 1 to ml );
+     begin
+         lt := zxt( arg1, ml );
+         rt := zxt( arg2, ml );
+         FOR i IN res'RANGE LOOP
+             res(i) := not_table( or_table( lt(i), rt(i) ) );
+         END LOOP;
+         RETURN res; 
+     end "nor";
+
+     FUNCTION "xor"  ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED IS
+         CONSTANT ml  : integer := maximum( arg1'LENGTH, arg2'LENGTH );
+         VARIABLE lt  : UNSIGNED ( 1 to ml );
+         VARIABLE rt  : UNSIGNED ( 1 to ml );
+         VARIABLE res : UNSIGNED ( 1 to ml );
+     begin
+         lt := zxt( arg1, ml );
+         rt := zxt( arg2, ml );
+         FOR i IN res'RANGE LOOP
+             res(i) := xor_table( lt(i), rt(i) );
+         END LOOP;
+         RETURN res; 
+     end "xor";
+
+     FUNCTION "not"  ( arg1 : UNSIGNED ) RETURN UNSIGNED IS
+         VARIABLE result : UNSIGNED ( arg1'RANGE ) := (Others => 'X');
+     begin
+         for i in result'range loop
+             result(i) := not_table( arg1(i) );
+         end loop;
+         return result;
+     end "not";
+
+     FUNCTION "and"  ( arg1,arg2 : SIGNED ) RETURN SIGNED IS
+       CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ;
+       VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+       VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+     BEGIN
+       a := (OTHERS => arg1(arg1'left)) ;
+       a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1);
+       b := (OTHERS => arg2(arg2'left)) ;
+       b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2);
+       answer := SIGNED(a and b);
+       RETURN (answer);
+     end "and";
+
+     FUNCTION "nand"  ( arg1,arg2 : SIGNED ) RETURN SIGNED IS
+       CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ;
+       VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+       VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+     BEGIN
+       a := (OTHERS => arg1(arg1'left)) ;
+       a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1);
+       b := (OTHERS => arg2(arg2'left)) ;
+       b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2);
+       answer := SIGNED(a nand b);
+       RETURN (answer);
+     end "nand";
+
+     FUNCTION "or"  ( arg1,arg2 : SIGNED ) RETURN SIGNED IS
+       CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ;
+       VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+       VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+     BEGIN
+       a := (OTHERS => arg1(arg1'left)) ;
+       a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1);
+       b := (OTHERS => arg2(arg2'left)) ;
+       b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2);
+       answer := SIGNED(a or b);
+       RETURN (answer);
+     end "or";
+
+     FUNCTION "nor"  ( arg1,arg2 : SIGNED ) RETURN SIGNED IS
+       CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ;
+       VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+       VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+     BEGIN
+       a := (OTHERS => arg1(arg1'left)) ;
+       a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1);
+       b := (OTHERS => arg2(arg2'left)) ;
+       b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2);
+       answer := SIGNED(a nor b);
+       RETURN (answer);
+     end "nor";
+
+     FUNCTION "xor"  ( arg1, arg2 : SIGNED ) RETURN SIGNED IS
+       CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ;
+       VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+       VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+     BEGIN
+       a := (OTHERS => arg1(arg1'left)) ;
+       a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1);
+       b := (OTHERS => arg2(arg2'left)) ;
+       b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2);
+       answer := SIGNED(a xor b);
+       RETURN (answer);
+     end "xor";
+
+     FUNCTION "not"  ( arg1 : SIGNED ) RETURN SIGNED IS
+         VARIABLE result : SIGNED ( arg1'RANGE ) := (Others => 'X');
+     begin
+         for i in result'range loop
+             result(i) := not_table( arg1(i) );
+         end loop;
+         return result;
+     end "not";
+
+     FUNCTION "xnor"  ( arg1, arg2 : std_ulogic_vector ) RETURN std_ulogic_vector IS
+         CONSTANT ml  : integer := maximum( arg1'LENGTH, arg2'LENGTH );
+         VARIABLE lt  : std_ulogic_vector ( 1 to ml );
+         VARIABLE rt  : std_ulogic_vector ( 1 to ml );
+         VARIABLE res : std_ulogic_vector ( 1 to ml );
+     begin
+         lt := zxt( arg1, ml );
+         rt := zxt( arg2, ml );
+         FOR i IN res'RANGE LOOP
+             res(i) := not_table( xor_table( lt(i), rt(i) ) );
+         END LOOP;
+         RETURN res; 
+     end "xnor";
+
+     FUNCTION "xnor"  ( arg1, arg2 : std_logic_vector ) RETURN std_logic_vector IS
+         CONSTANT ml  : integer := maximum( arg1'LENGTH, arg2'LENGTH );
+         VARIABLE lt  : std_logic_vector ( 1 to ml );
+         VARIABLE rt  : std_logic_vector ( 1 to ml );
+         VARIABLE res : std_logic_vector ( 1 to ml );
+     begin
+         lt := zxt( arg1, ml );
+         rt := zxt( arg2, ml );
+         FOR i IN res'RANGE LOOP
+             res(i) := not_table( xor_table( lt(i), rt(i) ) );
+         END LOOP;
+         RETURN res; 
+     end "xnor";
+
+     FUNCTION "xnor"  ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED IS
+         CONSTANT ml  : integer := maximum( arg1'LENGTH, arg2'LENGTH );
+         VARIABLE lt  : UNSIGNED ( 1 to ml );
+         VARIABLE rt  : UNSIGNED ( 1 to ml );
+         VARIABLE res : UNSIGNED ( 1 to ml );
+     begin
+         lt := zxt( arg1, ml );
+         rt := zxt( arg2, ml );
+         FOR i IN res'RANGE LOOP
+             res(i) := not_table( xor_table( lt(i), rt(i) ) );
+         END LOOP;
+         RETURN res; 
+     end "xnor";
+
+     FUNCTION "xnor"  ( arg1, arg2 : SIGNED ) RETURN SIGNED IS
+       CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ;
+       VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+       VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ;
+     BEGIN
+       a := (OTHERS => arg1(arg1'left)) ;
+       a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1);
+       b := (OTHERS => arg2(arg2'left)) ;
+       b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2);
+       answer := SIGNED(a xnor b);
+       RETURN (answer);
+     end "xnor";
+     
+END ;
diff --git a/libraries/std/textio.vhdl b/libraries/std/textio.vhdl
new file mode 100644
index 000000000..71b3ca72e
--- /dev/null
+++ b/libraries/std/textio.vhdl
@@ -0,0 +1,130 @@
+--  Std.Textio package declaration.  This file is part of GHDL.
+--  This file was written from the clause 14.3 of the VHDL LRM.
+--  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 textio is
+
+-- type definitions for text i/o
+
+  -- a LINE is a pointer to a string value.
+  type line is access string;
+
+  --  A file of variable-length ASCII records.
+  --  Note: in order to work correctly, the TEXT file type must be declared in
+  --  the textio package of library std.  Otherwise, a file of string has a
+  --  non-ASCII format.
+  type text is file of string;
+
+  type side is (right, left);	-- For justifying ouput data within fields.
+  subtype width is natural;	-- For specifying widths of output fields.
+
+-- standard text files
+
+  file input:  text is in "STD_INPUT";  --V87
+  file output: text is out "STD_OUTPUT";  --V87
+  file input : text open read_mode is "STD_INPUT";  --V93
+  file output : text open write_mode is "STD_OUTPUT";  --V93
+
+-- input routines for standard types
+
+  procedure readline (variable f: in text; l: inout line); --V87
+  procedure readline (file f: text; l: inout line); --V93
+
+  --  For READ procedures:
+  --  In this implementation, any L is accepted (ie, there is no constraints
+  --  on direction, or left bound).  Therefore, even variable of type LINE
+  --  not initialized by READLINE are accepted.  Strictly speaking, this is
+  --  not required by LRM, nor prevented.  However, other implementations may
+  --  fail at parsing such strings.
+  --
+  --  Also, in case of error (GOOD is false), this implementation do not
+  --  modify L (as specified by the LRM) nor VALUE.
+  --
+  --  For READ procedures without a GOOD argument, an assertion fails in case
+  --  of error.
+  --
+  --  In case of overflow (ie, if the number is out of the bounds of the type),
+  --  the procedure will fail with an execution error.
+  --  FIXME: this should not occur for a bad string.
+
+  procedure read (l: inout line; value: out bit; good: out boolean);
+  procedure read (l: inout line; value: out bit); 
+
+  procedure read (l: inout line; value: out bit_vector; good: out boolean);
+  procedure read (l: inout line; value: out bit_vector);
+
+  procedure read (l: inout line; value: out boolean; good: out boolean);
+  procedure read (l: inout line; value: out boolean);
+
+  procedure read (l: inout line; value: out character; good: out boolean);
+  procedure read (l: inout line; value: out character); 
+
+  procedure read (l: inout line; value: out integer; good: out boolean);
+  procedure read (l: inout line; value: out integer);
+
+  procedure read (l: inout line; value: out real; good: out boolean);
+  procedure read (l: inout line; value: out real);
+
+  procedure read (l: inout line; value: out string; good: out boolean);
+  procedure read (l: inout line; value: out string);
+
+  --  This implementation requires no space after the unit identifier,
+  --  ie "7.5 nsv" is parsed as 7.5 ns.
+  --  The unit identifier can be in lower case, upper case or mixed case.
+  procedure read (l: inout line; value: out time; good: out boolean);
+  procedure read (l: inout line; value: out time);
+
+-- output routines for standard types
+
+  procedure writeline (variable f: out text; l: inout line); --V87
+  procedure writeline (file f: text; l: inout line); --V93
+
+  --  This implementation accept any value for all the types.
+  procedure write 
+    (l: inout line; value: in bit;
+    justified: in side := right; field: in width := 0);
+  procedure write 
+    (l: inout line; value: in bit_vector;
+    justified: in side := right; field: in width := 0);
+  procedure write
+    (l: inout line; value: in boolean;
+    justified: in side := right; field: in width := 0);
+  procedure write
+    (l: inout line; value: in character;
+    justified: in side := right; field: in width := 0);
+  procedure write
+    (l: inout line; value: in integer;
+    justified: in side := right; field: in width := 0);
+  procedure write
+    (L: inout line; value: in real;
+    justified: in side := right; field: in width := 0;
+    digits: in natural := 0);
+  procedure write 
+    (l: inout line; value: in string;
+    justified: in side := right; field: in width := 0);
+
+  --  UNIT must be a unit name declared in std.standard.  Of course, no rules
+  --  in the core VHDL language prevent you from using a value that is not a
+  --  unit (eg: 10 ns or even 5 fs).
+  --  An assertion error message is generated in this case, and question mark
+  --  (?) is written at the place of the unit name.
+  procedure write
+    (l: inout line; value : in time;
+    justified: in side := right; field: in width := 0; unit : in TIME := ns);
+
+end textio;
diff --git a/libraries/std/textio_body.vhdl b/libraries/std/textio_body.vhdl
new file mode 100644
index 000000000..0362ef61a
--- /dev/null
+++ b/libraries/std/textio_body.vhdl
@@ -0,0 +1,1320 @@
+--  Std.Textio package body.  This file is part of GHDL.
+--  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 body textio is
+  -- output routines for standard types
+
+  --  TIME_NAMES associates time units with textual names.
+  --  Textual names are in lower cases, since according to LRM93 14.3:
+  --   when written, the identifier is expressed in lowercase characters.
+  --  The length of the names are 3 characters, the last one may be a space
+  --  for 2 characters long names.
+  type time_unit is
+    record
+      val : time;
+      name : string (1 to 3);
+    end record;
+  type time_names_type is array (1 to 8) of time_unit;
+  constant time_names : time_names_type :=
+    ((fs, "fs "), (ps, "ps "), (ns, "ns "), (us, "us "),
+     (ms, "ms "), (sec, "sec"), (min, "min"), (hr, "hr "));
+
+  --  Non breaking space character.                     --V93
+  constant nbsp : character := character'val (160);	--V93
+
+  procedure writeline (f: out text; l: inout line) is --V87
+  procedure writeline (file f: text; l: inout line) is --V93
+  begin
+    if l = null then
+      -- LRM93 14.3
+      -- If parameter L contains a null access value at the start of the call,
+      -- the a null string is written to the file.
+      write (f, "");
+    else
+      -- LRM93 14.3
+      -- Procedure WRITELINE causes the current line designated by parameter L
+      -- to be written to the file and returns with the value of parameter L
+      -- designating a null string.
+      write (f, l.all);
+      deallocate (l);
+      l := new string'("");
+    end if;
+  end writeline;
+
+  procedure write
+    (l: inout line; value: in string;
+    justified: in side := right; field: in width := 0)
+  is
+    variable length: natural;
+    variable nl: line;
+  begin
+    -- l can be null.
+    if l = null then
+      length := 0;
+    else
+      length := l.all'length;
+    end if;
+    if value'length < field then
+      nl := new string (1 to length + field);
+      if length /= 0 then
+        nl (1 to length) := l.all;
+      end if;
+      if justified = right then
+        nl (length + 1 to length + field - value'length) := (others => ' ');
+        nl (nl.all'high - value'length + 1 to nl.all'high) := value;
+      else
+        nl (length + 1 to length + value'length) := value;
+        nl (length + value'length + 1 to nl.all'high) := (others => ' ');
+      end if;
+    else
+      nl := new string (1 to length + value'length);
+      if length /= 0 then
+        nl (1 to length) := l.all;
+      end if;
+      nl (length + 1 to nl.all'high) := value;
+    end if;
+    deallocate (l);
+    l := nl;
+  end write;
+
+  procedure write
+    (l: inout line; value: in integer;
+    justified: in side := right; field: in width := 0)
+  is
+    variable str: string (11 downto 1);
+    variable val: integer := value;
+    variable digit: natural;
+    variable index: natural := 0;
+  begin
+    --  Note: the absolute value of VAL cannot be directly taken, since
+    --  it may be greather that the maximum value of an INTEGER.
+    loop
+      --  LRM93 7.2.6
+      --  (A rem B) has the sign of A and an absolute value less then
+      --   the absoulte value of B.
+      digit := abs (val rem 10);
+      val := val / 10;
+      index := index + 1;
+      str (index) := character'val(48 + digit);
+      exit when val = 0;
+    end loop;
+    if value < 0 then
+      index := index + 1;
+      str(index) := '-';
+    end if;
+    write (l, str (index downto 1), justified, field);
+  end write;
+
+  procedure write
+    (l: inout line; value: in boolean;
+    justified: in side := right; field: in width := 0)
+  is
+  begin
+    if value then
+      write (l, string'("TRUE"), justified, field);
+    else
+      write (l, string'("FALSE"), justified, field);
+    end if;
+  end write;
+
+  procedure write
+    (l: inout line; value: in character;
+    justified: in side := right; field: in width := 0)
+  is
+    variable str: string (1 to 1);
+  begin
+    str (1) := value;
+    write (l, str, justified, field);
+  end write;
+
+  function bit_to_char (value : in bit) return character is
+  begin
+    case value is
+      when '0' =>
+        return '0';
+      when '1' =>
+        return '1';
+    end case;
+  end bit_to_char;
+
+  procedure write
+    (l: inout line; value: in bit;
+    justified: in side := right; field: in width := 0)
+  is
+    variable str : string (1 to 1);
+  begin
+    str (1) := bit_to_char (value);
+    write (l, str, justified, field);
+  end write;
+
+  procedure write
+    (l: inout line; value: in bit_vector;
+    justified: in side := right; field: in width := 0)
+  is
+    constant length : natural := value'length;
+    alias n_value : bit_vector (1 to value'length) is value;
+    variable str : string (1 to length);
+  begin
+    for i in str'range loop
+      str (i) := bit_to_char (n_value (i));
+    end loop;
+    write (l, str, justified, field);
+  end write;
+
+  procedure write
+    (l: inout line; value : in time;
+    justified: in side := right; field: in width := 0; unit : in TIME := ns)
+  is
+    --  Copy of VALUE on which we are working.
+    variable val : time := value;
+
+    --  Copy of UNIT on which we are working.
+    variable un : time := unit;
+
+    --  Digit extract from VAL/UN.
+    variable d : integer; -- natural range 0 to 9;
+
+    --  Index for unit name.
+    variable n : integer;
+
+    --  Result.
+    variable str : string (1 to 28);
+
+    --  Current character in RES.
+    variable pos : natural := 1;
+
+    --  Add a character to STR.
+    procedure add_char (c : character) is
+    begin
+      str (pos) := c;
+      pos := pos + 1;
+    end add_char;
+  begin
+    --  Note:
+    --  Care is taken to avoid overflow.  Time may be 64 bits while integer
+    --   may be only 32 bits.
+
+    --  Handle sign.
+    --  Note: VAL cannot be negated since its range may be not symetric
+    --  around 0.
+    if val < 0 ns then
+      add_char ('-');
+    end if;
+
+    --  Search for the first digit.
+    --  Note: we must start from unit, since all units are not a power of 10.
+    --  Note: UN can be multiplied only after we know it is possible.  This
+    --   is a to avoid overflow.
+    if un <= 0 fs then
+      assert false report "UNIT argument is not positive" severity error;
+      un := 1 ns;
+    end if;
+    while val / 10 >= un or val / 10 <= -un loop
+      un := un * 10;
+    end loop;
+
+    --  Extract digits one per one.
+    loop
+      d := val / un;
+      add_char (character'val (abs d + character'pos ('0')));
+      val := val - d * un;
+      exit when val = 0 ns and un <= unit;
+      if un = unit then
+	add_char ('.');
+      end if;
+      --  Stop as soon as precision will be lost.
+      --  This can happen only for hr and min.
+      --  FIXME: change the algorithm to display all the digits.
+      exit when (un / 10) * 10 /= un;
+      un := un / 10;
+    end loop;
+
+    add_char (' ');
+
+    --  Search the time unit name in the time table.
+    n := 0;
+    for i in time_names'range loop
+      if time_names (i).val = unit then
+	n := i;
+	exit;
+      end if;
+    end loop;
+    assert n /= 0 report "UNIT argument is not a unit name" severity error;
+    if n = 0 then
+      add_char ('?');
+    else
+      add_char (time_names (n).name (1));
+      add_char (time_names (n).name (2));
+      if time_names (n).name (3) /= ' ' then
+	add_char (time_names (n).name (3));
+      end if;
+    end if;
+
+    --  Write the result.
+    write (l, str (1 to pos - 1), justified, field);
+  end write;
+
+  -- Parameter DIGITS specifies how many digits to the right of the decimal
+  -- point are to be output when writing a real number; the default value 0
+  -- indicates that the number should be output in standard form, consisting
+  -- of a normalized mantissa plus exponent (e.g., 1.079236E23). If DIGITS is
+  -- nonzero, then the real number is output as an integer part followed by
+  -- '.' followed by the fractional part, using the specified number of digits
+  -- (e.g., 3.14159).
+  -- Note: Nan, +Inf, -Inf are not to be considered, since these numbers are
+  --  not in the bounds defined by any real range.
+  procedure write (L: inout line; value: in real;
+                   justified: in side := right; field: in width := 0;
+		   digits: in natural := 0)
+  is
+    --  STR contains the result of the conversion.
+    variable str : string (1 to 320);
+
+    --  POS is the index of the next character to be put in STR.
+    variable pos : positive := str'left;
+
+    --  VAL contains the value to be converted.
+    variable val : real;
+
+    --  The exponent or mantissa computed is stored in MANTISSA.  This is
+    --  a signed number.
+    variable mantissa : integer;
+
+    variable b : boolean;
+    variable d : natural;
+
+    --  Append character C in STR.
+    procedure add_char (c : character) is
+    begin
+      str (pos) := c;
+      pos := pos + 1;
+    end add_char;
+
+    --  Add digit V in STR.
+    procedure add_digit (v : natural) is
+    begin
+      add_char (character'val (character'pos ('0') + v));
+    end add_digit;
+
+    --  Add leading digit and substract it.
+    procedure extract_leading_digit is
+      variable d : natural range 0 to 10;
+    begin
+      --  Note: We need truncation but type conversion does rounding.
+      --  FIXME: should consider precision.
+      d := natural (val);
+      if real (d) > val then
+	d := d - 1;
+      end if;
+
+      val := (val - real (d)) * 10.0;
+
+      add_digit (d);
+    end extract_leading_digit;
+  begin
+    --  Handle sign.
+    --  There is no overflow here, since with IEEE implementations, sign is
+    --  independant of the mantissa.
+    --  LRM93 14.3
+    --  The sign is never written if the value is non-negative.
+    if value < 0.0 then
+      add_char ('-');
+      val := -value;
+    else
+      val := value;
+    end if;
+
+    --  Compute the mantissa.
+    --  FIXME: should do a dichotomy.
+    if val = 0.0 then
+      mantissa := 0;
+    elsif val < 1.0 then
+      mantissa := -1;
+      while val * (10.0 ** (-mantissa)) < 1.0 loop
+	mantissa := mantissa - 1;
+      end loop;
+    else
+      mantissa := 0;
+      while val / (10.0 ** mantissa) >= 10.0 loop
+	mantissa := mantissa + 1;
+      end loop;
+    end if;
+
+    --  Normalize VAL: in [0; 10[
+    if mantissa >= 0 then
+      val := val / (10.0 ** mantissa);
+    else
+      val := val * 10.0 ** (-mantissa);
+    end if;
+
+    if digits = 0 then
+      for i in 0 to 15 loop
+	extract_leading_digit;
+
+	if i = 0 then
+	  add_char ('.');
+	end if;
+	exit when i > 0 and val < 10.0 ** (i + 1 - 15);
+      end loop;
+
+      --  LRM93 14.3
+      --  if the exponent is present, the `e' is written as a lower case 
+      --  character.
+      add_char ('e');
+
+      if mantissa < 0 then
+	add_char ('-');
+	mantissa := -mantissa;
+      end if;
+      b := false;
+      for i in 4 downto 0 loop
+	d := (mantissa / 10000) mod 10;
+	if d /= 0 or b or i = 0 then
+	  add_digit (d);
+	  b := true;
+	end if;
+	mantissa := (mantissa - d * 10000) * 10;
+      end loop;
+    else
+      if mantissa < 0 then
+	add_char ('0');
+	mantissa := mantissa + 1;
+      else
+	loop
+	  extract_leading_digit;
+	  exit when mantissa = 0;
+	  mantissa := mantissa - 1;
+	end loop;
+      end if;
+      add_char ('.');
+      for i in 1 to digits loop
+	if mantissa = 0 then
+	  extract_leading_digit;
+	else
+	  add_char ('0');
+	  mantissa := mantissa + 1;
+	end if;
+      end loop;
+    end if;
+    write (l, str (1 to pos - 1), justified, field);
+  end write;
+
+  procedure untruncated_text_read                              --V87
+    (variable f : text; str : out string; len : out natural);  --V87
+  procedure untruncated_text_read                              --V93
+    (file f : text; str : out string; len : out natural);      --V93
+
+  attribute foreign : string;                                  --V87
+  attribute foreign of untruncated_text_read : procedure is "GHDL intrinsic";
+
+  procedure untruncated_text_read
+    (variable f : text; str : out string; len : out natural) is    --V87
+    (file f : text; str : out string; len : out natural) is    --V93
+  begin
+    assert false report "must not be called" severity failure;
+  end untruncated_text_read;
+  
+  procedure readline (variable f: in text; l: inout line) --V87
+  procedure readline (file f: text; l: inout line) --V93
+  is
+    variable len, nlen, posn : natural;
+    variable nl, old_l : line;
+    variable str : string (1 to 128);
+    variable is_eol : boolean;
+  begin
+    --  LRM93 14.3
+    --  If parameter L contains a non-null access value at the start of the
+    --  call, the object designated by that value is deallocated before the
+    --  new object is created.
+    if l /= null then
+      deallocate (l);
+    end if;
+    
+    -- We read the input in 128-byte chunks.
+    -- We keep reading until we reach a newline or there is no more input.
+    -- The loop invariant is that old_l is allocated and contains the
+    -- previous chunks read, and posn = old_l.all'length.
+    posn := 0;
+    loop
+      untruncated_text_read (f, str, len);
+      exit when len = 0;
+      if str (len) = LF then
+        --  LRM 14.3
+        --  The representation of the line does not contain the representation
+        --  of the end of the line.
+        is_eol := true;
+        len := len - 1;
+      else
+        is_eol := false;
+      end if;        
+      l := new string (1 to posn + len);
+      if old_l /= null then
+        l (1 to posn) := old_l (1 to posn);
+        deallocate (old_l);
+      end if;
+      l (posn + 1 to posn + len) := str (1 to len);
+      exit when is_eol;
+      posn := posn + len;
+      old_l := l;
+    end loop;
+  end readline;
+
+  --  Replaces L with L (LEFT to/downto L'RIGHT)
+  procedure trim (l : inout line; left : natural)
+  is
+    variable nl : line;
+  begin
+    if l = null then
+      return;
+    end if;
+    if l'left < l'right then
+      --  Ascending.
+      if left > l'right then
+	nl := new string'("");
+      else
+	nl := new string (left to l'right);
+--      nl := new string (1 to l'right + 1 - left);
+	nl.all := l (left to l'right);
+      end if;
+    else
+      --  Descending
+      if left < l'right then
+	nl := new string'("");
+      else
+	nl := new string (left downto l'right);
+--      nl := new string (left - l'right + 1 downto 1);
+	nl.all := l (left downto l'right);
+      end if;
+    end if;
+    deallocate (l);
+    l := nl;
+  end trim;
+
+  --  Replaces L with L (LEFT + 1 to L'RIGHT or LEFT - 1 downto L'RIGHT)
+  procedure trim_next (l : inout line; left : natural)
+  is
+    variable nl : line;
+  begin
+    if l = null then
+      return;
+    end if;
+    if l'left < l'right then
+      --  Ascending.
+      trim (l, left + 1);
+    else
+      --  Descending
+      trim (l, left - 1);
+    end if;
+  end trim_next;
+
+  function to_lower (c : character) return character is
+  begin
+    if c >= 'A' and c <= 'Z' then
+      return character'val (character'pos (c) + 32);
+    else
+      return c;
+    end if;
+  end to_lower;
+
+  procedure read (l: inout line; value: out character; good: out boolean)
+  is
+    variable nl : line;
+  begin
+    if l'length = 0 then
+      good := false;
+    else
+      value := l (l'left);
+      trim_next (l, l'left);
+      good := true;
+    end if;
+  end read;
+
+  procedure read (l: inout line; value: out character)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "character read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out bit; good: out boolean)
+  is
+  begin
+    good := false;
+    for i in l'range loop
+      case l(i) is
+	when ' ' 
+	  | NBSP --V93
+	  | HT =>
+	  null;
+	when '1' =>
+	  value := '1';
+	  good := true;
+	  trim_next (l, i);
+	  return;
+	when '0' =>
+	  value := '0';
+	  good := true;
+	  trim_next (l, i);
+	  return;
+	when others =>
+	  return;
+      end case;
+    end loop;
+    return;
+  end read;
+
+  procedure read (l: inout line; value: out bit)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "bit read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out bit_vector; good: out boolean)
+  is
+    --  Number of bit to parse.
+    variable len : natural;
+
+    variable pos, last : natural;
+    variable res : bit_vector (1 to value'length);
+
+    --  State of the previous byte:
+    --  LEADING: blank before the bit vector.
+    --  FOUND: bit of the vector.
+    type state_type is (leading, found);
+    variable state : state_type;
+  begin
+    --  Initialization.
+    len := value'length;
+    if len = 0 then
+      --  If VALUE is a nul array, return now.
+      --  L stay unchanged.
+      --  FIXME: should blanks be removed ?
+      good := true;
+      return;
+    end if;
+    good := false;
+    state := leading;
+    pos := res'left;
+    for i in l'range loop
+      case l(i) is
+	when ' ' 
+	  | NBSP --V93
+	  | HT =>
+	  case state is
+	    when leading =>
+	      null;
+	    when found =>
+	      return;
+	  end case;
+	when '1' | '0' =>
+	  case state is
+	    when leading =>
+	      state := found;
+	    when found =>
+	      null;
+	  end case;
+	  if l(i) = '0' then
+	    res (pos) := '0';
+	  else
+	    res (pos) := '1';
+	  end if;
+	  pos := pos + 1;
+	  len := len - 1;
+	  last := i;
+	  exit when len = 0;
+	when others =>
+	  return;
+      end case;
+    end loop;
+    
+    if len /= 0 then
+      --  Not enough bits.
+      return;
+    end if;
+
+    --  Note: if LEN = 0, then FIRST and LAST have been set.
+    good := true;
+    value := res;
+    trim_next (l, last);
+    return;
+  end read;
+
+  procedure read (l: inout line; value: out bit_vector)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "bit_vector read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out boolean; good: out boolean)
+  is
+    --  State:
+    --  BLANK: space are being scaned.
+    --  L_TF : T(rue) or F(alse) has been scanned.
+    --  L_RA : (t)R(ue) or (f)A(lse) has been scanned.
+    --  L_UL : (tr)U(e) or (fa)L(se) has been scanned.
+    --  L_ES : (tru)E or (fal)S(e) has been scanned.
+    type state_type is (blank, l_tf, l_ra, l_ul, l_es);
+    variable state : state_type;
+    
+    --  Set to TRUE if T has been scanned, to FALSE if F has been scanned.
+    variable res : boolean;
+  begin
+    --  By default, it is a failure.
+    good := false;
+    state := blank;
+    for i in l'range loop
+      case state is
+	when blank =>
+	  if l (i) = ' '
+	    or l (i) = nbsp --V93
+	    or l (i) = HT
+	  then
+	    null;
+	  elsif to_lower (l (i)) = 't' then
+	    res := true;
+	    state := l_tf;
+	  elsif to_lower (l (i)) = 'f' then
+	    res := false;
+	    state := l_tf;
+	  else
+	    return;
+	  end if;
+	when l_tf =>
+	  if res = true and to_lower (l (i)) = 'r' then
+	    state := l_ra;
+	  elsif res = false and to_lower (l (i)) = 'a' then
+	    state := l_ra;
+	  else
+	    return;
+	  end if;
+	when l_ra =>
+	  if res = true and to_lower (l (i)) = 'u' then
+	    state := l_ul;
+	  elsif res = false and to_lower (l (i)) = 'l' then
+	    state := l_ul;
+	  else
+	    return;
+	  end if;
+	when l_ul =>
+	  if res = true and to_lower (l (i)) = 'e' then
+	    trim_next (l, i);
+	    good := true;
+	    value := true;
+	    return;
+	  elsif res = false and to_lower (l (i)) = 's' then
+	    state := l_es;
+	  else
+	    return;
+	  end if;
+	when l_es =>
+	  if res = false and to_lower (l (i)) = 'e' then
+	    trim_next (l, i);
+	    good := true;
+	    value := false;
+	    return;
+	  else
+	    return;
+	  end if;
+      end case;
+    end loop;
+    return;
+  end read;
+
+  procedure read (l: inout line; value: out boolean)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "boolean read failure"
+      severity failure;
+  end read;
+
+  function char_to_nat (c : character) return natural
+  is
+  begin
+    return character'pos (c) - character'pos ('0');
+  end char_to_nat;
+	
+  procedure read (l: inout line; value: out integer; good: out boolean)
+  is
+    variable val : integer;
+    variable d : natural;
+
+    type state_t is (leading, sign, digits);
+    variable cur_state : state_t := leading;
+  begin
+    val := 1;
+    for i in l'range loop
+      case cur_state is
+	when leading =>
+	  case l(i) is
+	    when ' ' 
+	      | NBSP	--V93
+	      | ht =>
+	      null;
+	    when '+' =>
+	      cur_state := sign;
+	    when '-' =>
+	      val := -1;
+	      cur_state := sign;
+	    when '0' to '9' =>
+	      val := char_to_nat (l(i));
+	      cur_state := digits;
+	    when others =>
+	      good := false;
+	      return;
+	  end case;
+	when sign =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      val := val * char_to_nat (l(i));
+	      cur_state := digits;
+	    when others =>
+	      good := false;
+	      return;
+	  end case;
+	when digits =>
+	  case l(i) is
+	    when '0' to '9' =>
+              d := char_to_nat (l(i));
+	      val := val * 10;
+              if val < 0 then
+                val := val - d;
+              else
+                val := val + d;
+              end if;
+	    when others =>
+	      trim (l, i);
+	      good := true;
+	      value := val;
+	      return;
+	  end case;
+      end case;
+    end loop;
+    deallocate (l);
+    l := new string'("");
+    if cur_state /= leading then
+      good := true;
+      value := val;
+    else
+      good := false;
+    end if;
+  end read;
+
+  procedure read (l: inout line; value: out integer)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "integer read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out real; good: out boolean)
+  is
+    --  The result.
+    variable val : real;
+    --  True if the result is negative.
+    variable val_neg : boolean;
+
+    --  Number of digits after the dot.
+    variable nbr_dec : natural;
+
+    --  Value of the exponent.
+    variable exp : integer;
+    --  True if the exponent is negative.
+    variable exp_neg : boolean;
+
+    --  The parsing is done with a state machine.
+    --  LEADING: leading blank suppression.
+    --  SIGN: a sign has been found.
+    --  DIGITS: integer parts
+    --  DECIMALS: digits after the dot.
+    --  EXPONENT_SIGN: sign after "E"
+    --  EXPONENT_1: first digit of the exponent.
+    --  EXPONENT: digits of the exponent.
+    type state_t is (leading, sign, digits, decimals,
+		     exponent_sign, exponent_1, exponent);
+    variable cur_state : state_t := leading;
+
+    --  Set VALUE to the result, and set GOOD to TRUE.
+    procedure set_value is
+    begin
+      good := true;
+
+      if exp_neg then
+	val := val * 10.0 ** (-exp);
+      else
+	val := val * 10.0 ** exp;
+      end if;
+      if val_neg then
+	value := -val;
+      else
+	value := val;
+      end if;
+    end set_value;
+
+  begin
+    --  Initialization.
+    val_neg := false;
+    nbr_dec := 1;
+    exp := 0;
+    exp_neg := false;
+
+    --  By default, parsing has failed.
+    good := false;
+
+    --  Iterate over all characters of the string.
+    --  Return immediatly in case of parse error.
+    --  Trim L and call SET_VALUE and return in case of success.
+    for i in l'range loop
+      case cur_state is
+	when leading =>
+	  case l(i) is
+	    when ' '
+	      | NBSP	--V93
+	      | ht =>
+	      null;
+	    when '+' =>
+	      cur_state := sign;
+	    when '-' =>
+	      val_neg := true;
+	      cur_state := sign;
+	    when '0' to '9' =>
+	      val := real (char_to_nat (l(i)));
+	      cur_state := digits;
+	    when others =>
+	      return;
+	  end case;
+	when sign =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      val := real (char_to_nat (l(i)));
+	      cur_state := digits;
+	    when others =>
+	      return;
+	  end case;
+	when digits =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      val := val * 10.0 + real (char_to_nat (l(i)));
+	    when '.' =>
+	      cur_state := decimals;
+	    when others =>
+	      --  A "." (dot) is required in the string.
+	      return;
+	  end case;
+	when decimals =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      val := val + real (char_to_nat (l(i))) / (10.0 ** nbr_dec);
+	      nbr_dec := nbr_dec + 1;
+	    when 'e' | 'E' =>
+	      --  "nnn.E" is erroneous.
+	      if nbr_dec = 1 then
+		return;
+	      end if;
+	      cur_state := exponent_sign;
+	    when others =>
+	      --  "nnn.XX" is erroneous.
+	      if nbr_dec = 1 then
+		return;
+	      end if;
+	      trim (l, i);
+	      set_value;
+	      return;
+	  end case;
+	when exponent_sign =>
+	  case l(i) is
+	    when '+' =>
+	      cur_state := exponent_1;
+	    when '-' =>
+	      exp_neg := true;
+	      cur_state := exponent_1;
+	    when '0' to '9' =>
+	      exp := char_to_nat (l(i));
+	      cur_state := exponent;
+	    when others =>
+	      --  Error.
+	      return;
+	  end case;
+	when exponent_1 | exponent =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      exp := exp * 10 + char_to_nat (l(i));
+	      cur_state := exponent;
+	    when others =>
+	      trim (l, i);
+	      set_value;
+	      return;
+	  end case;
+      end case;
+    end loop;
+    
+    --  End of string.
+    case cur_state is
+      when leading | sign | digits =>
+	--  Erroneous.
+	return;
+      when decimals =>
+	--  "nnn.XX" is erroneous.
+	if nbr_dec = 1 then
+	  return;
+	end if;
+      when exponent_sign =>
+	--  Erroneous ("NNN.NNNE")
+	return;
+      when exponent_1 =>
+	--  "NNN.NNNE-"
+	return;
+      when exponent =>
+	null;
+    end case;
+
+    deallocate (l);
+    l := new string'("");
+    set_value;
+  end read;
+
+  procedure read (l: inout line; value: out real)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "real read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out time; good: out boolean)
+  is
+    --  The result.
+    variable res : time;
+
+    --  UNIT is computed from the unit name, the exponent and the number of
+    --  digits before the dot.  UNIT is the weight of the current digit.
+    variable unit : time;
+
+    --  Number of digits before the dot.
+    variable nbr_digits : integer;
+
+    --  True if a unit name has been found.  Used temporaly to know the status
+    --  at the end of the search loop.
+    variable unit_found : boolean;
+
+    --  True if the number is negative.
+    variable is_neg : boolean;
+
+    --  Value of the exponent.
+    variable exp : integer;
+
+    --  True if the exponent is negative.
+    variable exp_neg : boolean;
+
+    --  Unit name extracted from the string.
+    variable unit_name : string (1 to 3);
+
+    --  state is the kind of the previous character parsed.
+    --  LEADING: leading blanks
+    --  SIGN: + or - as the first character of the number.
+    --  DIGITS: digit of the integer part of the number.
+    --  DOT: dot (.) after the integer part and before the decimal part.
+    --  DECIMALS: digit of the decimal part.
+    --  EXPONENT_MARK: e or E.
+    --  EXPONENT_SIGN: + or - just after the exponent mark (E).
+    --  EXPONENT: digit of the exponent.
+    --  UNIT_BLANK: blank after the exponent.
+    --  UNIT_1, UNIT_2, UNIT_3: first, second, third character of the unit.
+    type state_type is (leading, sign, digits, dot, decimals,
+			exponent_mark, exponent_sign, exponent,
+			unit_blank, unit_1, unit_2, unit_3);
+    variable state : state_type;
+
+    --  Used during the second scan of the string, TRUE is digits is being
+    --  scaned.
+    variable has_digits : boolean;
+
+    --  Position at the end of the string.
+    variable pos : integer;
+
+    --  Used to compute POS.
+    variable length : integer;
+  begin
+    --  Initialization.
+    --  Fail by default; therefore, in case of error, a return statement is
+    --  ok.
+    good := false;
+    
+    nbr_digits := 0;
+    is_neg := false;
+    exp := 0;
+    exp_neg := false;
+    res := 0 fs;
+
+    --  Look for exponent and unit name.
+    --  Parse the string: this loop checks the correctness of the format, and
+    --  must return (GOOD has been set to FALSE) in case of error.
+    --  Set: NBR_DIGITS, IS_NEG, EXP, EXP_NEG.
+    state := leading;
+    for i in l'range loop
+      case l (i) is
+	when ' '
+	  | NBSP  --V93
+	  | HT =>
+	  case state is
+	    when leading | unit_blank =>
+	      null;
+	    when sign | dot | exponent_mark | exponent_sign =>
+	      return;
+	    when digits | decimals | exponent =>
+	      state := unit_blank;
+	    when unit_1 | unit_2 =>
+	      exit;
+	    when unit_3 =>
+	      --  Cannot happen, since an exit is performed at unit_3.
+	      assert false report "internal error" severity failure;
+	  end case;
+	when '+' | '-' =>
+	  case state is
+	    when leading =>
+	      if l(i) = '-' then
+		is_neg := true;
+	      end if;
+	      state := sign;
+	    when exponent_mark =>
+	      if l(i) = '-' then
+		exp_neg := true;
+	      end if;
+	      state := exponent_sign;
+	    when others =>
+	      return;
+	  end case;
+	when '0' to '9' =>
+	  case state is
+	    when exponent_mark | exponent_sign | exponent =>
+	      exp := exp * 10 + char_to_nat (l (i));
+	      state := exponent;
+	    when leading | sign | digits =>
+	      --  Leading "0" are not significant.
+	      if nbr_digits > 0 or l (i) /= '0' then
+		nbr_digits := nbr_digits + 1;
+	      end if;
+	      state := digits;
+	    when decimals =>
+	      null;
+	    when dot =>
+	      state := decimals;
+	    when others =>
+	      return;
+	  end case;
+	when 'a' to 'z' | 'A' to 'Z' =>
+	  case state is
+ 	    when digits | decimals =>
+	      --  "E" has exponent mark.
+	      if l (i) = 'e' or l(i) = 'E' then
+		state := exponent_mark;
+	      else
+		return;
+	      end if;
+	    when unit_blank =>
+	      unit_name (1) := to_lower (l(i));
+	      state := unit_1;
+	    when unit_1 =>
+	      unit_name (2) := to_lower (l(i));
+	      state := unit_2;
+	      pos := i;
+	    when unit_2 =>
+	      unit_name (3) := to_lower (l(i));
+	      state := unit_3;
+	      exit;
+	    when others =>
+	      return;
+	  end case;
+	when '.' =>
+	  case state is
+	    when digits =>
+	      state := decimals;
+	    when others =>
+	      return;
+	  end case;
+	when others =>
+	  return;
+      end case;
+    end loop;
+
+    --  A unit name (2 or 3 letters) must have been found.
+    --  The string may end anywhere.
+    if state /= unit_2 and state /= unit_3 then
+      return;
+    end if;
+
+    --  Compute EXP with the sign.
+    if exp_neg then
+      exp := -exp;
+    end if;
+
+    --  Search the unit name in the list of time names.
+    unit_found := false;
+    for i in time_names'range loop
+      --  The first two characters must match (case insensitive).
+      --  The third character must match if:
+      --  * the unit name is a three characters identifier (ie, not a blank).
+      --  * there is a third character in STR.
+      if time_names (i).name (1) = unit_name (1)
+	and time_names (i).name (2) = unit_name (2)
+	and (time_names (i).name (3) = ' '
+	     or time_names (i).name (3) = unit_name (3))
+      then
+	unit := time_names (i).val;
+	unit_found := true;
+	--  POS is set to the position of the first invalid character.
+	if time_names (i).name (3) = ' ' then
+	  length := 1;
+	else
+	  length := 2;
+	end if;
+	if l'left < l'right then
+	  pos := pos + length;
+	else
+	  pos := pos - length;
+	end if;
+	exit;
+      end if;
+    end loop;
+    if not unit_found then
+      return;
+    end if;
+
+    --  Compute UNIT, the weight of the first non-significant character.
+    nbr_digits := nbr_digits + exp - 1;
+    if nbr_digits < 0 then
+      unit := unit / 10 ** (-nbr_digits);
+    else
+      unit := unit * 10 ** nbr_digits;
+    end if;
+
+    --  HAS_DIGITS will be set as soon as a digit is found.
+    --  No error is expected here (this has been checked during the first
+    --  pass).
+    has_digits := false;
+    for i in l'range loop
+      case l (i) is
+	when ' '
+	  | NBSP  --V93
+	  | HT =>
+	  if has_digits then
+	    exit;
+	  end if;
+	when '+' | '-' =>
+	  if not has_digits then
+	    has_digits := true;
+	  else
+	    assert false report "internal error" severity failure;
+	    return;
+	  end if;
+	when '0' to '9' =>
+	  --  Leading "0" are not significant.
+	  if l (i) /= '0' or res /= 0 fs then
+	    res := res + char_to_nat (l (i)) * unit;
+	    unit := unit / 10;
+	  end if;
+	  has_digits := true;
+	when 'a' to 'z' | 'A' to 'Z' =>
+	  if has_digits then
+	    exit;
+	  else
+	    assert false report "internal error" severity failure;
+	    return;
+	  end if;
+	when '.' =>
+	  if not has_digits then
+	    assert false report "internal error" severity failure;
+	    return;
+	  end if;
+	when others =>
+	  assert false report "internal error" severity failure;
+	  return;
+      end case;
+    end loop;
+
+    --  Set VALUE.
+    if is_neg then
+      value := -res;
+    else
+      value := res;
+    end if;
+    good := true;
+    trim (l, pos);
+    return;
+  end read;
+
+  procedure read (l: inout line; value: out time)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "time read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out string; good: out boolean)
+  is
+    constant len : natural := value'length;
+  begin
+    if l'length < len then
+      good := false;
+      return;
+    end if;
+    good := true;
+    if len = 0 then
+      return;
+    end if;
+    if l'left < l'right then
+      value := l (l'left to l'left + len - 1);
+      trim (l, l'left + len);
+    else
+      value := l (l'left downto l'left - len + 1);
+      trim (l, l'left - len);
+    end if;
+  end read;
+
+  procedure read (l: inout line; value: out string)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "string read failure"
+      severity failure;
+  end read;
+
+end textio;
diff --git a/libraries/synopsys/std_logic_arith.vhdl b/libraries/synopsys/std_logic_arith.vhdl
new file mode 100644
index 000000000..685b64732
--- /dev/null
+++ b/libraries/synopsys/std_logic_arith.vhdl
@@ -0,0 +1,2391 @@
+--------------------------------------------------------------------------
+--                                                                      --
+-- Copyright (c) 1990,1991,1992 by Synopsys, Inc.  All rights reserved. --
+--                                                                      --
+-- This source file may be used and distributed without restriction     --
+-- provided that this copyright statement is not removed from the file  --
+-- and that any derivative work contains this copyright notice.         --
+--                                                                      --
+--	Package name: STD_LOGIC_ARITH					--
+--									--
+--	Purpose: 							--
+--	 A set of arithemtic, conversion, and comparison functions 	--
+--	 for SIGNED, UNSIGNED, SMALL_INT, INTEGER, 			--
+--	 STD_ULOGIC, STD_LOGIC, and STD_LOGIC_VECTOR.			--
+--									--
+--------------------------------------------------------------------------
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+
+package std_logic_arith is
+
+    type UNSIGNED is array (NATURAL range <>) of STD_LOGIC;
+    type SIGNED is array (NATURAL range <>) of STD_LOGIC;
+    subtype SMALL_INT is INTEGER range 0 to 1;
+
+    function "+"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED;
+    function "+"(L: SIGNED; R: SIGNED) return SIGNED;
+    function "+"(L: UNSIGNED; R: SIGNED) return SIGNED;
+    function "+"(L: SIGNED; R: UNSIGNED) return SIGNED;
+    function "+"(L: UNSIGNED; R: INTEGER) return UNSIGNED;
+    function "+"(L: INTEGER; R: UNSIGNED) return UNSIGNED;
+    function "+"(L: SIGNED; R: INTEGER) return SIGNED;
+    function "+"(L: INTEGER; R: SIGNED) return SIGNED;
+    function "+"(L: UNSIGNED; R: STD_ULOGIC) return UNSIGNED;
+    function "+"(L: STD_ULOGIC; R: UNSIGNED) return UNSIGNED;
+    function "+"(L: SIGNED; R: STD_ULOGIC) return SIGNED;
+    function "+"(L: STD_ULOGIC; R: SIGNED) return SIGNED;
+
+    function "+"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "+"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR;
+    function "+"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR;
+    function "+"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "+"(L: UNSIGNED; R: INTEGER) return STD_LOGIC_VECTOR;
+    function "+"(L: INTEGER; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "+"(L: SIGNED; R: INTEGER) return STD_LOGIC_VECTOR;
+    function "+"(L: INTEGER; R: SIGNED) return STD_LOGIC_VECTOR;
+    function "+"(L: UNSIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR;
+    function "+"(L: STD_ULOGIC; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "+"(L: SIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR;
+    function "+"(L: STD_ULOGIC; R: SIGNED) return STD_LOGIC_VECTOR;
+
+    function "-"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED;
+    function "-"(L: SIGNED; R: SIGNED) return SIGNED;
+    function "-"(L: UNSIGNED; R: SIGNED) return SIGNED;
+    function "-"(L: SIGNED; R: UNSIGNED) return SIGNED;
+    function "-"(L: UNSIGNED; R: INTEGER) return UNSIGNED;
+    function "-"(L: INTEGER; R: UNSIGNED) return UNSIGNED;
+    function "-"(L: SIGNED; R: INTEGER) return SIGNED;
+    function "-"(L: INTEGER; R: SIGNED) return SIGNED;
+    function "-"(L: UNSIGNED; R: STD_ULOGIC) return UNSIGNED;
+    function "-"(L: STD_ULOGIC; R: UNSIGNED) return UNSIGNED;
+    function "-"(L: SIGNED; R: STD_ULOGIC) return SIGNED;
+    function "-"(L: STD_ULOGIC; R: SIGNED) return SIGNED;
+
+    function "-"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "-"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR;
+    function "-"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR;
+    function "-"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "-"(L: UNSIGNED; R: INTEGER) return STD_LOGIC_VECTOR;
+    function "-"(L: INTEGER; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "-"(L: SIGNED; R: INTEGER) return STD_LOGIC_VECTOR;
+    function "-"(L: INTEGER; R: SIGNED) return STD_LOGIC_VECTOR;
+    function "-"(L: UNSIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_ULOGIC; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "-"(L: SIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_ULOGIC; R: SIGNED) return STD_LOGIC_VECTOR;
+
+    function "+"(L: UNSIGNED) return UNSIGNED;
+    function "+"(L: SIGNED) return SIGNED;
+    function "-"(L: SIGNED) return SIGNED;
+    function "ABS"(L: SIGNED) return SIGNED;
+
+    function "+"(L: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "+"(L: SIGNED) return STD_LOGIC_VECTOR;
+    function "-"(L: SIGNED) return STD_LOGIC_VECTOR;
+    function "ABS"(L: SIGNED) return STD_LOGIC_VECTOR;
+
+    function "*"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED;
+    function "*"(L: SIGNED; R: SIGNED) return SIGNED;
+    function "*"(L: SIGNED; R: UNSIGNED) return SIGNED;
+    function "*"(L: UNSIGNED; R: SIGNED) return SIGNED;
+
+    function "*"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "*"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR;
+    function "*"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR;
+    function "*"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR;
+
+    function "<"(L: UNSIGNED; R: UNSIGNED) return BOOLEAN;
+    function "<"(L: SIGNED; R: SIGNED) return BOOLEAN;
+    function "<"(L: UNSIGNED; R: SIGNED) return BOOLEAN;
+    function "<"(L: SIGNED; R: UNSIGNED) return BOOLEAN;
+    function "<"(L: UNSIGNED; R: INTEGER) return BOOLEAN;
+    function "<"(L: INTEGER; R: UNSIGNED) return BOOLEAN;
+    function "<"(L: SIGNED; R: INTEGER) return BOOLEAN;
+    function "<"(L: INTEGER; R: SIGNED) return BOOLEAN;
+
+    function "<="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN;
+    function "<="(L: SIGNED; R: SIGNED) return BOOLEAN;
+    function "<="(L: UNSIGNED; R: SIGNED) return BOOLEAN;
+    function "<="(L: SIGNED; R: UNSIGNED) return BOOLEAN;
+    function "<="(L: UNSIGNED; R: INTEGER) return BOOLEAN;
+    function "<="(L: INTEGER; R: UNSIGNED) return BOOLEAN;
+    function "<="(L: SIGNED; R: INTEGER) return BOOLEAN;
+    function "<="(L: INTEGER; R: SIGNED) return BOOLEAN;
+
+    function ">"(L: UNSIGNED; R: UNSIGNED) return BOOLEAN;
+    function ">"(L: SIGNED; R: SIGNED) return BOOLEAN;
+    function ">"(L: UNSIGNED; R: SIGNED) return BOOLEAN;
+    function ">"(L: SIGNED; R: UNSIGNED) return BOOLEAN;
+    function ">"(L: UNSIGNED; R: INTEGER) return BOOLEAN;
+    function ">"(L: INTEGER; R: UNSIGNED) return BOOLEAN;
+    function ">"(L: SIGNED; R: INTEGER) return BOOLEAN;
+    function ">"(L: INTEGER; R: SIGNED) return BOOLEAN;
+
+    function ">="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN;
+    function ">="(L: SIGNED; R: SIGNED) return BOOLEAN;
+    function ">="(L: UNSIGNED; R: SIGNED) return BOOLEAN;
+    function ">="(L: SIGNED; R: UNSIGNED) return BOOLEAN;
+    function ">="(L: UNSIGNED; R: INTEGER) return BOOLEAN;
+    function ">="(L: INTEGER; R: UNSIGNED) return BOOLEAN;
+    function ">="(L: SIGNED; R: INTEGER) return BOOLEAN;
+    function ">="(L: INTEGER; R: SIGNED) return BOOLEAN;
+
+    function "="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN;
+    function "="(L: SIGNED; R: SIGNED) return BOOLEAN;
+    function "="(L: UNSIGNED; R: SIGNED) return BOOLEAN;
+    function "="(L: SIGNED; R: UNSIGNED) return BOOLEAN;
+    function "="(L: UNSIGNED; R: INTEGER) return BOOLEAN;
+    function "="(L: INTEGER; R: UNSIGNED) return BOOLEAN;
+    function "="(L: SIGNED; R: INTEGER) return BOOLEAN;
+    function "="(L: INTEGER; R: SIGNED) return BOOLEAN;
+
+    function "/="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN;
+    function "/="(L: SIGNED; R: SIGNED) return BOOLEAN;
+    function "/="(L: UNSIGNED; R: SIGNED) return BOOLEAN;
+    function "/="(L: SIGNED; R: UNSIGNED) return BOOLEAN;
+    function "/="(L: UNSIGNED; R: INTEGER) return BOOLEAN;
+    function "/="(L: INTEGER; R: UNSIGNED) return BOOLEAN;
+    function "/="(L: SIGNED; R: INTEGER) return BOOLEAN;
+    function "/="(L: INTEGER; R: SIGNED) return BOOLEAN;
+
+    function SHL(ARG: UNSIGNED; COUNT: UNSIGNED) return UNSIGNED;
+    function SHL(ARG: SIGNED; COUNT: UNSIGNED) return SIGNED;
+    function SHR(ARG: UNSIGNED; COUNT: UNSIGNED) return UNSIGNED;
+    function SHR(ARG: SIGNED; COUNT: UNSIGNED) return SIGNED;
+
+    function CONV_INTEGER(ARG: INTEGER) return INTEGER;
+    function CONV_INTEGER(ARG: UNSIGNED) return INTEGER;
+    function CONV_INTEGER(ARG: SIGNED) return INTEGER;
+    function CONV_INTEGER(ARG: STD_ULOGIC) return SMALL_INT;
+
+    function CONV_UNSIGNED(ARG: INTEGER; SIZE: INTEGER) return UNSIGNED;
+    function CONV_UNSIGNED(ARG: UNSIGNED; SIZE: INTEGER) return UNSIGNED;
+    function CONV_UNSIGNED(ARG: SIGNED; SIZE: INTEGER) return UNSIGNED;
+    function CONV_UNSIGNED(ARG: STD_ULOGIC; SIZE: INTEGER) return UNSIGNED;
+
+    function CONV_SIGNED(ARG: INTEGER; SIZE: INTEGER) return SIGNED;
+    function CONV_SIGNED(ARG: UNSIGNED; SIZE: INTEGER) return SIGNED;
+    function CONV_SIGNED(ARG: SIGNED; SIZE: INTEGER) return SIGNED;
+    function CONV_SIGNED(ARG: STD_ULOGIC; SIZE: INTEGER) return SIGNED;
+
+    function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) 
+						       return STD_LOGIC_VECTOR;
+    function CONV_STD_LOGIC_VECTOR(ARG: UNSIGNED; SIZE: INTEGER) 
+						       return STD_LOGIC_VECTOR;
+    function CONV_STD_LOGIC_VECTOR(ARG: SIGNED; SIZE: INTEGER) 
+						       return STD_LOGIC_VECTOR;
+    function CONV_STD_LOGIC_VECTOR(ARG: STD_ULOGIC; SIZE: INTEGER) 
+						       return STD_LOGIC_VECTOR;
+    -- zero extend STD_LOGIC_VECTOR (ARG) to SIZE, 
+    -- SIZE < 0 is same as SIZE = 0
+    -- returns STD_LOGIC_VECTOR(SIZE-1 downto 0)
+    function EXT(ARG: STD_LOGIC_VECTOR; SIZE: INTEGER) return STD_LOGIC_VECTOR;
+
+    -- sign extend STD_LOGIC_VECTOR (ARG) to SIZE, 
+    -- SIZE < 0 is same as SIZE = 0
+    -- return STD_LOGIC_VECTOR(SIZE-1 downto 0)
+    function SXT(ARG: STD_LOGIC_VECTOR; SIZE: INTEGER) return STD_LOGIC_VECTOR;
+
+end Std_logic_arith;
+
+
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+
+package body std_logic_arith is
+
+    function max(L, R: INTEGER) return INTEGER is
+    begin
+	if L > R then
+	    return L;
+	else
+	    return R;
+	end if;
+    end;
+
+
+    function min(L, R: INTEGER) return INTEGER is
+    begin
+	if L < R then
+	    return L;
+	else
+	    return R;
+	end if;
+    end;
+
+    -- synopsys synthesis_off
+    type tbl_type is array (STD_ULOGIC) of STD_ULOGIC;
+    constant tbl_BINARY : tbl_type :=
+	('X', 'X', '0', '1', 'X', 'X', '0', '1', 'X');
+    -- synopsys synthesis_on
+
+    -- synopsys synthesis_off
+    type tbl_mvl9_boolean is array (STD_ULOGIC) of boolean;
+    constant IS_X : tbl_mvl9_boolean :=
+        (true, true, false, false, true, true, false, false, true);
+    -- synopsys synthesis_on
+
+
+
+    function MAKE_BINARY(A : STD_ULOGIC) return STD_ULOGIC is
+	-- synopsys built_in SYN_FEED_THRU
+    begin
+	-- synopsys synthesis_off
+	    if (IS_X(A)) then
+		assert false 
+		report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)."
+		severity warning;
+	        return ('X');
+	    end if;
+	    return tbl_BINARY(A);
+	-- synopsys synthesis_on
+    end;
+
+    function MAKE_BINARY(A : UNSIGNED) return UNSIGNED is
+	-- synopsys built_in SYN_FEED_THRU
+	variable one_bit : STD_ULOGIC;
+	variable result : UNSIGNED (A'range);
+    begin
+	-- synopsys synthesis_off
+	    for i in A'range loop
+	        if (IS_X(A(i))) then
+		    assert false 
+		    report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)."
+		    severity warning;
+		    result := (others => 'X');
+	            return result;
+	        end if;
+		result(i) := tbl_BINARY(A(i));
+	    end loop;
+	    return result;
+	-- synopsys synthesis_on
+    end;
+
+    function MAKE_BINARY(A : UNSIGNED) return SIGNED is
+	-- synopsys built_in SYN_FEED_THRU
+	variable one_bit : STD_ULOGIC;
+	variable result : SIGNED (A'range);
+    begin
+	-- synopsys synthesis_off
+	    for i in A'range loop
+	        if (IS_X(A(i))) then
+		    assert false 
+		    report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)."
+		    severity warning;
+		    result := (others => 'X');
+	            return result;
+	        end if;
+		result(i) := tbl_BINARY(A(i));
+	    end loop;
+	    return result;
+	-- synopsys synthesis_on
+    end;
+
+    function MAKE_BINARY(A : SIGNED) return UNSIGNED is
+	-- synopsys built_in SYN_FEED_THRU
+	variable one_bit : STD_ULOGIC;
+	variable result : UNSIGNED (A'range);
+    begin
+	-- synopsys synthesis_off
+	    for i in A'range loop
+	        if (IS_X(A(i))) then
+		    assert false 
+		    report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)."
+		    severity warning;
+		    result := (others => 'X');
+	            return result;
+	        end if;
+		result(i) := tbl_BINARY(A(i));
+	    end loop;
+	    return result;
+	-- synopsys synthesis_on
+    end;
+
+    function MAKE_BINARY(A : SIGNED) return SIGNED is
+	-- synopsys built_in SYN_FEED_THRU
+	variable one_bit : STD_ULOGIC;
+	variable result : SIGNED (A'range);
+    begin
+	-- synopsys synthesis_off
+	    for i in A'range loop
+	        if (IS_X(A(i))) then
+		    assert false 
+		    report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)."
+		    severity warning;
+		    result := (others => 'X');
+	            return result;
+	        end if;
+		result(i) := tbl_BINARY(A(i));
+	    end loop;
+	    return result;
+	-- synopsys synthesis_on
+    end;
+
+    function MAKE_BINARY(A : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+	-- synopsys built_in SYN_FEED_THRU
+	variable one_bit : STD_ULOGIC;
+	variable result : STD_LOGIC_VECTOR (A'range);
+    begin
+	-- synopsys synthesis_off
+	    for i in A'range loop
+	        if (IS_X(A(i))) then
+		    assert false 
+		    report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)."
+		    severity warning;
+		    result := (others => 'X');
+	            return result;
+	        end if;
+		result(i) := tbl_BINARY(A(i));
+	    end loop;
+	    return result;
+	-- synopsys synthesis_on
+    end;
+
+    function MAKE_BINARY(A : UNSIGNED) return STD_LOGIC_VECTOR is
+	-- synopsys built_in SYN_FEED_THRU
+	variable one_bit : STD_ULOGIC;
+	variable result : STD_LOGIC_VECTOR (A'range);
+    begin
+	-- synopsys synthesis_off
+	    for i in A'range loop
+	        if (IS_X(A(i))) then
+		    assert false 
+		    report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)."
+		    severity warning;
+		    result := (others => 'X');
+	            return result;
+	        end if;
+		result(i) := tbl_BINARY(A(i));
+	    end loop;
+	    return result;
+	-- synopsys synthesis_on
+    end;
+
+    function MAKE_BINARY(A : SIGNED) return STD_LOGIC_VECTOR is
+	-- synopsys built_in SYN_FEED_THRU
+	variable one_bit : STD_ULOGIC;
+	variable result : STD_LOGIC_VECTOR (A'range);
+    begin
+	-- synopsys synthesis_off
+	    for i in A'range loop
+	        if (IS_X(A(i))) then
+		    assert false 
+		    report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)."
+		    severity warning;
+		    result := (others => 'X');
+	            return result;
+	        end if;
+		result(i) := tbl_BINARY(A(i));
+	    end loop;
+	    return result;
+	-- synopsys synthesis_on
+    end;
+
+
+
+    -- Type propagation function which returns a signed type with the
+    -- size of the left arg.
+    function LEFT_SIGNED_ARG(A,B: SIGNED) return SIGNED is
+      variable Z: SIGNED (A'left downto 0);
+      -- pragma return_port_name Z
+    begin
+      return(Z);
+    end;
+	
+    -- Type propagation function which returns an unsigned type with the
+    -- size of the left arg.
+    function LEFT_UNSIGNED_ARG(A,B: UNSIGNED) return UNSIGNED is
+      variable Z: UNSIGNED (A'left downto 0);
+      -- pragma return_port_name Z
+    begin
+      return(Z);
+    end;
+	
+    -- Type propagation function which returns a signed type with the
+    -- size of the result of a signed multiplication
+    function MULT_SIGNED_ARG(A,B: SIGNED) return SIGNED is
+      variable Z: SIGNED ((A'length+B'length-1) downto 0);
+      -- pragma return_port_name Z
+    begin
+      return(Z);
+    end;
+	
+    -- Type propagation function which returns an unsigned type with the
+    -- size of the result of a unsigned multiplication
+    function MULT_UNSIGNED_ARG(A,B: UNSIGNED) return UNSIGNED is
+      variable Z: UNSIGNED ((A'length+B'length-1) downto 0);
+      -- pragma return_port_name Z
+    begin
+      return(Z);
+    end;
+
+
+
+    function mult(A,B: SIGNED) return SIGNED is
+
+      variable BA: SIGNED((A'length+B'length-1) downto 0);
+      variable PA: SIGNED((A'length+B'length-1) downto 0);
+      variable AA: SIGNED(A'length downto 0);
+      variable neg: STD_ULOGIC;
+      constant one : UNSIGNED(1 downto 0) := "01";
+      
+      -- pragma map_to_operator MULT_TC_OP
+      -- pragma type_function MULT_SIGNED_ARG
+      -- pragma return_port_name Z
+
+      begin
+	if (A(A'left) = 'X' or B(B'left) = 'X') then
+            PA := (others => 'X');
+            return(PA);
+	end if;
+        PA := (others => '0');
+        neg := B(B'left) xor A(A'left);
+        BA := CONV_SIGNED(('0' & ABS(B)),(A'length+B'length));
+        AA := '0' & ABS(A);
+        for i in integer range 0 to A'length-1 loop
+          if AA(i) = '1' then
+            PA := PA+BA;
+          end if;
+          BA := SHL(BA,one);
+        end loop;
+        if (neg= '1') then
+          return(-PA);
+        else 
+          return(PA);
+        end if;
+      end;
+
+    function mult(A,B: UNSIGNED) return UNSIGNED is
+
+      variable BA: UNSIGNED((A'length+B'length-1) downto 0);
+      variable PA: UNSIGNED((A'length+B'length-1) downto 0);
+      constant one : UNSIGNED(1 downto 0) := "01";
+      
+      -- pragma map_to_operator MULT_UNS_OP
+      -- pragma type_function MULT_UNSIGNED_ARG
+      -- pragma return_port_name Z
+
+      begin
+	if (A(A'left) = 'X' or B(B'left) = 'X') then
+            PA := (others => 'X');
+            return(PA);
+	end if;
+        PA := (others => '0');
+        BA := CONV_UNSIGNED(B,(A'length+B'length));
+        for i in integer range 0 to A'length-1 loop
+          if A(i) = '1' then
+            PA := PA+BA;
+          end if;
+          BA := SHL(BA,one);
+        end loop;
+        return(PA);
+      end;
+
+    -- subtract two signed numbers of the same length
+    -- both arrays must have range (msb downto 0)
+    function minus(A, B: SIGNED) return SIGNED is
+	variable carry: STD_ULOGIC;
+	variable BV: STD_ULOGIC_VECTOR (A'left downto 0);
+	variable sum: SIGNED (A'left downto 0);
+
+	-- pragma map_to_operator SUB_TC_OP
+
+	-- pragma type_function LEFT_SIGNED_ARG
+        -- pragma return_port_name Z
+
+    begin
+	if (A(A'left) = 'X' or B(B'left) = 'X') then
+            sum := (others => 'X');
+            return(sum);
+	end if;
+	carry := '1';
+	BV := not STD_ULOGIC_VECTOR(B);
+
+	for i in 0 to A'left loop
+	    sum(i) := A(i) xor BV(i) xor carry;
+	    carry := (A(i) and BV(i)) or
+		    (A(i) and carry) or
+		    (carry and BV(i));
+	end loop;
+	return sum;
+    end;
+
+    -- add two signed numbers of the same length
+    -- both arrays must have range (msb downto 0)
+    function plus(A, B: SIGNED) return SIGNED is
+	variable carry: STD_ULOGIC;
+	variable BV, sum: SIGNED (A'left downto 0);
+
+	-- pragma map_to_operator ADD_TC_OP
+	-- pragma type_function LEFT_SIGNED_ARG
+        -- pragma return_port_name Z
+
+    begin
+	if (A(A'left) = 'X' or B(B'left) = 'X') then
+            sum := (others => 'X');
+            return(sum);
+	end if;
+	carry := '0';
+	BV := B;
+
+	for i in 0 to A'left loop
+	    sum(i) := A(i) xor BV(i) xor carry;
+	    carry := (A(i) and BV(i)) or
+		    (A(i) and carry) or
+		    (carry and BV(i));
+	end loop;
+	return sum;
+    end;
+
+
+    -- subtract two unsigned numbers of the same length
+    -- both arrays must have range (msb downto 0)
+    function unsigned_minus(A, B: UNSIGNED) return UNSIGNED is
+	variable carry: STD_ULOGIC;
+	variable BV: STD_ULOGIC_VECTOR (A'left downto 0);
+	variable sum: UNSIGNED (A'left downto 0);
+
+	-- pragma map_to_operator SUB_UNS_OP
+	-- pragma type_function LEFT_UNSIGNED_ARG
+        -- pragma return_port_name Z
+
+    begin
+	if (A(A'left) = 'X' or B(B'left) = 'X') then
+            sum := (others => 'X');
+            return(sum);
+	end if;
+	carry := '1';
+	BV := not STD_ULOGIC_VECTOR(B);
+
+	for i in 0 to A'left loop
+	    sum(i) := A(i) xor BV(i) xor carry;
+	    carry := (A(i) and BV(i)) or
+		    (A(i) and carry) or
+		    (carry and BV(i));
+	end loop;
+	return sum;
+    end;
+
+    -- add two unsigned numbers of the same length
+    -- both arrays must have range (msb downto 0)
+    function unsigned_plus(A, B: UNSIGNED) return UNSIGNED is
+	variable carry: STD_ULOGIC;
+	variable BV, sum: UNSIGNED (A'left downto 0);
+
+	-- pragma map_to_operator ADD_UNS_OP
+	-- pragma type_function LEFT_UNSIGNED_ARG
+        -- pragma return_port_name Z
+
+    begin
+	if (A(A'left) = 'X' or B(B'left) = 'X') then
+            sum := (others => 'X');
+            return(sum);
+	end if;
+	carry := '0';
+	BV := B;
+
+	for i in 0 to A'left loop
+	    sum(i) := A(i) xor BV(i) xor carry;
+	    carry := (A(i) and BV(i)) or
+		    (A(i) and carry) or
+		    (carry and BV(i));
+	end loop;
+	return sum;
+    end;
+
+
+
+    function "*"(L: SIGNED; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to mult
+	-- synopsys subpgm_id 296
+    begin
+          return     mult(CONV_SIGNED(L, L'length),
+		          CONV_SIGNED(R, R'length)); -- pragma label mult 
+    end;
+      
+    function "*"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED is
+	-- pragma label_applies_to mult
+	-- synopsys subpgm_id 295
+    begin
+          return   mult(CONV_UNSIGNED(L, L'length),
+                        CONV_UNSIGNED(R, R'length)); -- pragma label mult 
+    end;
+        
+    function "*"(L: UNSIGNED; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to mult
+	-- synopsys subpgm_id 297
+    begin
+ 	return       mult(CONV_SIGNED(L, L'length+1),
+		          CONV_SIGNED(R, R'length)); -- pragma label mult 
+    end;
+
+    function "*"(L: SIGNED; R: UNSIGNED) return SIGNED is
+	-- pragma label_applies_to mult
+	-- synopsys subpgm_id 298
+    begin
+	return      mult(CONV_SIGNED(L, L'length),
+		         CONV_SIGNED(R, R'length+1)); -- pragma label mult 
+    end;
+
+
+    function "*"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to mult
+	-- synopsys subpgm_id 301
+    begin
+          return STD_LOGIC_VECTOR (
+		mult(-- pragma label mult 
+		CONV_SIGNED(L, L'length), CONV_SIGNED(R, R'length))); 
+    end;
+      
+    function "*"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to mult
+	-- synopsys subpgm_id 300
+    begin
+          return STD_LOGIC_VECTOR (
+		mult(-- pragma label mult
+		CONV_UNSIGNED(L, L'length), CONV_UNSIGNED(R, R'length))); 
+    end;
+        
+    function "*"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to mult
+	-- synopsys subpgm_id 302
+    begin
+ 	return STD_LOGIC_VECTOR (
+		mult(-- pragma label mult
+		CONV_SIGNED(L, L'length+1), CONV_SIGNED(R, R'length))); 
+    end;
+
+    function "*"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to mult
+	-- synopsys subpgm_id 303
+    begin
+	return STD_LOGIC_VECTOR (
+		mult(-- pragma label mult
+		CONV_SIGNED(L, L'length), CONV_SIGNED(R, R'length+1))); 
+    end;
+
+
+    function "+"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 236
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return unsigned_plus(CONV_UNSIGNED(L, length),
+			     CONV_UNSIGNED(R, length)); -- pragma label plus
+    end;
+
+
+    function "+"(L: SIGNED; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 237
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return plus(CONV_SIGNED(L, length),
+		    CONV_SIGNED(R, length)); -- pragma label plus
+    end;
+
+
+    function "+"(L: UNSIGNED; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 238
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return plus(CONV_SIGNED(L, length),
+		    CONV_SIGNED(R, length)); -- pragma label plus
+    end;
+
+
+    function "+"(L: SIGNED; R: UNSIGNED) return SIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 239
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return plus(CONV_SIGNED(L, length),
+		    CONV_SIGNED(R, length)); -- pragma label plus
+    end;
+
+
+    function "+"(L: UNSIGNED; R: INTEGER) return UNSIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 240
+	constant length: INTEGER := L'length + 1;
+    begin
+	return CONV_UNSIGNED(
+		plus( -- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1);
+    end;
+
+
+    function "+"(L: INTEGER; R: UNSIGNED) return UNSIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 241
+	constant length: INTEGER := R'length + 1;
+    begin
+	return CONV_UNSIGNED(
+		plus( -- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1);
+    end;
+
+
+    function "+"(L: SIGNED; R: INTEGER) return SIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 242
+	constant length: INTEGER := L'length;
+    begin
+	return plus(CONV_SIGNED(L, length),
+		    CONV_SIGNED(R, length)); -- pragma label plus
+    end;
+
+
+    function "+"(L: INTEGER; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 243
+	constant length: INTEGER := R'length;
+    begin
+	return plus(CONV_SIGNED(L, length),
+		    CONV_SIGNED(R, length)); -- pragma label plus
+    end;
+
+
+    function "+"(L: UNSIGNED; R: STD_ULOGIC) return UNSIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 244
+	constant length: INTEGER := L'length;
+    begin
+	return unsigned_plus(CONV_UNSIGNED(L, length),
+		     CONV_UNSIGNED(R, length)) ; -- pragma label plus
+    end;
+
+
+    function "+"(L: STD_ULOGIC; R: UNSIGNED) return UNSIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 245
+	constant length: INTEGER := R'length;
+    begin
+	return unsigned_plus(CONV_UNSIGNED(L, length),
+		     CONV_UNSIGNED(R, length)); -- pragma label plus
+    end;
+
+
+    function "+"(L: SIGNED; R: STD_ULOGIC) return SIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 246
+	constant length: INTEGER := L'length;
+    begin
+	return plus(CONV_SIGNED(L, length),
+		    CONV_SIGNED(R, length)); -- pragma label plus
+    end;
+
+
+    function "+"(L: STD_ULOGIC; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 247
+	constant length: INTEGER := R'length;
+    begin
+	return plus(CONV_SIGNED(L, length),
+		    CONV_SIGNED(R, length)); -- pragma label plus
+    end;
+
+
+
+    function "+"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 260
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return STD_LOGIC_VECTOR (
+		unsigned_plus(-- pragma label plus
+		CONV_UNSIGNED(L, length), CONV_UNSIGNED(R, length))); 
+    end;
+
+
+    function "+"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 261
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return STD_LOGIC_VECTOR (
+		plus(-- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "+"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 262
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return STD_LOGIC_VECTOR (
+		plus(-- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "+"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 263
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return STD_LOGIC_VECTOR (
+		plus(-- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "+"(L: UNSIGNED; R: INTEGER) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 264
+	constant length: INTEGER := L'length + 1;
+    begin
+	return STD_LOGIC_VECTOR (CONV_UNSIGNED(
+		plus( -- pragma label plus
+	        CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1));
+    end;
+
+
+    function "+"(L: INTEGER; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 265
+	constant length: INTEGER := R'length + 1;
+    begin
+	return STD_LOGIC_VECTOR (CONV_UNSIGNED(
+		plus( -- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1));
+    end;
+
+
+    function "+"(L: SIGNED; R: INTEGER) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 266
+	constant length: INTEGER := L'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		plus(-- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "+"(L: INTEGER; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 267
+	constant length: INTEGER := R'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		plus(-- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "+"(L: UNSIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 268
+	constant length: INTEGER := L'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		unsigned_plus(-- pragma label plus
+		CONV_UNSIGNED(L, length), CONV_UNSIGNED(R, length))) ; 
+    end;
+
+
+    function "+"(L: STD_ULOGIC; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 269
+	constant length: INTEGER := R'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		unsigned_plus(-- pragma label plus
+		CONV_UNSIGNED(L, length), CONV_UNSIGNED(R, length))); 
+    end;
+
+
+    function "+"(L: SIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 270
+	constant length: INTEGER := L'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		plus(-- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "+"(L: STD_ULOGIC; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to plus
+	-- synopsys subpgm_id 271
+	constant length: INTEGER := R'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		plus(-- pragma label plus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+
+    function "-"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 248
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return unsigned_minus(CONV_UNSIGNED(L, length),
+		      	      CONV_UNSIGNED(R, length)); -- pragma label minus
+    end;
+
+
+    function "-"(L: SIGNED; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 249
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return minus(CONV_SIGNED(L, length),
+		     CONV_SIGNED(R, length)); -- pragma label minus
+    end;
+
+
+    function "-"(L: UNSIGNED; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 250
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return minus(CONV_SIGNED(L, length),
+		     CONV_SIGNED(R, length)); -- pragma label minus
+    end;
+
+
+    function "-"(L: SIGNED; R: UNSIGNED) return SIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 251
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return minus(CONV_SIGNED(L, length),
+		     CONV_SIGNED(R, length)); -- pragma label minus
+    end;
+
+
+    function "-"(L: UNSIGNED; R: INTEGER) return UNSIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 252
+	constant length: INTEGER := L'length + 1;
+    begin
+	return CONV_UNSIGNED(
+		minus( -- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1);
+    end;
+
+
+    function "-"(L: INTEGER; R: UNSIGNED) return UNSIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 253
+	constant length: INTEGER := R'length + 1;
+    begin
+	return CONV_UNSIGNED(
+		minus( -- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1);
+    end;
+
+
+    function "-"(L: SIGNED; R: INTEGER) return SIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 254
+	constant length: INTEGER := L'length;
+    begin
+	return minus(CONV_SIGNED(L, length),
+		     CONV_SIGNED(R, length)); -- pragma label minus
+    end;
+
+
+    function "-"(L: INTEGER; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 255
+	constant length: INTEGER := R'length;
+    begin
+	return minus(CONV_SIGNED(L, length),
+		     CONV_SIGNED(R, length)); -- pragma label minus
+    end;
+
+
+    function "-"(L: UNSIGNED; R: STD_ULOGIC) return UNSIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 256
+	constant length: INTEGER := L'length + 1;
+    begin
+	return CONV_UNSIGNED(
+		minus( -- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1);
+    end;
+
+
+    function "-"(L: STD_ULOGIC; R: UNSIGNED) return UNSIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 257
+	constant length: INTEGER := R'length + 1;
+    begin
+	return CONV_UNSIGNED(
+		minus( -- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1);
+    end;
+
+
+    function "-"(L: SIGNED; R: STD_ULOGIC) return SIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 258
+	constant length: INTEGER := L'length;
+    begin
+	return minus(CONV_SIGNED(L, length),
+		     CONV_SIGNED(R, length)); -- pragma label minus
+    end;
+
+
+    function "-"(L: STD_ULOGIC; R: SIGNED) return SIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 259
+	constant length: INTEGER := R'length;
+    begin
+	return minus(CONV_SIGNED(L, length),
+		     CONV_SIGNED(R, length)); -- pragma label minus
+    end;
+
+
+
+
+    function "-"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 272
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return STD_LOGIC_VECTOR (
+		unsigned_minus(-- pragma label minus
+		CONV_UNSIGNED(L, length), CONV_UNSIGNED(R, length))); 
+    end;
+
+
+    function "-"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 273
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return STD_LOGIC_VECTOR (
+		minus(-- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "-"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 274
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return STD_LOGIC_VECTOR (
+		minus(-- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "-"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 275
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return STD_LOGIC_VECTOR (
+		minus(-- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "-"(L: UNSIGNED; R: INTEGER) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 276
+	constant length: INTEGER := L'length + 1;
+    begin
+	return STD_LOGIC_VECTOR (CONV_UNSIGNED(
+		minus( -- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1));
+    end;
+
+
+    function "-"(L: INTEGER; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 277
+	constant length: INTEGER := R'length + 1;
+    begin
+	return STD_LOGIC_VECTOR (CONV_UNSIGNED(
+		minus( -- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1));
+    end;
+
+
+    function "-"(L: SIGNED; R: INTEGER) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 278
+	constant length: INTEGER := L'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		minus(-- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "-"(L: INTEGER; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 279
+	constant length: INTEGER := R'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		minus(-- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "-"(L: UNSIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 280
+	constant length: INTEGER := L'length + 1;
+    begin
+	return STD_LOGIC_VECTOR (CONV_UNSIGNED(
+		minus( -- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1));
+    end;
+
+
+    function "-"(L: STD_ULOGIC; R: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 281
+	constant length: INTEGER := R'length + 1;
+    begin
+	return STD_LOGIC_VECTOR (CONV_UNSIGNED(
+		minus( -- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1));
+    end;
+
+
+    function "-"(L: SIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 282
+	constant length: INTEGER := L'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		minus(-- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+    function "-"(L: STD_ULOGIC; R: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 283
+	constant length: INTEGER := R'length;
+    begin
+	return STD_LOGIC_VECTOR (
+		minus(-- pragma label minus
+		CONV_SIGNED(L, length), CONV_SIGNED(R, length))); 
+    end;
+
+
+
+
+    function "+"(L: UNSIGNED) return UNSIGNED is
+	-- synopsys subpgm_id 284
+    begin
+	return L;
+    end;
+
+
+    function "+"(L: SIGNED) return SIGNED is
+	-- synopsys subpgm_id 285
+    begin
+	return L;
+    end;
+
+
+    function "-"(L: SIGNED) return SIGNED is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 286
+    begin
+	return 0 - L; -- pragma label minus
+    end;
+
+
+    function "ABS"(L: SIGNED) return SIGNED is
+	-- synopsys subpgm_id 287
+    begin
+	if (L(L'left) = '0' or L(L'left) = 'L') then
+	    return L;
+	else
+	    return 0 - L;
+	end if;
+    end;
+
+
+    function "+"(L: UNSIGNED) return STD_LOGIC_VECTOR is
+	-- synopsys subpgm_id 289
+    begin
+	return STD_LOGIC_VECTOR (L);
+    end;
+
+
+    function "+"(L: SIGNED) return STD_LOGIC_VECTOR is
+	-- synopsys subpgm_id 290
+    begin
+	return STD_LOGIC_VECTOR (L);
+    end;
+
+
+    function "-"(L: SIGNED) return STD_LOGIC_VECTOR is
+	-- pragma label_applies_to minus
+	-- synopsys subpgm_id 292
+	variable tmp: SIGNED(L'length-1 downto 0);
+    begin
+	tmp := 0 - L;  -- pragma label minus
+	return STD_LOGIC_VECTOR (tmp); 
+    end;
+
+
+    function "ABS"(L: SIGNED) return STD_LOGIC_VECTOR is
+	-- synopsys subpgm_id 294
+	variable tmp: SIGNED(L'length-1 downto 0);
+    begin
+	if (L(L'left) = '0' or L(L'left) = 'L') then
+	    return STD_LOGIC_VECTOR (L);
+	else
+	    tmp := 0 - L;
+	    return STD_LOGIC_VECTOR (tmp);
+	end if;
+    end;
+
+
+    -- Type propagation function which returns the type BOOLEAN
+    function UNSIGNED_RETURN_BOOLEAN(A,B: UNSIGNED) return BOOLEAN is
+      variable Z: BOOLEAN;
+      -- pragma return_port_name Z
+    begin
+      return(Z);
+    end;
+	
+    -- Type propagation function which returns the type BOOLEAN
+    function SIGNED_RETURN_BOOLEAN(A,B: SIGNED) return BOOLEAN is
+      variable Z: BOOLEAN;
+      -- pragma return_port_name Z
+    begin
+      return(Z);
+    end;
+	
+
+    -- compare two signed numbers of the same length
+    -- both arrays must have range (msb downto 0)
+    function is_less(A, B: SIGNED) return BOOLEAN is
+	constant sign: INTEGER := A'left;
+	variable a_is_0, b_is_1, result : boolean;
+
+	-- pragma map_to_operator LT_TC_OP
+	-- pragma type_function SIGNED_RETURN_BOOLEAN
+        -- pragma return_port_name Z
+
+    begin
+	if A(sign) /= B(sign) then
+	    result := A(sign) = '1';
+	else
+	    result := FALSE;
+	    for i in 0 to sign-1 loop
+		a_is_0 := A(i) = '0';
+		b_is_1 := B(i) = '1';
+		result := (a_is_0 and b_is_1) or
+			  (a_is_0 and result) or
+			  (b_is_1 and result);
+	    end loop;
+	end if;
+	return result;
+    end;
+
+
+    -- compare two signed numbers of the same length
+    -- both arrays must have range (msb downto 0)
+    function is_less_or_equal(A, B: SIGNED) return BOOLEAN is
+	constant sign: INTEGER := A'left;
+	variable a_is_0, b_is_1, result : boolean;
+
+	-- pragma map_to_operator LEQ_TC_OP
+	-- pragma type_function SIGNED_RETURN_BOOLEAN
+        -- pragma return_port_name Z
+
+    begin
+	if A(sign) /= B(sign) then
+	    result := A(sign) = '1';
+	else
+	    result := TRUE;
+	    for i in 0 to sign-1 loop
+		a_is_0 := A(i) = '0';
+		b_is_1 := B(i) = '1';
+		result := (a_is_0 and b_is_1) or
+			  (a_is_0 and result) or
+			  (b_is_1 and result);
+	    end loop;
+	end if;
+	return result;
+    end;
+
+
+
+    -- compare two unsigned numbers of the same length
+    -- both arrays must have range (msb downto 0)
+    function unsigned_is_less(A, B: UNSIGNED) return BOOLEAN is
+	constant sign: INTEGER := A'left;
+	variable a_is_0, b_is_1, result : boolean;
+
+	-- pragma map_to_operator LT_UNS_OP
+	-- pragma type_function UNSIGNED_RETURN_BOOLEAN
+        -- pragma return_port_name Z
+
+    begin
+	result := FALSE;
+	for i in 0 to sign loop
+	    a_is_0 := A(i) = '0';
+	    b_is_1 := B(i) = '1';
+	    result := (a_is_0 and b_is_1) or
+		      (a_is_0 and result) or
+		      (b_is_1 and result);
+	end loop;
+	return result;
+    end;
+
+
+    -- compare two unsigned numbers of the same length
+    -- both arrays must have range (msb downto 0)
+    function unsigned_is_less_or_equal(A, B: UNSIGNED) return BOOLEAN is
+	constant sign: INTEGER := A'left;
+	variable a_is_0, b_is_1, result : boolean;
+
+	-- pragma map_to_operator LEQ_UNS_OP
+	-- pragma type_function UNSIGNED_RETURN_BOOLEAN
+        -- pragma return_port_name Z
+
+    begin
+	result := TRUE;
+	for i in 0 to sign loop
+	    a_is_0 := A(i) = '0';
+	    b_is_1 := B(i) = '1';
+	    result := (a_is_0 and b_is_1) or
+		      (a_is_0 and result) or
+		      (b_is_1 and result);
+	end loop;
+	return result;
+    end;
+
+
+
+
+    function "<"(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to lt
+	-- synopsys subpgm_id 305
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return unsigned_is_less(CONV_UNSIGNED(L, length),
+				CONV_UNSIGNED(R, length)); -- pragma label lt
+    end;
+
+
+    function "<"(L: SIGNED; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to lt
+	-- synopsys subpgm_id 306
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return is_less(CONV_SIGNED(L, length),
+			CONV_SIGNED(R, length)); -- pragma label lt
+    end;
+
+
+    function "<"(L: UNSIGNED; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to lt
+	-- synopsys subpgm_id 307
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return is_less(CONV_SIGNED(L, length),
+			CONV_SIGNED(R, length)); -- pragma label lt
+    end;
+
+
+    function "<"(L: SIGNED; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to lt
+	-- synopsys subpgm_id 308
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return is_less(CONV_SIGNED(L, length),
+			CONV_SIGNED(R, length)); -- pragma label lt
+    end;
+
+
+    function "<"(L: UNSIGNED; R: INTEGER) return BOOLEAN is
+	-- pragma label_applies_to lt
+	-- synopsys subpgm_id 309
+	constant length: INTEGER := L'length + 1;
+    begin
+	return is_less(CONV_SIGNED(L, length),
+			CONV_SIGNED(R, length)); -- pragma label lt
+    end;
+
+
+    function "<"(L: INTEGER; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to lt
+	-- synopsys subpgm_id 310
+	constant length: INTEGER := R'length + 1;
+    begin
+	return is_less(CONV_SIGNED(L, length),
+			CONV_SIGNED(R, length)); -- pragma label lt
+    end;
+
+
+    function "<"(L: SIGNED; R: INTEGER) return BOOLEAN is
+	-- pragma label_applies_to lt
+	-- synopsys subpgm_id 311
+	constant length: INTEGER := L'length;
+    begin
+	return is_less(CONV_SIGNED(L, length),
+			CONV_SIGNED(R, length)); -- pragma label lt
+    end;
+
+
+    function "<"(L: INTEGER; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to lt
+	-- synopsys subpgm_id 312
+	constant length: INTEGER := R'length;
+    begin
+	return is_less(CONV_SIGNED(L, length),
+			CONV_SIGNED(R, length)); -- pragma label lt
+    end;
+
+
+
+
+    function "<="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to leq
+	-- synopsys subpgm_id 314
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return unsigned_is_less_or_equal(CONV_UNSIGNED(L, length),
+			     CONV_UNSIGNED(R, length)); -- pragma label leq
+    end;
+
+
+    function "<="(L: SIGNED; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to leq
+	-- synopsys subpgm_id 315
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return is_less_or_equal(CONV_SIGNED(L, length),
+				CONV_SIGNED(R, length)); -- pragma label leq
+    end;
+
+
+    function "<="(L: UNSIGNED; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to leq
+	-- synopsys subpgm_id 316
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return is_less_or_equal(CONV_SIGNED(L, length),
+				CONV_SIGNED(R, length)); -- pragma label leq
+    end;
+
+
+    function "<="(L: SIGNED; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to leq
+	-- synopsys subpgm_id 317
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return is_less_or_equal(CONV_SIGNED(L, length),
+				CONV_SIGNED(R, length)); -- pragma label leq
+    end;
+
+
+    function "<="(L: UNSIGNED; R: INTEGER) return BOOLEAN is
+	-- pragma label_applies_to leq
+	-- synopsys subpgm_id 318
+	constant length: INTEGER := L'length + 1;
+    begin
+	return is_less_or_equal(CONV_SIGNED(L, length),
+				CONV_SIGNED(R, length)); -- pragma label leq
+    end;
+
+
+    function "<="(L: INTEGER; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to leq
+	-- synopsys subpgm_id 319
+	constant length: INTEGER := R'length + 1;
+    begin
+	return is_less_or_equal(CONV_SIGNED(L, length),
+				CONV_SIGNED(R, length)); -- pragma label leq
+    end;
+
+
+    function "<="(L: SIGNED; R: INTEGER) return BOOLEAN is
+	-- pragma label_applies_to leq
+	-- synopsys subpgm_id 320
+	constant length: INTEGER := L'length;
+    begin
+	return is_less_or_equal(CONV_SIGNED(L, length),
+				CONV_SIGNED(R, length)); -- pragma label leq
+    end;
+
+
+    function "<="(L: INTEGER; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to leq
+	-- synopsys subpgm_id 321
+	constant length: INTEGER := R'length;
+    begin
+	return is_less_or_equal(CONV_SIGNED(L, length),
+				CONV_SIGNED(R, length)); -- pragma label leq
+    end;
+
+
+
+
+    function ">"(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to gt
+	-- synopsys subpgm_id 323
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return unsigned_is_less(CONV_UNSIGNED(R, length),
+				CONV_UNSIGNED(L, length)); -- pragma label gt
+    end;
+
+
+    function ">"(L: SIGNED; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to gt
+	-- synopsys subpgm_id 324
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return is_less(CONV_SIGNED(R, length),
+		       CONV_SIGNED(L, length)); -- pragma label gt
+    end;
+
+
+    function ">"(L: UNSIGNED; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to gt
+	-- synopsys subpgm_id 325
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return is_less(CONV_SIGNED(R, length),
+		       CONV_SIGNED(L, length)); -- pragma label gt
+    end;
+
+
+    function ">"(L: SIGNED; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to gt
+	-- synopsys subpgm_id 326
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return is_less(CONV_SIGNED(R, length),
+		       CONV_SIGNED(L, length)); -- pragma label gt
+    end;
+
+
+    function ">"(L: UNSIGNED; R: INTEGER) return BOOLEAN is
+	-- pragma label_applies_to gt
+	-- synopsys subpgm_id 327
+	constant length: INTEGER := L'length + 1;
+    begin
+	return is_less(CONV_SIGNED(R, length),
+		       CONV_SIGNED(L, length)); -- pragma label gt
+    end;
+
+
+    function ">"(L: INTEGER; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to gt
+	-- synopsys subpgm_id 328
+	constant length: INTEGER := R'length + 1;
+    begin
+	return is_less(CONV_SIGNED(R, length),
+		       CONV_SIGNED(L, length)); -- pragma label gt
+    end;
+
+
+    function ">"(L: SIGNED; R: INTEGER) return BOOLEAN is
+	-- pragma label_applies_to gt
+	-- synopsys subpgm_id 329
+	constant length: INTEGER := L'length;
+    begin
+	return is_less(CONV_SIGNED(R, length),
+		       CONV_SIGNED(L, length)); -- pragma label gt
+    end;
+
+
+    function ">"(L: INTEGER; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to gt
+	-- synopsys subpgm_id 330
+	constant length: INTEGER := R'length;
+    begin
+	return is_less(CONV_SIGNED(R, length),
+		       CONV_SIGNED(L, length)); -- pragma label gt
+    end;
+
+
+
+
+    function ">="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to geq
+	-- synopsys subpgm_id 332
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return unsigned_is_less_or_equal(CONV_UNSIGNED(R, length),
+			CONV_UNSIGNED(L, length)); -- pragma label geq
+    end;
+
+
+    function ">="(L: SIGNED; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to geq
+	-- synopsys subpgm_id 333
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return is_less_or_equal(CONV_SIGNED(R, length),
+			CONV_SIGNED(L, length)); -- pragma label geq
+    end;
+
+
+    function ">="(L: UNSIGNED; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to geq
+	-- synopsys subpgm_id 334
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return is_less_or_equal(CONV_SIGNED(R, length),
+			CONV_SIGNED(L, length)); -- pragma label geq
+    end;
+
+
+    function ">="(L: SIGNED; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to geq
+	-- synopsys subpgm_id 335
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return is_less_or_equal(CONV_SIGNED(R, length),
+			CONV_SIGNED(L, length)); -- pragma label geq
+    end;
+
+
+    function ">="(L: UNSIGNED; R: INTEGER) return BOOLEAN is
+	-- pragma label_applies_to geq
+	-- synopsys subpgm_id 336
+	constant length: INTEGER := L'length + 1;
+    begin
+	return is_less_or_equal(CONV_SIGNED(R, length),
+				CONV_SIGNED(L, length)); -- pragma label geq
+    end;
+
+
+    function ">="(L: INTEGER; R: UNSIGNED) return BOOLEAN is
+	-- pragma label_applies_to geq
+	-- synopsys subpgm_id 337
+	constant length: INTEGER := R'length + 1;
+    begin
+	return is_less_or_equal(CONV_SIGNED(R, length),
+				CONV_SIGNED(L, length)); -- pragma label geq
+    end;
+
+
+    function ">="(L: SIGNED; R: INTEGER) return BOOLEAN is
+	-- pragma label_applies_to geq
+	-- synopsys subpgm_id 338
+	constant length: INTEGER := L'length;
+    begin
+	return is_less_or_equal(CONV_SIGNED(R, length),
+				CONV_SIGNED(L, length)); -- pragma label geq
+    end;
+
+
+    function ">="(L: INTEGER; R: SIGNED) return BOOLEAN is
+	-- pragma label_applies_to geq
+	-- synopsys subpgm_id 339
+	constant length: INTEGER := R'length;
+    begin
+	return is_less_or_equal(CONV_SIGNED(R, length),
+				CONV_SIGNED(L, length)); -- pragma label geq
+    end;
+
+
+
+
+    -- for internal use only.  Assumes SIGNED arguments of equal length.
+    function bitwise_eql(L: STD_ULOGIC_VECTOR; R: STD_ULOGIC_VECTOR)
+						return BOOLEAN is
+	-- pragma built_in SYN_EQL
+    begin
+	for i in L'range loop
+	    if L(i) /= R(i) then
+		return FALSE;
+	    end if;
+	end loop;
+	return TRUE;
+    end;
+
+    -- for internal use only.  Assumes SIGNED arguments of equal length.
+    function bitwise_neq(L: STD_ULOGIC_VECTOR; R: STD_ULOGIC_VECTOR)
+						return BOOLEAN is
+	-- pragma built_in SYN_NEQ
+    begin
+	for i in L'range loop
+	    if L(i) /= R(i) then
+		return TRUE;
+	    end if;
+	end loop;
+	return FALSE;
+    end;
+
+
+    function "="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 341
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return bitwise_eql( STD_ULOGIC_VECTOR( CONV_UNSIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_UNSIGNED(R, length) ) );
+    end;
+
+
+    function "="(L: SIGNED; R: SIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 342
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "="(L: UNSIGNED; R: SIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 343
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "="(L: SIGNED; R: UNSIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 344
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "="(L: UNSIGNED; R: INTEGER) return BOOLEAN is
+	-- synopsys subpgm_id 345
+	constant length: INTEGER := L'length + 1;
+    begin
+	return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "="(L: INTEGER; R: UNSIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 346
+	constant length: INTEGER := R'length + 1;
+    begin
+	return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "="(L: SIGNED; R: INTEGER) return BOOLEAN is
+	-- synopsys subpgm_id 347
+	constant length: INTEGER := L'length;
+    begin
+	return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "="(L: INTEGER; R: SIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 348
+	constant length: INTEGER := R'length;
+    begin
+	return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+
+
+    function "/="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 350
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return bitwise_neq( STD_ULOGIC_VECTOR( CONV_UNSIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_UNSIGNED(R, length) ) );
+    end;
+
+
+    function "/="(L: SIGNED; R: SIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 351
+	constant length: INTEGER := max(L'length, R'length);
+    begin
+	return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "/="(L: UNSIGNED; R: SIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 352
+	constant length: INTEGER := max(L'length + 1, R'length);
+    begin
+	return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "/="(L: SIGNED; R: UNSIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 353
+	constant length: INTEGER := max(L'length, R'length + 1);
+    begin
+	return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "/="(L: UNSIGNED; R: INTEGER) return BOOLEAN is
+	-- synopsys subpgm_id 354
+	constant length: INTEGER := L'length + 1;
+    begin
+	return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "/="(L: INTEGER; R: UNSIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 355
+	constant length: INTEGER := R'length + 1;
+    begin
+	return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "/="(L: SIGNED; R: INTEGER) return BOOLEAN is
+	-- synopsys subpgm_id 356
+	constant length: INTEGER := L'length;
+    begin
+	return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+    function "/="(L: INTEGER; R: SIGNED) return BOOLEAN is
+	-- synopsys subpgm_id 357
+	constant length: INTEGER := R'length;
+    begin
+	return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ),
+		STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) );
+    end;
+
+
+
+    function SHL(ARG: UNSIGNED; COUNT: UNSIGNED) return UNSIGNED is
+	-- synopsys subpgm_id 358
+	constant control_msb: INTEGER := COUNT'length - 1;
+	variable control: UNSIGNED (control_msb downto 0);
+	constant result_msb: INTEGER := ARG'length-1;
+	subtype rtype is UNSIGNED (result_msb downto 0);
+	variable result, temp: rtype;
+    begin
+	control := MAKE_BINARY(COUNT);
+	-- synopsys synthesis_off
+	if (control(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	-- synopsys synthesis_on
+	result := ARG;
+	for i in 0 to control_msb loop
+	    if control(i) = '1' then
+		temp := rtype'(others => '0');
+		if 2**i <= result_msb then
+		    temp(result_msb downto 2**i) := 
+				    result(result_msb - 2**i downto 0);
+		end if;
+		result := temp;
+	    end if;
+	end loop;
+	return result;
+    end;
+
+    function SHL(ARG: SIGNED; COUNT: UNSIGNED) return SIGNED is
+	-- synopsys subpgm_id 359
+	constant control_msb: INTEGER := COUNT'length - 1;
+	variable control: UNSIGNED (control_msb downto 0);
+	constant result_msb: INTEGER := ARG'length-1;
+	subtype rtype is SIGNED (result_msb downto 0);
+	variable result, temp: rtype;
+    begin
+	control := MAKE_BINARY(COUNT);
+	-- synopsys synthesis_off
+	if (control(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	-- synopsys synthesis_on
+	result := ARG;
+	for i in 0 to control_msb loop
+	    if control(i) = '1' then
+		temp := rtype'(others => '0');
+		if 2**i <= result_msb then
+		    temp(result_msb downto 2**i) := 
+				    result(result_msb - 2**i downto 0);
+		end if;
+		result := temp;
+	    end if;
+	end loop;
+	return result;
+    end;
+
+
+    function SHR(ARG: UNSIGNED; COUNT: UNSIGNED) return UNSIGNED is
+	-- synopsys subpgm_id 360
+	constant control_msb: INTEGER := COUNT'length - 1;
+	variable control: UNSIGNED (control_msb downto 0);
+	constant result_msb: INTEGER := ARG'length-1;
+	subtype rtype is UNSIGNED (result_msb downto 0);
+	variable result, temp: rtype;
+    begin
+	control := MAKE_BINARY(COUNT);
+	-- synopsys synthesis_off
+	if (control(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	-- synopsys synthesis_on
+	result := ARG;
+	for i in 0 to control_msb loop
+	    if control(i) = '1' then
+		temp := rtype'(others => '0');
+		if 2**i <= result_msb then
+		    temp(result_msb - 2**i downto 0) := 
+					result(result_msb downto 2**i);
+		end if;
+		result := temp;
+	    end if;
+	end loop;
+	return result;
+    end;
+
+    function SHR(ARG: SIGNED; COUNT: UNSIGNED) return SIGNED is
+	-- synopsys subpgm_id 361
+	constant control_msb: INTEGER := COUNT'length - 1;
+	variable control: UNSIGNED (control_msb downto 0);
+	constant result_msb: INTEGER := ARG'length-1;
+	subtype rtype is SIGNED (result_msb downto 0);
+	variable result, temp: rtype;
+	variable sign_bit: STD_ULOGIC;
+    begin
+	control := MAKE_BINARY(COUNT);
+	-- synopsys synthesis_off
+	if (control(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	-- synopsys synthesis_on
+	result := ARG;
+	sign_bit := ARG(ARG'left);
+	for i in 0 to control_msb loop
+	    if control(i) = '1' then
+		temp := rtype'(others => sign_bit);
+		if 2**i <= result_msb then
+		    temp(result_msb - 2**i downto 0) := 
+					result(result_msb downto 2**i);
+		end if;
+		result := temp;
+	    end if;
+	end loop;
+	return result;
+    end;
+
+
+
+
+    function CONV_INTEGER(ARG: INTEGER) return INTEGER is
+	-- synopsys subpgm_id 365
+    begin
+	return ARG;
+    end;
+
+    function CONV_INTEGER(ARG: UNSIGNED) return INTEGER is
+	variable result: INTEGER;
+	variable tmp: STD_ULOGIC;
+	-- synopsys built_in SYN_UNSIGNED_TO_INTEGER
+	-- synopsys subpgm_id 366
+    begin
+	-- synopsys synthesis_off
+	assert ARG'length <= 31
+	    report "ARG is too large in CONV_INTEGER"
+	    severity FAILURE;
+	result := 0;
+	for i in ARG'range loop
+	    result := result * 2;
+	    tmp := tbl_BINARY(ARG(i));
+	    if tmp = '1' then
+		result := result + 1;
+	    elsif tmp = 'X' then
+		assert false
+		report "CONV_INTEGER: There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, and it has been converted to 0."
+		severity WARNING;
+	    end if;
+	end loop;
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_INTEGER(ARG: SIGNED) return INTEGER is
+	variable result: INTEGER;
+	variable tmp: STD_ULOGIC;
+	-- synopsys built_in SYN_SIGNED_TO_INTEGER
+	-- synopsys subpgm_id 367
+    begin
+	-- synopsys synthesis_off
+	assert ARG'length <= 32
+	    report "ARG is too large in CONV_INTEGER"
+	    severity FAILURE;
+	result := 0;
+	for i in ARG'range loop
+	    if i /= ARG'left then
+		result := result * 2;
+	        tmp := tbl_BINARY(ARG(i));
+	        if tmp = '1' then
+		    result := result + 1;
+	        elsif tmp = 'X' then
+		    assert false
+		    report "CONV_INTEGER: There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, and it has been converted to 0."
+		    severity WARNING;
+	        end if;
+	    end if;
+	end loop;
+	tmp := MAKE_BINARY(ARG(ARG'left));
+	if tmp = '1' then
+	    if ARG'length = 32 then
+		result := (result - 2**30) - 2**30;
+	    else
+		result := result - (2 ** (ARG'length-1));
+	    end if;
+	end if;
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_INTEGER(ARG: STD_ULOGIC) return SMALL_INT is
+	variable tmp: STD_ULOGIC;
+	-- synopsys built_in SYN_FEED_THRU
+	-- synopsys subpgm_id 370
+    begin
+	-- synopsys synthesis_off
+	tmp := tbl_BINARY(ARG);
+	if tmp = '1' then
+	    return 1;
+	elsif tmp = 'X' then
+	    assert false
+	    report "CONV_INTEGER: There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, and it has been converted to 0."
+	    severity WARNING;
+	    return 0;
+	else
+	    return 0;
+	end if;
+	-- synopsys synthesis_on
+    end;
+
+
+    -- convert an integer to a unsigned STD_ULOGIC_VECTOR
+    function CONV_UNSIGNED(ARG: INTEGER; SIZE: INTEGER) return UNSIGNED is
+	variable result: UNSIGNED(SIZE-1 downto 0);
+	variable temp: integer;
+	-- synopsys built_in SYN_INTEGER_TO_UNSIGNED
+	-- synopsys subpgm_id 371
+    begin
+	-- synopsys synthesis_off
+	temp := ARG;
+	for i in 0 to SIZE-1 loop
+	    if (temp mod 2) = 1 then
+		result(i) := '1';
+	    else 
+		result(i) := '0';
+	    end if;
+	    if temp > 0 then
+		temp := temp / 2;
+	    else
+		temp := (temp - 1) / 2; -- simulate ASR
+	    end if;
+	end loop;
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_UNSIGNED(ARG: UNSIGNED; SIZE: INTEGER) return UNSIGNED is
+	constant msb: INTEGER := min(ARG'length, SIZE) - 1;
+	subtype rtype is UNSIGNED (SIZE-1 downto 0);
+	variable new_bounds: UNSIGNED (ARG'length-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_ZERO_EXTEND
+	-- synopsys subpgm_id 372
+    begin
+	-- synopsys synthesis_off
+	new_bounds := MAKE_BINARY(ARG);
+	if (new_bounds(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	result := rtype'(others => '0');
+	result(msb downto 0) := new_bounds(msb downto 0);
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_UNSIGNED(ARG: SIGNED; SIZE: INTEGER) return UNSIGNED is
+	constant msb: INTEGER := min(ARG'length, SIZE) - 1;
+	subtype rtype is UNSIGNED (SIZE-1 downto 0);
+	variable new_bounds: UNSIGNED (ARG'length-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_SIGN_EXTEND
+	-- synopsys subpgm_id 373
+    begin
+	-- synopsys synthesis_off
+	new_bounds := MAKE_BINARY(ARG);
+	if (new_bounds(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	result := rtype'(others => new_bounds(new_bounds'left));
+	result(msb downto 0) := new_bounds(msb downto 0);
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_UNSIGNED(ARG: STD_ULOGIC; SIZE: INTEGER) return UNSIGNED is
+	subtype rtype is UNSIGNED (SIZE-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_ZERO_EXTEND
+	-- synopsys subpgm_id 375
+    begin
+	-- synopsys synthesis_off
+	result := rtype'(others => '0');
+	result(0) := MAKE_BINARY(ARG);
+	if (result(0) = 'X') then
+	    result := rtype'(others => 'X');
+	end if;
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    -- convert an integer to a 2's complement STD_ULOGIC_VECTOR
+    function CONV_SIGNED(ARG: INTEGER; SIZE: INTEGER) return SIGNED is
+	variable result: SIGNED (SIZE-1 downto 0);
+	variable temp: integer;
+	-- synopsys built_in SYN_INTEGER_TO_SIGNED
+	-- synopsys subpgm_id 376
+    begin
+	-- synopsys synthesis_off
+	temp := ARG;
+	for i in 0 to SIZE-1 loop
+	    if (temp mod 2) = 1 then
+		result(i) := '1';
+	    else 
+		result(i) := '0';
+	    end if;
+	    if temp > 0 then
+		temp := temp / 2;
+	    elsif (temp > integer'low) then
+		temp := (temp - 1) / 2; -- simulate ASR
+	    else
+		temp := temp / 2; -- simulate ASR
+	    end if;
+	end loop;
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_SIGNED(ARG: UNSIGNED; SIZE: INTEGER) return SIGNED is
+	constant msb: INTEGER := min(ARG'length, SIZE) - 1;
+	subtype rtype is SIGNED (SIZE-1 downto 0);
+	variable new_bounds : SIGNED (ARG'length-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_ZERO_EXTEND
+	-- synopsys subpgm_id 377
+    begin
+	-- synopsys synthesis_off
+	new_bounds := MAKE_BINARY(ARG);
+	if (new_bounds(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	result := rtype'(others => '0');
+	result(msb downto 0) := new_bounds(msb downto 0);
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+    function CONV_SIGNED(ARG: SIGNED; SIZE: INTEGER) return SIGNED is
+	constant msb: INTEGER := min(ARG'length, SIZE) - 1;
+	subtype rtype is SIGNED (SIZE-1 downto 0);
+	variable new_bounds : SIGNED (ARG'length-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_SIGN_EXTEND
+	-- synopsys subpgm_id 378
+    begin
+	-- synopsys synthesis_off
+	new_bounds := MAKE_BINARY(ARG);
+	if (new_bounds(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	result := rtype'(others => new_bounds(new_bounds'left));
+	result(msb downto 0) := new_bounds(msb downto 0);
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_SIGNED(ARG: STD_ULOGIC; SIZE: INTEGER) return SIGNED is
+	subtype rtype is SIGNED (SIZE-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_ZERO_EXTEND
+	-- synopsys subpgm_id 380
+    begin
+	-- synopsys synthesis_off
+	result := rtype'(others => '0');
+	result(0) := MAKE_BINARY(ARG);
+	if (result(0) = 'X') then
+	    result := rtype'(others => 'X');
+	end if;
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    -- convert an integer to an STD_LOGIC_VECTOR
+    function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) return STD_LOGIC_VECTOR is
+	variable result: STD_LOGIC_VECTOR (SIZE-1 downto 0);
+	variable temp: integer;
+	-- synopsys built_in SYN_INTEGER_TO_SIGNED
+	-- synopsys subpgm_id 381
+    begin
+	-- synopsys synthesis_off
+	temp := ARG;
+	for i in 0 to SIZE-1 loop
+	    if (temp mod 2) = 1 then
+		result(i) := '1';
+	    else 
+		result(i) := '0';
+	    end if;
+	    if temp > 0 then
+		temp := temp / 2;
+	    elsif (temp > integer'low) then
+		temp := (temp - 1) / 2; -- simulate ASR
+	    else
+		temp := temp / 2; -- simulate ASR
+	    end if;
+	end loop;
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_STD_LOGIC_VECTOR(ARG: UNSIGNED; SIZE: INTEGER) return STD_LOGIC_VECTOR is
+	constant msb: INTEGER := min(ARG'length, SIZE) - 1;
+	subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0);
+	variable new_bounds : STD_LOGIC_VECTOR (ARG'length-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_ZERO_EXTEND
+	-- synopsys subpgm_id 382
+    begin
+	-- synopsys synthesis_off
+	new_bounds := MAKE_BINARY(ARG);
+	if (new_bounds(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	result := rtype'(others => '0');
+	result(msb downto 0) := new_bounds(msb downto 0);
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+    function CONV_STD_LOGIC_VECTOR(ARG: SIGNED; SIZE: INTEGER) return STD_LOGIC_VECTOR is
+	constant msb: INTEGER := min(ARG'length, SIZE) - 1;
+	subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0);
+	variable new_bounds : STD_LOGIC_VECTOR (ARG'length-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_SIGN_EXTEND
+	-- synopsys subpgm_id 383
+    begin
+	-- synopsys synthesis_off
+	new_bounds := MAKE_BINARY(ARG);
+	if (new_bounds(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	result := rtype'(others => new_bounds(new_bounds'left));
+	result(msb downto 0) := new_bounds(msb downto 0);
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function CONV_STD_LOGIC_VECTOR(ARG: STD_ULOGIC; SIZE: INTEGER) return STD_LOGIC_VECTOR is
+	subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_ZERO_EXTEND
+	-- synopsys subpgm_id 384
+    begin
+	-- synopsys synthesis_off
+	result := rtype'(others => '0');
+	result(0) := MAKE_BINARY(ARG);
+	if (result(0) = 'X') then
+	    result := rtype'(others => 'X');
+	end if;
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+    function EXT(ARG: STD_LOGIC_VECTOR; SIZE: INTEGER) 
+						return STD_LOGIC_VECTOR is
+	constant msb: INTEGER := min(ARG'length, SIZE) - 1;
+	subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0);
+	variable new_bounds: STD_LOGIC_VECTOR (ARG'length-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_ZERO_EXTEND
+	-- synopsys subpgm_id 385
+    begin
+	-- synopsys synthesis_off
+	new_bounds := MAKE_BINARY(ARG);
+	if (new_bounds(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	result := rtype'(others => '0');
+	result(msb downto 0) := new_bounds(msb downto 0);
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+    function SXT(ARG: STD_LOGIC_VECTOR; SIZE: INTEGER) return STD_LOGIC_VECTOR is
+	constant msb: INTEGER := min(ARG'length, SIZE) - 1;
+	subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0);
+	variable new_bounds : STD_LOGIC_VECTOR (ARG'length-1 downto 0);
+	variable result: rtype;
+	-- synopsys built_in SYN_SIGN_EXTEND
+	-- synopsys subpgm_id 386
+    begin
+	-- synopsys synthesis_off
+	new_bounds := MAKE_BINARY(ARG);
+	if (new_bounds(0) = 'X') then
+	    result := rtype'(others => 'X');
+	    return result;
+	end if;
+	result := rtype'(others => new_bounds(new_bounds'left));
+	result(msb downto 0) := new_bounds(msb downto 0);
+	return result;
+	-- synopsys synthesis_on
+    end;
+
+
+end std_logic_arith;
diff --git a/libraries/synopsys/std_logic_misc-body.vhdl b/libraries/synopsys/std_logic_misc-body.vhdl
new file mode 100644
index 000000000..531328c3f
--- /dev/null
+++ b/libraries/synopsys/std_logic_misc-body.vhdl
@@ -0,0 +1,811 @@
+--------------------------------------------------------------------------
+--
+-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc.  All rights reserved.
+-- 
+-- This source file may be used and distributed without restriction 
+-- provided that this copyright statement is not removed from the file 
+-- and that any derivative work contains this copyright notice.
+--
+--	Package name: std_logic_misc
+--
+--	Purpose: This package defines supplemental types, subtypes, 
+--		 constants, and functions for the Std_logic_1164 Package.
+--
+--	Author:  GWH
+--
+--------------------------------------------------------------------------
+
+package body std_logic_misc is
+
+--synopsys synthesis_off
+
+    type STRN_STD_ULOGIC_TABLE is array (STD_ULOGIC,STRENGTH) of STD_ULOGIC;
+
+    --------------------------------------------------------------------
+    --
+    -- Truth tables for output strength --> STD_ULOGIC lookup
+    --
+    --------------------------------------------------------------------
+
+    -- truth table for output strength --> STD_ULOGIC lookup
+    constant tbl_STRN_STD_ULOGIC: STRN_STD_ULOGIC_TABLE := 
+    --  ------------------------------------------------------------------
+    --  | X01  X0H  XL1  X0Z  XZ1  WLH  WLZ  WZH  W0H  WL1 | strn/ output|
+    --  ------------------------------------------------------------------
+        (('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U'),  -- |   U   |
+         ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'),  -- |   X   |
+         ('0', '0', 'L', '0', 'Z', 'L', 'L', 'Z', '0', 'L'),  -- |   0   |
+         ('1', 'H', '1', 'Z', '1', 'H', 'Z', 'H', 'H', '1'),  -- |   1   |
+         ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'),  -- |   Z   |
+         ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'),  -- |   W   |
+         ('0', '0', 'L', '0', 'Z', 'L', 'L', 'Z', '0', 'L'),  -- |   L   |
+         ('1', 'H', '1', 'Z', '1', 'H', 'Z', 'H', 'H', '1'),  -- |   H   |
+         ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W')); -- |   -   |
+
+
+
+    --------------------------------------------------------------------
+    --
+    -- Truth tables for strength --> STD_ULOGIC mapping ('Z' pass through)
+    --
+    --------------------------------------------------------------------
+
+    -- truth table for output strength --> STD_ULOGIC lookup
+    constant tbl_STRN_STD_ULOGIC_Z: STRN_STD_ULOGIC_TABLE := 
+    --  ------------------------------------------------------------------
+    --  | X01  X0H  XL1  X0Z  XZ1  WLH  WLZ  WZH  W0H  WL1 | strn/ output|
+    --  ------------------------------------------------------------------
+        (('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U'),  -- |   U   |
+         ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'),  -- |   X   |
+         ('0', '0', 'L', '0', 'Z', 'L', 'L', 'Z', '0', 'L'),  -- |   0   |
+         ('1', 'H', '1', 'Z', '1', 'H', 'Z', 'H', 'H', '1'),  -- |   1   |
+         ('Z', 'Z', 'Z', 'Z', 'Z', 'Z', 'Z', 'Z', 'Z', 'Z'),  -- |   Z   |
+         ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'),  -- |   W   |
+         ('0', '0', 'L', '0', 'Z', 'L', 'L', 'Z', '0', 'L'),  -- |   L   |
+         ('1', 'H', '1', 'Z', '1', 'H', 'Z', 'H', 'H', '1'),  -- |   H   |
+         ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W')); -- |   -   |
+
+
+
+    ---------------------------------------------------------------------
+    --
+    -- functions for mapping the STD_(U)LOGIC according to STRENGTH
+    --
+    ---------------------------------------------------------------------
+
+    function strength_map(input: STD_ULOGIC; strn: STRENGTH) return STD_LOGIC is
+	-- pragma subpgm_id 387
+    begin
+    	return tbl_STRN_STD_ULOGIC(input, strn);
+    end strength_map;
+
+
+    function strength_map_z(input:STD_ULOGIC; strn:STRENGTH) return STD_LOGIC is
+	-- pragma subpgm_id 388
+    begin
+    	return tbl_STRN_STD_ULOGIC_Z(input, strn);
+    end strength_map_z;
+
+
+    ---------------------------------------------------------------------
+    --
+    -- conversion functions for STD_LOGIC_VECTOR and STD_ULOGIC_VECTOR
+    --
+    ---------------------------------------------------------------------
+
+--synopsys synthesis_on
+    function Drive (V: STD_LOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+      -- pragma built_in SYN_FEED_THRU
+      -- pragma subpgm_id 389
+--synopsys synthesis_off
+        alias Value: STD_LOGIC_VECTOR (V'length-1 downto 0) is V;
+--synopsys synthesis_on
+    begin
+--synopsys synthesis_off
+    	return STD_ULOGIC_VECTOR(Value);
+--synopsys synthesis_on
+    end Drive;
+
+
+    function Drive (V: STD_ULOGIC_VECTOR) return STD_LOGIC_VECTOR is
+      -- pragma built_in SYN_FEED_THRU
+      -- pragma subpgm_id 390
+--synopsys synthesis_off
+        alias Value: STD_ULOGIC_VECTOR (V'length-1 downto 0) is V;
+--synopsys synthesis_on
+    begin
+--synopsys synthesis_off
+    	return STD_LOGIC_VECTOR(Value);
+--synopsys synthesis_on
+    end Drive;
+--synopsys synthesis_off
+
+
+    ---------------------------------------------------------------------
+    --
+    -- conversion functions for sensing various types
+    --
+    -- (the second argument allows the user to specify the value to
+    --  be returned when the network is undriven)
+    --
+    ---------------------------------------------------------------------
+
+    function Sense (V: STD_ULOGIC; vZ, vU, vDC: STD_ULOGIC) 
+    					        return STD_LOGIC is
+	-- pragma subpgm_id 391
+    begin
+    	if V = 'Z' then
+    		return vZ;
+	elsif V = 'U' then
+		return vU;
+	elsif V = '-' then
+		return vDC;
+    	else
+    		return V;
+    	end if;
+    end Sense;
+
+
+    function Sense (V: STD_ULOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) 
+    					return STD_LOGIC_VECTOR is
+	-- pragma subpgm_id 392
+    	alias Value: STD_ULOGIC_VECTOR (V'length-1 downto 0) is V;
+    	variable Result: STD_LOGIC_VECTOR (V'length-1 downto 0);
+    begin
+    	for i in Value'range loop
+    		if ( Value(i) = 'Z' ) then
+    			Result(i) := vZ;
+		elsif Value(i) = 'U' then
+			Result(i) :=  vU;
+		elsif Value(i) = '-' then
+			Result(i) := vDC;
+    		else
+    			Result(i) := Value(i);
+    		end if;
+    	end loop;
+    	return Result;
+    end Sense;
+
+
+    function Sense (V: STD_ULOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) 
+    					return STD_ULOGIC_VECTOR is
+	-- pragma subpgm_id 393
+    	alias Value: STD_ULOGIC_VECTOR (V'length-1 downto 0) is V;
+    	variable Result: STD_ULOGIC_VECTOR (V'length-1 downto 0);
+    begin
+    	for i in Value'range loop
+    		if ( Value(i) = 'Z' ) then
+    			Result(i) := vZ;
+		elsif Value(i) = 'U' then
+			Result(i) :=  vU;
+		elsif Value(i) = '-' then
+			Result(i) := vDC;
+    		else
+    			Result(i) := Value(i);
+    		end if;
+    	end loop;
+    	return Result;
+    end Sense;
+
+
+    function Sense (V: STD_LOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) 
+    					return STD_LOGIC_VECTOR is
+	-- pragma subpgm_id 394
+    	alias Value: STD_LOGIC_VECTOR (V'length-1 downto 0) is V;
+    	variable Result: STD_LOGIC_VECTOR (V'length-1 downto 0);
+    begin
+    	for i in Value'range loop
+    		if ( Value(i) = 'Z' ) then
+    			Result(i) := vZ;
+		elsif Value(i) = 'U' then
+			Result(i) :=  vU;
+		elsif Value(i) = '-' then
+			Result(i) := vDC;
+    		else
+    			Result(i) := Value(i);
+    		end if;
+    	end loop;
+    	return Result;
+    end Sense;
+
+
+    function Sense (V: STD_LOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) 
+    					return STD_ULOGIC_VECTOR is
+	-- pragma subpgm_id 395
+    	alias Value: STD_LOGIC_VECTOR (V'length-1 downto 0) is V;
+    	variable Result: STD_ULOGIC_VECTOR (V'length-1 downto 0);
+    begin
+    	for i in Value'range loop
+    		if ( Value(i) = 'Z' ) then
+    			Result(i) := vZ;
+		elsif Value(i) = 'U' then
+			Result(i) :=  vU;
+		elsif Value(i) = '-' then
+			Result(i) := vDC;
+    		else
+    			Result(i) := Value(i);
+    		end if;
+    	end loop;
+    	return Result;
+    end Sense;
+
+    ---------------------------------------------------------------------
+    --
+    --	Function: STD_LOGIC_VECTORtoBIT_VECTOR
+    --
+    --	Purpose: Conversion fun. from STD_LOGIC_VECTOR to BIT_VECTOR
+    --
+    --	Mapping:	0, L --> 0
+    --			1, H --> 1
+    --			X, W --> vX if Xflag is TRUE
+    --			X, W --> 0  if Xflag is FALSE
+    --			Z --> vZ if Zflag is TRUE
+    --			Z --> 0  if Zflag is FALSE
+    --			U --> vU if Uflag is TRUE
+    --			U --> 0  if Uflag is FALSE
+    --			- --> vDC if DCflag is TRUE
+    --			- --> 0  if DCflag is FALSE
+    --
+    ---------------------------------------------------------------------
+
+--synopsys synthesis_on
+    function STD_LOGIC_VECTORtoBIT_VECTOR (V: STD_LOGIC_VECTOR
+--synopsys synthesis_off
+    	; vX, vZ, vU, vDC: BIT := '0'; 
+    	  Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE
+--synopsys synthesis_on
+    		   ) return BIT_VECTOR is
+      -- pragma built_in SYN_FEED_THRU
+      -- pragma subpgm_id 396
+--synopsys synthesis_off
+    	alias Value: STD_LOGIC_VECTOR (V'length-1 downto 0) is V;
+    	variable Result: BIT_VECTOR (V'length-1 downto 0);
+--synopsys synthesis_on
+    begin
+--synopsys synthesis_off
+    	for i in Value'range loop
+    		case Value(i) is
+    			when '0' | 'L' =>
+    				Result(i) := '0';
+    			when '1' | 'H' =>
+    				Result(i) := '1';
+	    		when 'X' =>
+    				if ( Xflag ) then
+    					Result(i) := vX;
+    				else
+    					Result(i) := '0';
+	    		 		assert FALSE
+    				 	    report "STD_LOGIC_VECTORtoBIT_VECTOR: X --> 0"
+    				 	    severity WARNING;
+    				end if;
+	    		when 'W' =>
+    				if ( Xflag ) then
+    					Result(i) := vX;
+    				else
+    					Result(i) := '0';
+	    		 		assert FALSE
+    				 	    report "STD_LOGIC_VECTORtoBIT_VECTOR: W --> 0"
+    				 	    severity WARNING;
+    				end if;
+	    		when 'Z' =>
+    				if ( Zflag ) then
+    					Result(i) := vZ;
+	    			else
+    					Result(i) := '0';
+    					assert FALSE
+    					    report "STD_LOGIC_VECTORtoBIT_VECTOR: Z --> 0"
+    					    severity WARNING;
+	    			end if;
+    			when 'U' =>
+    				if ( Uflag ) then
+    					Result(i) := vU;
+	    			else
+    					Result(i) := '0';
+    					assert FALSE
+    					    report "STD_LOGIC_VECTORtoBIT_VECTOR: U --> 0"
+    					    severity WARNING;
+				end if;
+    			when '-' =>
+    				if ( DCflag ) then
+    					Result(i) := vDC;
+	    			else
+    					Result(i) := '0';
+    					assert FALSE
+    					    report "STD_LOGIC_VECTORtoBIT_VECTOR: - --> 0"
+    					    severity WARNING;
+	    			end if;
+    			end case;
+	    	end loop;
+    	return Result;
+--synopsys synthesis_on
+    end STD_LOGIC_VECTORtoBIT_VECTOR;
+
+
+
+
+    ---------------------------------------------------------------------
+    --
+    --	Function: STD_ULOGIC_VECTORtoBIT_VECTOR
+    --
+    --	Purpose: Conversion fun. from STD_ULOGIC_VECTOR to BIT_VECTOR
+    --
+    --	Mapping:	0, L --> 0
+    --			1, H --> 1
+    --			X, W --> vX if Xflag is TRUE
+    --			X, W --> 0  if Xflag is FALSE
+    --			Z --> vZ if Zflag is TRUE
+    --			Z --> 0  if Zflag is FALSE
+    --			U --> vU if Uflag is TRUE
+    --			U --> 0  if Uflag is FALSE
+    --			- --> vDC if DCflag is TRUE
+    --			- --> 0  if DCflag is FALSE
+    --
+    ---------------------------------------------------------------------
+
+    function STD_ULOGIC_VECTORtoBIT_VECTOR (V: STD_ULOGIC_VECTOR
+--synopsys synthesis_off
+    	; vX, vZ, vU, vDC: BIT := '0'; 
+    	  Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE
+--synopsys synthesis_on
+    		   ) return BIT_VECTOR is
+      -- pragma built_in SYN_FEED_THRU
+      -- pragma subpgm_id 397
+--synopsys synthesis_off
+    	alias Value: STD_ULOGIC_VECTOR (V'length-1 downto 0) is V;
+    	variable Result: BIT_VECTOR (V'length-1 downto 0);
+--synopsys synthesis_on
+    begin
+--synopsys synthesis_off
+    	for i in Value'range loop
+    		case Value(i) is
+    			when '0' | 'L' =>
+    				Result(i) := '0';
+    			when '1' | 'H' =>
+    				Result(i) := '1';
+	    		when 'X' =>
+    				if ( Xflag ) then
+    					Result(i) := vX;
+	    			else
+    					Result(i) := '0';
+	    		 		assert FALSE
+    				 	    report "STD_ULOGIC_VECTORtoBIT_VECTOR: X --> 0"
+    				 	    severity WARNING;
+	    			end if;
+    			when 'W' =>
+	    			if ( Xflag ) then
+    					Result(i) := vX;
+    				else
+    					Result(i) := '0';
+	    		 		assert FALSE
+    				 	    report "STD_ULOGIC_VECTORtoBIT_VECTOR: W --> 0"
+    				 	    severity WARNING;
+	    			end if;
+    			when 'Z' =>
+    				if ( Zflag ) then
+	    				Result(i) := vZ;
+    				else
+    					Result(i) := '0';
+    					assert FALSE
+    					    report "STD_ULOGIC_VECTORtoBIT_VECTOR: Z --> 0"
+	    				    severity WARNING;
+    				end if;
+	    		when 'U' =>
+    				if ( Uflag ) then
+    					Result(i) := vU;
+	    			else
+    					Result(i) := '0';
+    					assert FALSE
+    					    report "STD_ULOGIC_VECTORtoBIT_VECTOR: U --> 0"
+    					    severity WARNING;
+				end if;
+    			when '-' =>
+    				if ( DCflag ) then
+    					Result(i) := vDC;
+	    			else
+    					Result(i) := '0';
+    					assert FALSE
+    					    report "STD_ULOGIC_VECTORtoBIT_VECTOR: - --> 0"
+    					    severity WARNING;
+	    			end if;
+    			end case;
+    	end loop;
+    	return Result;
+--synopsys synthesis_on
+    end STD_ULOGIC_VECTORtoBIT_VECTOR;
+
+
+
+
+    ---------------------------------------------------------------------
+    --
+    --	Function: STD_ULOGICtoBIT
+    --
+    --	Purpose: Conversion function from STD_ULOGIC to BIT
+    --
+    --	Mapping:	0, L --> 0
+    --			1, H --> 1
+    --			X, W --> vX if Xflag is TRUE
+    --			X, W --> 0  if Xflag is FALSE
+    --			Z --> vZ if Zflag is TRUE
+    --			Z --> 0  if Zflag is FALSE
+    --			U --> vU if Uflag is TRUE
+    --			U --> 0  if Uflag is FALSE
+    --			- --> vDC if DCflag is TRUE
+    --			- --> 0  if DCflag is FALSE
+    --
+    ---------------------------------------------------------------------
+
+    function STD_ULOGICtoBIT (V: STD_ULOGIC
+--synopsys synthesis_off
+    	; vX, vZ, vU, vDC: BIT := '0'; 
+    	  Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE
+--synopsys synthesis_on
+    		   ) return BIT is
+      -- pragma built_in SYN_FEED_THRU
+      -- pragma subpgm_id 398
+    	variable Result: BIT;
+    begin
+--synopsys synthesis_off
+    	case V is
+    		when '0' | 'L' =>
+    			Result := '0';
+    		when '1' | 'H' =>
+    			Result := '1';
+    		when 'X' =>
+    			if ( Xflag ) then
+    				Result := vX;
+    			else
+    				Result := '0';
+    		 		assert FALSE
+    			 	    report "STD_ULOGICtoBIT: X --> 0"
+    			 	    severity WARNING;
+    			end if;
+    		when 'W' =>
+    			if ( Xflag ) then
+    				Result := vX;
+    			else
+    				Result := '0';
+    		 		assert FALSE
+    			 	    report "STD_ULOGICtoBIT: W --> 0"
+    			 	    severity WARNING;
+    			end if;
+    		when 'Z' =>
+    			if ( Zflag ) then
+    				Result := vZ;
+    			else
+    				Result := '0';
+    				assert FALSE
+    				    report "STD_ULOGICtoBIT: Z --> 0"
+    				    severity WARNING;
+    			end if;
+    		when 'U' =>
+    			if ( Uflag ) then
+    				Result := vU;
+    			else
+    				Result := '0';
+    				assert FALSE
+    				    report "STD_ULOGICtoBIT: U --> 0"
+    				    severity WARNING;
+			end if;
+    		when '-' =>
+    			if ( DCflag ) then
+    				Result := vDC;
+    			else
+    				Result := '0';
+    				assert FALSE
+    				    report "STD_ULOGICtoBIT: - --> 0"
+    				    severity WARNING;
+    			end if;
+    	end case;
+    	return Result;
+--synopsys synthesis_on
+    end STD_ULOGICtoBIT;
+
+
+    --------------------------------------------------------------------------
+
+    function AND_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 399
+	variable result: STD_LOGIC;
+    begin
+	result := '1';
+	for i in ARG'range loop
+	    result := result and ARG(i);
+	end loop;
+        return result;
+    end;
+
+    function NAND_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 400
+    begin
+        return not AND_REDUCE(ARG);
+    end;
+
+    function OR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 401
+	variable result: STD_LOGIC;
+    begin
+	result := '0';
+	for i in ARG'range loop
+	    result := result or ARG(i);
+	end loop;
+        return result;
+    end;
+
+    function NOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 402
+    begin
+        return not OR_REDUCE(ARG);
+    end;
+
+    function XOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 403
+	variable result: STD_LOGIC;
+    begin
+	result := '0';
+	for i in ARG'range loop
+	    result := result xor ARG(i);
+	end loop;
+        return result;
+    end;
+
+    function XNOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 404
+    begin
+        return not XOR_REDUCE(ARG);
+    end;
+
+    function AND_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 405
+	variable result: STD_LOGIC;
+    begin
+	result := '1';
+	for i in ARG'range loop
+	    result := result and ARG(i);
+	end loop;
+        return result;
+    end;
+
+    function NAND_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 406
+    begin
+        return not AND_REDUCE(ARG);
+    end;
+
+    function OR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 407
+	variable result: STD_LOGIC;
+    begin
+	result := '0';
+	for i in ARG'range loop
+	    result := result or ARG(i);
+	end loop;
+        return result;
+    end;
+
+    function NOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 408
+    begin
+        return not OR_REDUCE(ARG);
+    end;
+
+    function XOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 409
+	variable result: STD_LOGIC;
+    begin
+	result := '0';
+	for i in ARG'range loop
+	    result := result xor ARG(i);
+	end loop;
+        return result;
+    end;
+
+    function XNOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is
+	-- pragma subpgm_id 410
+    begin
+        return not XOR_REDUCE(ARG);
+    end;
+
+--synopsys synthesis_off
+	
+    function fun_BUF3S(Input, Enable: UX01; Strn: STRENGTH) return STD_LOGIC is
+	-- pragma subpgm_id 411
+	type TRISTATE_TABLE is array(STRENGTH, UX01, UX01) of STD_LOGIC;
+
+	-- truth table for tristate "buf" function (Enable active Low)
+          constant tbl_BUF3S: TRISTATE_TABLE := 
+          -- ----------------------------------------------------
+          -- | Input   U    X    0    1       | Enable Strength |
+          -- ---------------------------------|-----------------|
+        	   ((('U', 'U', 'U', 'U'),  --|   U       X01   |
+        	     ('U', 'X', 'X', 'X'),  --|   X       X01   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       X01   |
+        	     ('U', 'X', '0', '1')), --|   1       X01   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       X0H   |
+        	     ('U', 'X', 'X', 'X'),  --|   X       X0H   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       X0H   |
+        	     ('U', 'X', '0', 'H')), --|   1       X0H   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       XL1   |
+        	     ('U', 'X', 'X', 'X'),  --|   X       XL1   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       XL1   |
+        	     ('U', 'X', 'L', '1')), --|   1       XL1   |
+        	    (('U', 'U', 'U', 'Z'),  --|   U       X0Z   |
+        	     ('U', 'X', 'X', 'Z'),  --|   X       X0Z   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       X0Z   |
+        	     ('U', 'X', '0', 'Z')), --|   1       X0Z   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       XZ1   |
+        	     ('U', 'X', 'X', 'X'),  --|   X       XZ1   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       XZ1   |
+        	     ('U', 'X', 'Z', '1')), --|   1       XZ1   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       WLH   |
+        	     ('U', 'W', 'W', 'W'),  --|   X       WLH   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       WLH   |
+        	     ('U', 'W', 'L', 'H')), --|   1       WLH   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       WLZ   |
+        	     ('U', 'W', 'W', 'Z'),  --|   X       WLZ   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       WLZ   |
+        	     ('U', 'W', 'L', 'Z')), --|   1       WLZ   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       WZH   |
+        	     ('U', 'W', 'W', 'W'),  --|   X       WZH   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       WZH   |
+        	     ('U', 'W', 'Z', 'H')), --|   1       WZH   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       W0H   |
+        	     ('U', 'W', 'W', 'W'),  --|   X       W0H   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       W0H   |
+        	     ('U', 'W', '0', 'H')), --|   1       W0H   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       WL1   |
+        	     ('U', 'W', 'W', 'W'),  --|   X       WL1   |
+        	     ('Z', 'Z', 'Z', 'Z'),  --|   0       WL1   |
+        	     ('U', 'W', 'L', '1')));--|   1       WL1   |
+    begin
+	return tbl_BUF3S(Strn, Enable, Input);
+    end fun_BUF3S;
+
+
+    function fun_BUF3SL(Input, Enable: UX01; Strn: STRENGTH) return STD_LOGIC is
+	-- pragma subpgm_id 412
+	type TRISTATE_TABLE is array(STRENGTH, UX01, UX01) of STD_LOGIC;
+
+	-- truth table for tristate "buf" function (Enable active Low)
+          constant tbl_BUF3SL: TRISTATE_TABLE := 
+          -- ----------------------------------------------------
+          -- | Input   U    X    0    1       | Enable Strength |
+          -- ---------------------------------|-----------------|
+        	   ((('U', 'U', 'U', 'U'),  --|   U       X01   |
+        	     ('U', 'X', 'X', 'X'),  --|   X       X01   |
+        	     ('U', 'X', '0', '1'),  --|   0       X01   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       X01   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       X0H   |
+        	     ('U', 'X', 'X', 'X'),  --|   X       X0H   |
+        	     ('U', 'X', '0', 'H'),  --|   0       X0H   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       X0H   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       XL1   |
+        	     ('U', 'X', 'X', 'X'),  --|   X       XL1   |
+        	     ('U', 'X', 'L', '1'),  --|   0       XL1   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       XL1   |
+        	    (('U', 'U', 'U', 'Z'),  --|   U       X0Z   |
+        	     ('U', 'X', 'X', 'Z'),  --|   X       X0Z   |
+        	     ('U', 'X', '0', 'Z'),  --|   0       X0Z   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       X0Z   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       XZ1   |
+        	     ('U', 'X', 'X', 'X'),  --|   X       XZ1   |
+        	     ('U', 'X', 'Z', '1'),  --|   0       XZ1   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       XZ1   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       WLH   |
+        	     ('U', 'W', 'W', 'W'),  --|   X       WLH   |
+        	     ('U', 'W', 'L', 'H'),  --|   0       WLH   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       WLH   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       WLZ   |
+        	     ('U', 'W', 'W', 'Z'),  --|   X       WLZ   |
+        	     ('U', 'W', 'L', 'Z'),  --|   0       WLZ   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       WLZ   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       WZH   |
+        	     ('U', 'W', 'W', 'W'),  --|   X       WZH   |
+        	     ('U', 'W', 'Z', 'H'),  --|   0       WZH   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       WZH   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       W0H   |
+        	     ('U', 'W', 'W', 'W'),  --|   X       W0H   |
+        	     ('U', 'W', '0', 'H'),  --|   0       W0H   |
+        	     ('Z', 'Z', 'Z', 'Z')), --|   1       W0H   |
+        	    (('U', 'U', 'U', 'U'),  --|   U       WL1   |
+        	     ('U', 'W', 'W', 'W'),  --|   X       WL1   |
+        	     ('U', 'W', 'L', '1'),  --|   0       WL1   |
+        	     ('Z', 'Z', 'Z', 'Z')));--|   1       WL1   |
+    begin
+	return tbl_BUF3SL(Strn, Enable, Input);
+    end fun_BUF3SL;
+
+
+    function fun_MUX2x1(Input0, Input1, Sel: UX01) return UX01 is
+	-- pragma subpgm_id 413
+	type MUX_TABLE is array (UX01, UX01, UX01) of UX01;
+
+	-- truth table for "MUX2x1" function
+	constant tbl_MUX2x1: MUX_TABLE :=
+	--------------------------------------------
+        --| In0  'U'  'X'  '0'  '1'      | Sel In1 |
+	--------------------------------------------
+	      ((('U', 'U', 'U', 'U'),  --| 'U' 'U' |
+	        ('U', 'U', 'U', 'U'),  --| 'X' 'U' |
+		('U', 'X', '0', '1'),  --| '0' 'U' |
+		('U', 'U', 'U', 'U')), --| '1' 'U' |
+	       (('U', 'X', 'U', 'U'),  --| 'U' 'X' |
+	        ('U', 'X', 'X', 'X'),  --| 'X' 'X' |
+		('U', 'X', '0', '1'),  --| '0' 'X' |
+		('X', 'X', 'X', 'X')), --| '1' 'X' |
+	       (('U', 'U', '0', 'U'),  --| 'U' '0' |
+	        ('U', 'X', '0', 'X'),  --| 'X' '0' |
+		('U', 'X', '0', '1'),  --| '0' '0' |
+		('0', '0', '0', '0')), --| '1' '0' |
+	       (('U', 'U', 'U', '1'),  --| 'U' '1' |
+	        ('U', 'X', 'X', '1'),  --| 'X' '1' |
+		('U', 'X', '0', '1'),  --| '0' '1' |
+		('1', '1', '1', '1')));--| '1' '1' |
+    begin
+	return tbl_MUX2x1(Input1, Sel, Input0);
+    end fun_MUX2x1;
+
+
+    function fun_MAJ23(Input0, Input1, Input2: UX01) return UX01 is
+	-- pragma subpgm_id 414
+	type MAJ23_TABLE is array (UX01, UX01, UX01) of UX01;
+
+	----------------------------------------------------------------------------
+	--	The "tbl_MAJ23" truth table return 1 if the majority of three
+	--	inputs is 1, a 0 if the majority is 0, a X if unknown, and a U if
+	--	uninitialized.
+	----------------------------------------------------------------------------
+	constant tbl_MAJ23: MAJ23_TABLE :=
+        --------------------------------------------
+        --| In0  'U'  'X'  '0'  '1'      | In1 In2 |
+        --------------------------------------------
+              ((('U', 'U', 'U', 'U'),  --| 'U' 'U' |
+                ('U', 'U', 'U', 'U'),  --| 'X' 'U' |
+                ('U', 'U', '0', 'U'),  --| '0' 'U' |
+                ('U', 'U', 'U', '1')), --| '1' 'U' |
+               (('U', 'U', 'U', 'U'),  --| 'U' 'X' |
+                ('U', 'X', 'X', 'X'),  --| 'X' 'X' |
+                ('U', 'X', '0', 'X'),  --| '0' 'X' |
+                ('U', 'X', 'X', '1')), --| '1' 'X' |
+               (('U', 'U', '0', 'U'),  --| 'U' '0' |
+                ('U', 'X', '0', 'X'),  --| 'X' '0' |
+                ('0', '0', '0', '0'),  --| '0' '0' |
+                ('U', 'X', '0', '1')), --| '1' '0' |
+               (('U', 'U', 'U', '1'),  --| 'U' '1' |
+                ('U', 'X', 'X', '1'),  --| 'X' '1' |
+                ('U', 'X', '0', '1'),  --| '0' '1' |
+                ('1', '1', '1', '1')));--| '1' '1' |
+
+    begin
+	return tbl_MAJ23(Input0, Input1, Input2);
+    end fun_MAJ23;
+
+
+    function fun_WiredX(Input0, Input1: STD_ULOGIC) return STD_LOGIC is
+	-- pragma subpgm_id 415
+        TYPE stdlogic_table IS ARRAY(STD_ULOGIC, STD_ULOGIC) OF STD_LOGIC;
+
+	-- truth table for "WiredX" function
+        -------------------------------------------------------------------    
+        -- resolution function
+        -------------------------------------------------------------------    
+        CONSTANT resolution_table : stdlogic_table := (
+        --      ---------------------------------------------------------
+        --      |  U    X    0    1    Z    W    L    H    -        |   |  
+        --      ---------------------------------------------------------
+                ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ), -- | U |
+                ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | X |
+                ( 'U', 'X', '0', 'X', '0', '0', '0', '0', 'X' ), -- | 0 |
+                ( 'U', 'X', 'X', '1', '1', '1', '1', '1', 'X' ), -- | 1 |
+                ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', 'X' ), -- | Z |
+                ( 'U', 'X', '0', '1', 'W', 'W', 'W', 'W', 'X' ), -- | W |
+                ( 'U', 'X', '0', '1', 'L', 'W', 'L', 'W', 'X' ), -- | L |
+                ( 'U', 'X', '0', '1', 'H', 'W', 'W', 'H', 'X' ), -- | H |
+                ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ));-- | - |
+    begin
+	return resolution_table(Input0, Input1);
+    end fun_WiredX;
+
+--synopsys synthesis_on
+	
+end;
diff --git a/libraries/synopsys/std_logic_misc.vhdl b/libraries/synopsys/std_logic_misc.vhdl
new file mode 100644
index 000000000..999aa8391
--- /dev/null
+++ b/libraries/synopsys/std_logic_misc.vhdl
@@ -0,0 +1,170 @@
+--------------------------------------------------------------------------
+--
+-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc.  All rights reserved.
+-- 
+-- This source file may be used and distributed without restriction 
+-- provided that this copyright statement is not removed from the file 
+-- and that any derivative work contains this copyright notice.
+--
+--	Package name: std_logic_misc
+--
+--	Purpose: This package defines supplemental types, subtypes, 
+--		 constants, and functions for the Std_logic_1164 Package.
+--
+--	Author:  GWH
+--
+--------------------------------------------------------------------------
+
+library IEEE;
+use IEEE.STD_LOGIC_1164.all;
+--library SYNOPSYS;
+--use SYNOPSYS.attributes.all;
+
+
+package std_logic_misc is
+
+    -- output-strength types
+
+    type STRENGTH is (strn_X01, strn_X0H, strn_XL1, strn_X0Z, strn_XZ1, 
+		      strn_WLH, strn_WLZ, strn_WZH, strn_W0H, strn_WL1);
+
+
+--synopsys synthesis_off
+
+    type MINOMAX is array (1 to 3) of TIME;
+    
+
+    ---------------------------------------------------------------------
+    --
+    -- functions for mapping the STD_(U)LOGIC according to STRENGTH
+    --
+    ---------------------------------------------------------------------
+
+    function strength_map(input: STD_ULOGIC; strn: STRENGTH) return STD_LOGIC;
+
+    function strength_map_z(input:STD_ULOGIC; strn:STRENGTH) return STD_LOGIC;
+
+    ---------------------------------------------------------------------
+    --
+    -- conversion functions for STD_ULOGIC_VECTOR and STD_LOGIC_VECTOR
+    --
+    ---------------------------------------------------------------------
+
+--synopsys synthesis_on
+    function Drive (V: STD_ULOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function Drive (V: STD_LOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+--synopsys synthesis_off
+
+    --attribute CLOSELY_RELATED_TCF of Drive: function is TRUE;
+
+    ---------------------------------------------------------------------
+    --
+    -- conversion functions for sensing various types
+    -- (the second argument allows the user to specify the value to
+    --  be returned when the network is undriven)
+    --
+    ---------------------------------------------------------------------
+
+    function Sense (V: STD_ULOGIC; vZ, vU, vDC: STD_ULOGIC) return STD_LOGIC;
+
+    function Sense (V: STD_ULOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) 
+    					   return STD_LOGIC_VECTOR;
+    function Sense (V: STD_ULOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) 
+    					   return STD_ULOGIC_VECTOR;
+
+    function Sense (V: STD_LOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) 
+    					   return STD_LOGIC_VECTOR;
+    function Sense (V: STD_LOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) 
+    					   return STD_ULOGIC_VECTOR;
+
+--synopsys synthesis_on
+
+
+    ---------------------------------------------------------------------
+    --
+    --	Function: STD_LOGIC_VECTORtoBIT_VECTOR STD_ULOGIC_VECTORtoBIT_VECTOR
+    --
+    --	Purpose: Conversion fun. from STD_(U)LOGIC_VECTOR to BIT_VECTOR
+    --
+    --	Mapping:	0, L --> 0
+    --			1, H --> 1
+    --			X, W --> vX if Xflag is TRUE
+    --			X, W --> 0  if Xflag is FALSE
+    --			Z --> vZ if Zflag is TRUE
+    --			Z --> 0  if Zflag is FALSE
+    --			U --> vU if Uflag is TRUE
+    --			U --> 0  if Uflag is FALSE
+    --			- --> vDC if DCflag is TRUE
+    --			- --> 0  if DCflag is FALSE
+    --
+    ---------------------------------------------------------------------
+
+    function STD_LOGIC_VECTORtoBIT_VECTOR (V: STD_LOGIC_VECTOR
+--synopsys synthesis_off
+    	; vX, vZ, vU, vDC: BIT := '0'; 
+    	  Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE
+--synopsys synthesis_on
+    	) return BIT_VECTOR;
+
+    function STD_ULOGIC_VECTORtoBIT_VECTOR (V: STD_ULOGIC_VECTOR
+--synopsys synthesis_off
+    	; vX, vZ, vU, vDC: BIT := '0'; 
+    	  Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE
+--synopsys synthesis_on
+    	) return BIT_VECTOR;
+    
+
+    ---------------------------------------------------------------------
+    --
+    --	Function: STD_ULOGICtoBIT
+    --
+    --	Purpose: Conversion function from STD_(U)LOGIC to BIT
+    --
+    --	Mapping:	0, L --> 0
+    --			1, H --> 1
+    --			X, W --> vX if Xflag is TRUE
+    --			X, W --> 0  if Xflag is FALSE
+    --			Z --> vZ if Zflag is TRUE
+    --			Z --> 0  if Zflag is FALSE
+    --			U --> vU if Uflag is TRUE
+    --			U --> 0  if Uflag is FALSE
+    --			- --> vDC if DCflag is TRUE
+    --			- --> 0  if DCflag is FALSE
+    --
+    ---------------------------------------------------------------------
+
+    function STD_ULOGICtoBIT (V: STD_ULOGIC
+--synopsys synthesis_off
+    	; vX, vZ, vU, vDC: BIT := '0'; 
+    	  Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE
+--synopsys synthesis_on
+    	) return BIT;
+
+        --------------------------------------------------------------------
+        function AND_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01;
+        function NAND_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01;
+        function OR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01;
+        function NOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01;
+        function XOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01;
+        function XNOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01;
+    
+        function AND_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01;
+        function NAND_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01;
+        function OR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01;
+        function NOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01;
+        function XOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01;
+        function XNOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01;
+    
+--synopsys synthesis_off
+	
+        function fun_BUF3S(Input, Enable: UX01; Strn: STRENGTH) return STD_LOGIC;
+        function fun_BUF3SL(Input, Enable: UX01; Strn: STRENGTH) return STD_LOGIC;
+        function fun_MUX2x1(Input0, Input1, Sel: UX01) return UX01;
+
+        function fun_MAJ23(Input0, Input1, Input2: UX01) return UX01;
+        function fun_WiredX(Input0, Input1: std_ulogic) return STD_LOGIC;
+
+--synopsys synthesis_on
+	
+end;
diff --git a/libraries/synopsys/std_logic_signed.vhdl b/libraries/synopsys/std_logic_signed.vhdl
new file mode 100644
index 000000000..27d211be5
--- /dev/null
+++ b/libraries/synopsys/std_logic_signed.vhdl
@@ -0,0 +1,343 @@
+--------------------------------------------------------------------------
+--                                                                      --
+-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc.                     --
+--                                             All rights reserved.     --
+--                                                                      --
+-- This source file may be used and distributed without restriction     --
+-- provided that this copyright statement is not removed from the file  --
+-- and that any derivative work contains this copyright notice.         --
+--                                                                      --
+--	Package name: STD_LOGIC_SIGNED                                  --
+--                                 					--
+--									--
+--      Date:        09/11/91 KN                                        --
+--                   10/08/92 AMT change std_ulogic to signed std_logic --
+--		     10/28/92 AMT added signed functions, -, ABS	--
+--									--
+--	Purpose: 							--
+--	 A set of signed arithemtic, conversion,                        --
+--           and comparision functions for STD_LOGIC_VECTOR.            --
+--									--
+--	Note:	Comparision of same length std_logic_vector is defined  --
+--		in the LRM.  The interpretation is for unsigned vectors --
+--		This package will "overload" that definition.		--
+--									--
+--------------------------------------------------------------------------
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.std_logic_arith.all;
+
+package STD_LOGIC_SIGNED is
+
+    function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "+"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR;
+    function "+"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR;
+    function "+"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR;
+    function "-"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function "+"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "ABS"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+
+    function "*"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function "<"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function "<"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function "<"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function "<="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function "<="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function "<="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function ">"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function ">"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function ">"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function ">="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function ">="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function ">="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function "="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function "="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function "="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function "/="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function "/="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function "/="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function SHL(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; 
+    function SHR(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; 
+
+    function CONV_INTEGER(ARG: STD_LOGIC_VECTOR) return INTEGER;
+
+-- remove this since it is already in std_logic_arith
+--    function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) return STD_LOGIC_VECTOR;
+
+end STD_LOGIC_SIGNED;
+
+
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.std_logic_arith.all;
+
+package body STD_LOGIC_SIGNED is
+
+
+    function maximum(L, R: INTEGER) return INTEGER is
+    begin
+        if L > R then
+            return L;
+        else
+            return R;
+        end if;
+    end;
+
+
+    function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        constant length: INTEGER := maximum(L'length, R'length);
+        variable result  : STD_LOGIC_VECTOR (length-1 downto 0);
+    begin
+        result  := SIGNED(L) + SIGNED(R); -- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := SIGNED(L) + R; -- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        variable result  : STD_LOGIC_VECTOR (R'range);
+    begin
+        result  := L + SIGNED(R); -- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := SIGNED(L) + R; -- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        variable result  : STD_LOGIC_VECTOR (R'range);
+    begin
+        result  := L + SIGNED(R); -- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        constant length: INTEGER := maximum(L'length, R'length);
+        variable result  : STD_LOGIC_VECTOR (length-1 downto 0);
+    begin
+        result  := SIGNED(L) - SIGNED(R); -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := SIGNED(L) - R; -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        variable result  : STD_LOGIC_VECTOR (R'range);
+    begin
+        result  := L - SIGNED(R); -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := SIGNED(L) - R; -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        variable result  : STD_LOGIC_VECTOR (R'range);
+    begin
+        result  := L - SIGNED(R); -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := + SIGNED(L); -- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := - SIGNED(L); -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "ABS"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := ABS( SIGNED(L));
+        return   std_logic_vector(result);
+    end;
+
+    function "*"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to mult
+        constant length: INTEGER := maximum(L'length, R'length);
+        variable result  : STD_LOGIC_VECTOR ((L'length+R'length-1) downto 0);
+    begin
+        result  := SIGNED(L) * SIGNED(R); -- pragma label mult
+        return   std_logic_vector(result);
+    end;
+        
+    function "<"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to lt
+        constant length: INTEGER := maximum(L'length, R'length);
+    begin
+        return   SIGNED(L) < SIGNED(R); -- pragma label lt
+    end;
+
+    function "<"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+            -- pragma label_applies_to lt
+    begin
+        return   SIGNED(L) < R; -- pragma label lt
+    end;
+
+    function "<"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to lt
+    begin
+        return   L < SIGNED(R); -- pragma label lt
+    end;
+
+    function "<="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to leq
+    begin
+        return   SIGNED(L) <= SIGNED(R); -- pragma label leq
+    end;
+
+    function "<="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+        -- pragma label_applies_to leq
+    begin
+        return   SIGNED(L) <= R; -- pragma label leq
+    end;
+
+    function "<="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to leq
+    begin
+        return   L <= SIGNED(R); -- pragma label leq
+    end;
+
+    function ">"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to gt
+    begin
+        return   SIGNED(L) > SIGNED(R); -- pragma label gt
+    end;
+
+    function ">"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+        -- pragma label_applies_to gt
+    begin
+        return   SIGNED(L) > R; -- pragma label gt
+    end;
+
+    function ">"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to gt
+    begin
+        return   L > SIGNED(R); -- pragma label gt
+    end;
+
+    function ">="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to geq
+    begin
+        return   SIGNED(L) >= SIGNED(R); -- pragma label geq
+    end;
+
+    function ">="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+        -- pragma label_applies_to geq
+    begin
+        return   SIGNED(L) >= R; -- pragma label geq
+    end;
+
+    function ">="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to geq
+    begin
+        return   L >= SIGNED(R); -- pragma label geq
+    end;
+
+    function "="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+    begin
+        return   SIGNED(L) = SIGNED(R);
+    end;
+
+    function "="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+    begin
+        return   SIGNED(L) = R;
+    end;
+
+    function "="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+    begin
+        return   L = SIGNED(R);
+    end;
+
+    function "/="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+    begin
+        return   SIGNED(L) /= SIGNED(R);
+    end;
+
+    function "/="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+    begin
+        return   SIGNED(L) /= R;
+    end;
+
+    function "/="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+    begin
+        return   L /= SIGNED(R);
+    end;
+
+    function SHL(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is 
+    begin
+       return STD_LOGIC_VECTOR(SHL(SIGNED(ARG),UNSIGNED(COUNT)));
+    end; 
+
+    function SHR(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+    begin
+       return STD_LOGIC_VECTOR(SHR(SIGNED(ARG),UNSIGNED(COUNT)));
+    end;
+ 
+
+
+--  This function converts std_logic_vector to a signed integer value
+--  using a conversion function in std_logic_arith
+    function CONV_INTEGER(ARG: STD_LOGIC_VECTOR) return INTEGER is
+        variable result    : SIGNED(ARG'range);
+    begin
+        result    := SIGNED(ARG);
+        return   CONV_INTEGER(result);
+    end;
+end STD_LOGIC_SIGNED;
+
+
diff --git a/libraries/synopsys/std_logic_textio.vhdl b/libraries/synopsys/std_logic_textio.vhdl
new file mode 100644
index 000000000..d69a87e37
--- /dev/null
+++ b/libraries/synopsys/std_logic_textio.vhdl
@@ -0,0 +1,634 @@
+----------------------------------------------------------------------------
+--
+-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc.  All rights reserved.
+-- 
+-- This source file may be used and distributed without restriction 
+-- provided that this copyright statement is not removed from the file 
+-- and that any derivative work contains this copyright notice.
+--
+--	Package name: STD_LOGIC_TEXTIO
+--
+--	Purpose: This package overloads the standard TEXTIO procedures
+--		 READ and WRITE.
+--
+--	Author: CRC, TS
+--
+----------------------------------------------------------------------------
+
+use STD.textio.all;
+library IEEE;
+use IEEE.std_logic_1164.all;
+
+package STD_LOGIC_TEXTIO is
+--synopsys synthesis_off
+	-- Read and Write procedures for STD_ULOGIC and STD_ULOGIC_VECTOR
+	procedure READ(L:inout LINE; VALUE:out STD_ULOGIC);
+	procedure READ(L:inout LINE; VALUE:out STD_ULOGIC; GOOD: out BOOLEAN);
+	procedure READ(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR);
+	procedure READ(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR; GOOD: out BOOLEAN);
+	procedure WRITE(L:inout LINE; VALUE:in STD_ULOGIC;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0);
+	procedure WRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0);
+
+	-- Read and Write procedures for STD_LOGIC_VECTOR
+	procedure READ(L:inout LINE; VALUE:out STD_LOGIC_VECTOR);
+	procedure READ(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN);
+	procedure WRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0);
+
+	--
+	-- Read and Write procedures for Hex and Octal values.
+	-- The values appear in the file as a series of characters
+	-- between 0-F (Hex), or 0-7 (Octal) respectively.
+	--
+
+	-- Hex
+	procedure HREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR);
+	procedure HREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR; GOOD: out BOOLEAN);
+	procedure HWRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0);
+	procedure HREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR);
+	procedure HREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN);
+	procedure HWRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0);
+
+	-- Octal
+	procedure OREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR);
+	procedure OREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR; GOOD: out BOOLEAN);
+	procedure OWRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0);
+	procedure OREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR);
+	procedure OREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN);
+	procedure OWRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0);
+
+	
+--synopsys synthesis_on
+end STD_LOGIC_TEXTIO;
+
+package body STD_LOGIC_TEXTIO is
+--synopsys synthesis_off
+
+	-- Type and constant definitions used to map STD_ULOGIC values 
+	-- into/from character values.
+
+	type MVL9plus is ('U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-', ERROR);
+	type char_indexed_by_MVL9 is array (STD_ULOGIC) of character;
+	type MVL9_indexed_by_char is array (character) of STD_ULOGIC;
+	type MVL9plus_indexed_by_char is array (character) of MVL9plus;
+
+	constant MVL9_to_char: char_indexed_by_MVL9 := "UX01ZWLH-";
+	constant char_to_MVL9: MVL9_indexed_by_char := 
+		('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z',
+		 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => 'U');
+	constant char_to_MVL9plus: MVL9plus_indexed_by_char := 
+		('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z',
+		 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => ERROR);
+
+
+	-- Overloaded procedures.
+
+	procedure READ(L:inout LINE; VALUE:out STD_ULOGIC; GOOD:out BOOLEAN) is
+		variable c: character;
+	begin
+		loop					-- skip white space
+			read(l,c);
+			exit when ((c /= ' ') and (c /= CR) and (c /= HT));
+		end loop;
+
+		if (char_to_MVL9plus(c) = ERROR) then
+			value := 'U';
+			good := FALSE;
+		else
+			value := char_to_MVL9(c);
+			good := TRUE;
+		end if;
+	end READ;
+
+	procedure READ(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR; GOOD:out BOOLEAN) is
+		variable m:  STD_ULOGIC;
+		variable c:  character;
+		variable s:  string(1 to value'length-1);
+		variable mv: STD_ULOGIC_VECTOR(0 to value'length-1);
+		constant allU: STD_ULOGIC_VECTOR(0 to value'length-1)
+		 				:= (others => 'U');
+	begin
+		loop					-- skip white space
+			read(l,c);
+			exit when ((c /= ' ') and (c /= CR) and (c /= HT));
+		end loop;
+
+		if (char_to_MVL9plus(c) = ERROR) then
+			value := allU;
+			good := FALSE;
+			return;
+		end if;
+
+		read(l, s);
+	    	for i in integer range 1 to value'length-1 loop
+			if (char_to_MVL9plus(s(i)) = ERROR) then
+				value := allU;
+				good := FALSE;
+			    	return;
+			end if;
+		end loop;
+
+		mv(0) := char_to_MVL9(c);
+	    	for i in integer range 1 to value'length-1 loop
+			mv(i) := char_to_MVL9(s(i));
+	    	end loop;
+		value := mv;
+		good := TRUE;
+	end READ;
+	
+	procedure READ(L:inout LINE; VALUE:out STD_ULOGIC) is
+		variable c: character;
+	begin
+		loop					-- skip white space
+			read(l,c);
+			exit when ((c /= ' ') and (c /= CR) and (c /= HT));
+		end loop;
+
+		if (char_to_MVL9plus(c) = ERROR) then
+			value := 'U';
+			assert FALSE report "READ(STD_ULOGIC) Error: Character '" &
+					c & "' read, expected STD_ULOGIC literal.";
+		else
+			value := char_to_MVL9(c);
+		end if;
+	end READ;
+
+	procedure READ(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR) is
+		variable m: STD_ULOGIC;
+		variable c: character;
+		variable s: string(1 to value'length-1);
+		variable mv: STD_ULOGIC_VECTOR(0 to value'length-1);
+		constant allU: STD_ULOGIC_VECTOR(0 to value'length-1)
+				 := (others => 'U');
+	begin
+		loop					 -- skip white space
+			read(l,c);
+			exit when ((c /= ' ') and (c /= CR) and (c /= HT));
+		end loop;
+
+		if (char_to_MVL9plus(c) = ERROR) then
+			value := allU;
+			assert FALSE report
+				"READ(STD_ULOGIC_VECTOR) Error: Character '" & 
+					c & "' read, expected STD_ULOGIC literal.";
+			return;
+		end if;
+
+		read(l, s);
+	    	for i in integer range 1 to value'length-1 loop
+			if (char_to_MVL9plus(s(i)) = ERROR) then
+			    value := allU;
+			    assert FALSE report 
+				"READ(STD_ULOGIC_VECTOR) Error: Character '" &
+					s(i) & "' read, expected STD_ULOGIC literal.";
+			    return;
+			end if;
+		end loop;
+
+		mv(0) := char_to_MVL9(c);
+	    	for i in integer range 1 to value'length-1 loop
+			mv(i) := char_to_MVL9(s(i));
+	    	end loop;
+		value := mv;
+	end READ;
+
+	procedure WRITE(L:inout LINE; VALUE:in STD_ULOGIC;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+	begin
+		write(l, MVL9_to_char(value), justified, field);
+	end WRITE;
+	
+
+	procedure WRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+		variable s: string(1 to value'length);
+		variable m: STD_ULOGIC_VECTOR(1 to value'length) := value;
+	begin
+	    	for i in 1 to value'length loop
+			s(i) := MVL9_to_char(m(i));
+		end loop;
+		write(l, s, justified, field);
+	end WRITE;
+
+	-- Read and Write procedures for STD_LOGIC_VECTOR
+	procedure READ(L:inout LINE; VALUE:out STD_LOGIC_VECTOR) is
+		variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0);
+	begin
+		READ(L, tmp);
+		VALUE := STD_LOGIC_VECTOR(tmp);
+	end READ;
+
+	procedure READ(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN) is
+		variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0);
+	begin
+		READ(L, tmp, GOOD);
+		VALUE := STD_LOGIC_VECTOR(tmp);
+	end READ;
+
+	procedure WRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+	begin
+		WRITE(L, STD_ULOGIC_VECTOR(VALUE), JUSTIFIED, FIELD);
+	end WRITE;
+
+
+	--
+	-- Hex Read and Write procedures.
+	--
+
+	--
+	-- Hex, and Octal Read and Write procedures for BIT_VECTOR
+	--  (these procedures are not exported, they are only used
+	--   by the STD_ULOGIC hex/octal reads and writes below.
+	--
+	--
+
+	procedure Char2QuadBits(C: Character; 
+				RESULT: out Bit_Vector(3 downto 0);
+				GOOD: out Boolean;
+				ISSUE_ERROR: in Boolean) is
+	begin
+		case c is
+			when '0' => result :=  x"0"; good := TRUE;
+			when '1' => result :=  x"1"; good := TRUE;
+			when '2' => result :=  x"2"; good := TRUE;
+			when '3' => result :=  x"3"; good := TRUE;
+			when '4' => result :=  x"4"; good := TRUE;
+			when '5' => result :=  x"5"; good := TRUE;
+			when '6' => result :=  x"6"; good := TRUE;
+			when '7' => result :=  x"7"; good := TRUE;
+			when '8' => result :=  x"8"; good := TRUE;
+			when '9' => result :=  x"9"; good := TRUE;
+			when 'A' => result :=  x"A"; good := TRUE;
+			when 'B' => result :=  x"B"; good := TRUE;
+			when 'C' => result :=  x"C"; good := TRUE;
+			when 'D' => result :=  x"D"; good := TRUE;
+			when 'E' => result :=  x"E"; good := TRUE;
+			when 'F' => result :=  x"F"; good := TRUE;
+ 
+			when 'a' => result :=  x"A"; good := TRUE;
+			when 'b' => result :=  x"B"; good := TRUE;
+			when 'c' => result :=  x"C"; good := TRUE;
+			when 'd' => result :=  x"D"; good := TRUE;
+			when 'e' => result :=  x"E"; good := TRUE;
+			when 'f' => result :=  x"F"; good := TRUE;
+			when others =>
+			   if ISSUE_ERROR then 
+				   assert FALSE report
+					"HREAD Error: Read a '" & c &
+					   "', expected a Hex character (0-F).";
+			   end if;
+			   good := FALSE;
+		end case;
+	end;
+
+	procedure HREAD(L:inout LINE; VALUE:out BIT_VECTOR)  is
+		variable ok: boolean;
+		variable c:  character;
+		constant ne: integer := value'length/4;
+		variable bv: bit_vector(0 to value'length-1);
+		variable s:  string(1 to ne-1);
+	begin
+		if value'length mod 4 /= 0 then
+			assert FALSE report 
+				"HREAD Error: Trying to read vector " &
+				   "with an odd (non multiple of 4) length";
+			return;
+		end if;
+
+		loop					-- skip white space
+			read(l,c);
+			exit when ((c /= ' ') and (c /= CR) and (c /= HT));
+		end loop;
+
+		Char2QuadBits(c, bv(0 to 3), ok, TRUE);
+		if not ok then 
+			return;
+		end if;
+
+		read(L, s, ok);
+		if not ok then
+			assert FALSE 
+				report "HREAD Error: Failed to read the STRING";
+			return;
+		end if;
+
+		for i in 1 to ne-1 loop
+			Char2QuadBits(s(i), bv(4*i to 4*i+3), ok, TRUE);
+			if not ok then
+				return;
+			end if;
+		end loop;
+		value := bv;
+	end HREAD; 
+
+	procedure HREAD(L:inout LINE; VALUE:out BIT_VECTOR;GOOD: out BOOLEAN) is
+		variable ok: boolean;
+		variable c:  character;
+		constant ne: integer := value'length/4;
+		variable bv: bit_vector(0 to value'length-1);
+		variable s:  string(1 to ne-1);
+	begin
+		if value'length mod 4 /= 0 then
+			good := FALSE;
+			return;
+		end if;
+
+		loop					-- skip white space
+			read(l,c);
+			exit when ((c /= ' ') and (c /= CR) and (c /= HT));
+		end loop;
+
+		Char2QuadBits(c, bv(0 to 3), ok, FALSE);
+		if not ok then 
+			good := FALSE;
+			return;
+		end if;
+
+		read(L, s, ok);
+		if not ok then
+			good := FALSE;
+			return;
+		end if;
+
+		for i in 1 to ne-1 loop
+			Char2QuadBits(s(i), bv(4*i to 4*i+3), ok, FALSE);
+			if not ok then
+				good := FALSE;
+				return;
+			end if;
+		end loop;
+		good := TRUE;
+		value := bv;
+	end HREAD; 
+
+
+	procedure HWRITE(L:inout LINE; VALUE:in BIT_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+		variable quad: bit_vector(0 to 3);
+		constant ne:   integer := value'length/4;
+		variable bv:   bit_vector(0 to value'length-1) := value;
+		variable s:    string(1 to ne);
+	begin
+		if value'length mod 4 /= 0 then
+			assert FALSE report 
+				"HWRITE Error: Trying to read vector " &
+				   "with an odd (non multiple of 4) length";
+			return;
+		end if;
+
+		for i in 0 to ne-1 loop
+			quad := bv(4*i to 4*i+3);
+			case quad is
+				when x"0" => s(i+1) := '0';
+				when x"1" => s(i+1) := '1';
+				when x"2" => s(i+1) := '2';
+				when x"3" => s(i+1) := '3';
+				when x"4" => s(i+1) := '4';
+				when x"5" => s(i+1) := '5';
+				when x"6" => s(i+1) := '6';
+				when x"7" => s(i+1) := '7';
+				when x"8" => s(i+1) := '8';
+				when x"9" => s(i+1) := '9';
+				when x"A" => s(i+1) := 'A';
+				when x"B" => s(i+1) := 'B';
+				when x"C" => s(i+1) := 'C';
+				when x"D" => s(i+1) := 'D';
+				when x"E" => s(i+1) := 'E';
+				when x"F" => s(i+1) := 'F';
+			end case;
+		end loop;
+		write(L, s, JUSTIFIED, FIELD);
+	end HWRITE; 
+
+	procedure Char2TriBits(C: Character; 
+				RESULT: out bit_vector(2 downto 0);
+				GOOD: out Boolean;
+				ISSUE_ERROR: in Boolean) is
+	begin
+		case c is
+			when '0' => result :=  o"0"; good := TRUE;
+			when '1' => result :=  o"1"; good := TRUE;
+			when '2' => result :=  o"2"; good := TRUE;
+			when '3' => result :=  o"3"; good := TRUE;
+			when '4' => result :=  o"4"; good := TRUE;
+			when '5' => result :=  o"5"; good := TRUE;
+			when '6' => result :=  o"6"; good := TRUE;
+			when '7' => result :=  o"7"; good := TRUE;
+			when others =>
+			   if ISSUE_ERROR then 
+				   assert FALSE report
+					"OREAD Error: Read a '" & c &
+					"', expected an Octal character (0-7).";
+			   end if;
+			   good := FALSE;
+		end case;
+	end;
+
+	procedure OREAD(L:inout LINE; VALUE:out BIT_VECTOR)  is
+		variable c: character;
+		variable ok: boolean;
+		constant ne: integer := value'length/3;
+		variable bv: bit_vector(0 to value'length-1);
+		variable s: string(1 to ne-1);
+	begin
+		if value'length mod 3 /= 0 then
+			assert FALSE report 
+				"OREAD Error: Trying to read vector " &
+				   "with an odd (non multiple of 3) length";
+			return;
+		end if;
+
+		loop					-- skip white space
+			read(l,c);
+			exit when ((c /= ' ') and (c /= CR) and (c /= HT));
+		end loop;
+
+		Char2TriBits(c, bv(0 to 2), ok, TRUE);
+		if not ok then 
+			return;
+		end if;
+
+		read(L, s, ok);
+		if not ok then
+			assert FALSE 
+				report "OREAD Error: Failed to read the STRING";
+			return;
+		end if;
+
+		for i in 1 to ne-1 loop
+			Char2TriBits(s(i), bv(3*i to 3*i+2), ok, TRUE);
+			if not ok then
+				return;
+			end if;
+		end loop;
+		value := bv;
+	end OREAD; 
+
+	procedure OREAD(L:inout LINE; VALUE:out BIT_VECTOR;GOOD: out BOOLEAN) is
+		variable ok: boolean;
+		variable c:  character;
+		constant ne: integer := value'length/3;
+		variable bv: bit_vector(0 to value'length-1);
+		variable s:  string(1 to ne-1);
+	begin
+		if value'length mod 3 /= 0 then
+			good := FALSE;
+			return;
+		end if;
+
+		loop					-- skip white space
+			read(l,c);
+			exit when ((c /= ' ') and (c /= CR) and (c /= HT));
+		end loop;
+
+		Char2TriBits(c, bv(0 to 2), ok, FALSE);
+		if not ok then 
+			good := FALSE;
+			return;
+		end if;
+
+		read(L, s, ok);
+		if not ok then
+			good := FALSE;
+			return;
+		end if;
+
+		for i in 1 to ne-1 loop
+			Char2TriBits(s(i), bv(3*i to 3*i+2), ok, FALSE);
+			if not ok then
+				good := FALSE;
+				return;
+			end if;
+		end loop;
+		good := TRUE;
+		value := bv;
+	end OREAD; 
+
+
+	procedure OWRITE(L:inout LINE; VALUE:in BIT_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+		variable tri: bit_vector(0 to 2);
+		constant ne:  integer := value'length/3;
+		variable bv:  bit_vector(0 to value'length-1) := value;
+		variable s:   string(1 to ne);
+	begin
+		if value'length mod 3 /= 0 then
+			assert FALSE report 
+				"OWRITE Error: Trying to read vector " &
+				   "with an odd (non multiple of 3) length";
+			return;
+		end if;
+
+		for i in 0 to ne-1 loop
+			tri := bv(3*i to 3*i+2);
+			case tri is
+				when o"0" => s(i+1) := '0';
+				when o"1" => s(i+1) := '1';
+				when o"2" => s(i+1) := '2';
+				when o"3" => s(i+1) := '3';
+				when o"4" => s(i+1) := '4';
+				when o"5" => s(i+1) := '5';
+				when o"6" => s(i+1) := '6';
+				when o"7" => s(i+1) := '7';
+			end case;
+		end loop;
+		write(L, s, JUSTIFIED, FIELD);
+	end OWRITE; 
+
+	-- Hex Read and Write procedures for STD_LOGIC_VECTOR
+	procedure HREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR;GOOD:out BOOLEAN) is
+		variable tmp: bit_vector(VALUE'length-1 downto 0);
+	begin
+		HREAD(L, tmp, GOOD);
+		VALUE := To_X01(tmp);
+	end HREAD;
+	
+	procedure HREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR) is
+		variable tmp: bit_vector(VALUE'length-1 downto 0);
+	begin
+		HREAD(L, tmp);
+		VALUE := To_X01(tmp);
+	end HREAD;
+
+	procedure HWRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+	begin
+		HWRITE(L, To_bitvector(VALUE),JUSTIFIED, FIELD);
+	end HWRITE;
+
+	-- Hex Read and Write procedures for STD_LOGIC_VECTOR
+
+	procedure HREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR) is
+		variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0);
+	begin
+		HREAD(L, tmp);
+		VALUE := STD_LOGIC_VECTOR(tmp);
+	end HREAD;
+
+	procedure HREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN) is
+		variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0);
+	begin
+		HREAD(L, tmp, GOOD);
+		VALUE := STD_LOGIC_VECTOR(tmp);
+	end HREAD;
+
+	procedure HWRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+	begin
+		HWRITE(L, To_bitvector(VALUE), JUSTIFIED, FIELD);
+	end HWRITE;
+
+
+	-- Octal Read and Write procedures for STD_ULOGIC_VECTOR
+	procedure OREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR;GOOD:out BOOLEAN) is
+		variable tmp: bit_vector(VALUE'length-1 downto 0);
+	begin
+		OREAD(L, tmp, GOOD);
+		VALUE := To_X01(tmp);
+	end OREAD;
+	
+	procedure OREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR) is
+		variable tmp: bit_vector(VALUE'length-1 downto 0);
+	begin
+		OREAD(L, tmp);
+		VALUE := To_X01(tmp);
+	end OREAD;
+
+	procedure OWRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+	begin
+		OWRITE(L, To_bitvector(VALUE),JUSTIFIED, FIELD);
+	end OWRITE;
+
+	-- Octal Read and Write procedures for STD_LOGIC_VECTOR
+
+	procedure OREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR) is
+		variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0);
+	begin
+		OREAD(L, tmp);
+		VALUE := STD_LOGIC_VECTOR(tmp);
+	end OREAD;
+
+	procedure OREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN) is
+		variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0);
+	begin
+		OREAD(L, tmp, GOOD);
+		VALUE := STD_LOGIC_VECTOR(tmp);
+	end OREAD;
+
+	procedure OWRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR;
+			JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is
+	begin
+		OWRITE(L, STD_ULOGIC_VECTOR(VALUE), JUSTIFIED, FIELD);
+	end OWRITE;
+
+
+--synopsys synthesis_on
+end STD_LOGIC_TEXTIO;
diff --git a/libraries/synopsys/std_logic_unsigned.vhdl b/libraries/synopsys/std_logic_unsigned.vhdl
new file mode 100644
index 000000000..3e29847a8
--- /dev/null
+++ b/libraries/synopsys/std_logic_unsigned.vhdl
@@ -0,0 +1,329 @@
+--------------------------------------------------------------------------
+--                                                                      --
+-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc.                     --
+--                                             All rights reserved.     --
+--                                                                      --
+-- This source file may be used and distributed without restriction     --
+-- provided that this copyright statement is not removed from the file  --
+-- and that any derivative work contains this copyright notice.         --
+--                                                                      --
+--	Package name: STD_LOGIC_UNSIGNED                                --
+--                                 					--
+--									--
+--      Date:        	09/11/92	KN				--
+--			10/08/92 	AMT				--
+--									--
+--	Purpose: 							--
+--	 A set of unsigned arithemtic, conversion,                      --
+--           and comparision functions for STD_LOGIC_VECTOR.            --
+--									--
+--	Note:  comparision of same length discrete arrays is defined	--
+--		by the LRM.  This package will "overload" those 	--
+--		definitions						--
+--									--
+--------------------------------------------------------------------------
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.std_logic_arith.all;
+
+package STD_LOGIC_UNSIGNED is
+
+    function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "+"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR;
+    function "+"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR;
+    function "+"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR;
+    function "-"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR;
+    function "-"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function "+"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function "*"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function "<"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function "<"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function "<"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function "<="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function "<="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function "<="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function ">"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function ">"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function ">"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function ">="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function ">="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function ">="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function "="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function "="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function "="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+
+    function "/="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function "/="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN;
+    function "/="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN;
+    function SHL(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+    function SHR(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+
+    function CONV_INTEGER(ARG: STD_LOGIC_VECTOR) return INTEGER;
+
+-- remove this since it is already in std_logic_arith
+--    function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) return STD_LOGIC_VECTOR;
+
+end STD_LOGIC_UNSIGNED;
+
+
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.std_logic_arith.all;
+
+package body STD_LOGIC_UNSIGNED is
+
+
+    function maximum(L, R: INTEGER) return INTEGER is
+    begin
+        if L > R then
+            return L;
+        else
+            return R;
+        end if;
+    end;
+
+
+    function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        constant length: INTEGER := maximum(L'length, R'length);
+        variable result  : STD_LOGIC_VECTOR (length-1 downto 0);
+    begin
+        result  := UNSIGNED(L) + UNSIGNED(R);-- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := UNSIGNED(L) + R;-- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        variable result  : STD_LOGIC_VECTOR (R'range);
+    begin
+        result  := L + UNSIGNED(R);-- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to plus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := UNSIGNED(L) + R;-- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+            -- pragma label_applies_to plus
+    variable result  : STD_LOGIC_VECTOR (R'range);
+    begin
+        result  := L + UNSIGNED(R);-- pragma label plus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        constant length: INTEGER := maximum(L'length, R'length);
+        variable result  : STD_LOGIC_VECTOR (length-1 downto 0);
+    begin
+        result  := UNSIGNED(L) - UNSIGNED(R); -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := UNSIGNED(L) - R; -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        variable result  : STD_LOGIC_VECTOR (R'range);
+    begin
+        result  := L - UNSIGNED(R);  -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR is
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := UNSIGNED(L) - R;
+        return   std_logic_vector(result);
+    end;
+
+    function "-"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to minus
+        variable result  : STD_LOGIC_VECTOR (R'range);
+    begin
+        result  := L - UNSIGNED(R);  -- pragma label minus
+        return   std_logic_vector(result);
+    end;
+
+    function "+"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        variable result  : STD_LOGIC_VECTOR (L'range);
+    begin
+        result  := + UNSIGNED(L);
+        return   std_logic_vector(result);
+    end;
+
+    function "*"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+        -- pragma label_applies_to mult
+        constant length: INTEGER := maximum(L'length, R'length);
+        variable result  : STD_LOGIC_VECTOR ((L'length+R'length-1) downto 0);
+    begin
+        result  := UNSIGNED(L) * UNSIGNED(R); -- pragma label mult
+        return   std_logic_vector(result);
+    end;
+        
+    function "<"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to lt
+        constant length: INTEGER := maximum(L'length, R'length);
+    begin
+        return   UNSIGNED(L) < UNSIGNED(R); -- pragma label lt
+    end;
+
+    function "<"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+        -- pragma label_applies_to lt
+    begin
+        return   UNSIGNED(L) < R; -- pragma label lt
+    end;
+
+    function "<"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to lt
+    begin
+        return   L < UNSIGNED(R); -- pragma label lt
+    end;
+
+    function "<="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+       -- pragma label_applies_to leq
+    begin
+        return   UNSIGNED(L) <= UNSIGNED(R); -- pragma label leq
+    end;
+
+    function "<="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+       -- pragma label_applies_to leq
+    begin
+        return   UNSIGNED(L) <= R; -- pragma label leq
+    end;
+
+    function "<="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+       -- pragma label_applies_to leq
+    begin
+        return   L <= UNSIGNED(R); -- pragma label leq
+    end;
+
+    function ">"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to gt
+    begin
+        return   UNSIGNED(L) > UNSIGNED(R); -- pragma label gt
+    end;
+
+    function ">"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+        -- pragma label_applies_to gt
+    begin
+        return   UNSIGNED(L) > R; -- pragma label gt
+    end;
+
+    function ">"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to gt
+    begin
+        return   L > UNSIGNED(R); -- pragma label gt
+    end;
+
+    function ">="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to geq
+    begin
+        return   UNSIGNED(L) >= UNSIGNED(R);  -- pragma label geq
+    end;
+
+    function ">="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+        -- pragma label_applies_to geq
+    begin
+        return   UNSIGNED(L) >= R;  -- pragma label geq
+    end;
+
+    function ">="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+        -- pragma label_applies_to geq
+    begin
+        return   L >= UNSIGNED(R);  -- pragma label geq
+    end;
+
+    function "="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+    begin
+        return   UNSIGNED(L) = UNSIGNED(R);
+    end;
+
+    function "="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+    begin
+        return   UNSIGNED(L) = R;
+    end;
+
+    function "="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+    begin
+        return   L = UNSIGNED(R);
+    end;
+
+    function "/="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is
+    begin
+        return   UNSIGNED(L) /= UNSIGNED(R);
+    end;
+
+    function "/="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is
+    begin
+        return   UNSIGNED(L) /= R;
+    end;
+
+    function "/="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is
+    begin
+        return   L /= UNSIGNED(R);
+    end;
+
+    function CONV_INTEGER(ARG: STD_LOGIC_VECTOR) return INTEGER is
+        variable result    : UNSIGNED(ARG'range);
+    begin
+        result    := UNSIGNED(ARG);
+        return   CONV_INTEGER(result);
+    end;
+    function SHL(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+    begin
+       return STD_LOGIC_VECTOR(SHL(UNSIGNED(ARG),UNSIGNED(COUNT)));
+    end;
+ 
+    function SHR(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+    begin
+       return STD_LOGIC_VECTOR(SHR(UNSIGNED(ARG),UNSIGNED(COUNT)));
+    end;
+
+
+-- remove this since it is already in std_logic_arith
+    --function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) return STD_LOGIC_VECTOR is
+        --variable result1 : UNSIGNED (SIZE-1 downto 0);
+        --variable result2 : STD_LOGIC_VECTOR (SIZE-1 downto 0);
+    --begin
+        --result1 := CONV_UNSIGNED(ARG,SIZE);
+        --return   std_logic_vector(result1);
+    --end;
+
+
+end STD_LOGIC_UNSIGNED;
+
+
diff --git a/libraries/vital2000/memory_b.vhdl b/libraries/vital2000/memory_b.vhdl
new file mode 100644
index 000000000..0376ee4d3
--- /dev/null
+++ b/libraries/vital2000/memory_b.vhdl
@@ -0,0 +1,7151 @@
+-- ----------------------------------------------------------------------------
+-- Title        : Standard VITAL Memory Package
+--              :
+-- Library      : Vital_Memory
+--              :
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              : Ekambaram Balaji, LSI Logic Corporation
+--              : Jose De Castro, Consultant
+--              : Prakash Bare, GDA Technologies
+--              : William Yam, LSI Logic Corporation
+--              : Dennis Brophy, Model Technology
+--              :
+-- Purpose      : This packages defines standard types, constants, functions
+--              : and procedures for use in developing ASIC memory models.
+--              :  
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History : 
+-- ----------------------------------------------------------------------------
+-- Ver:|Auth:| Date:| Changes Made:
+-- 0.1 | eb  |071796| First prototye as part of VITAL memory proposal
+-- 0.2 | jdc |012897| Initial prototyping with proposed MTM scheme 
+-- 0.3 | jdc |090297| Extensive updates for TAG review (functional)
+-- 0.4 | eb  |091597| Changed naming conventions for VitalMemoryTable 
+--     |     |      | Added interface of VitalMemoryCrossPorts() & 
+--     |     |      | VitalMemoryViolation().
+-- 0.5 | jdc |092997| Completed naming changes thoughout package body.
+--     |     |      | Testing with simgle port test model looks ok.
+-- 0.6 | jdc |121797| Major updates to the packages:
+--     |     |      | - Implement VitalMemoryCrossPorts()
+--     |     |      |   - Use new VitalAddressValueType
+--     |     |      |   - Use new VitalCrossPortModeType enum
+--     |     |      |   - Overloading without SamePort args
+--     |     |      |   - Honor erroneous address values
+--     |     |      |   - Honor ports disabled with 'Z'
+--     |     |      | - Implement implicit read 'M' table symbol
+--     |     |      | - Cleanup buses to use (H DOWNTO L)
+--     |     |      | - Message control via MsgOn,HeaderMsg,PortName
+--     |     |      | - Tested with 1P1RW,2P2RW,4P2R2W,4P4RW cases
+-- 0.7 | jdc |052698| Bug fixes to the packages:
+--     |     |      | - Fix failure with negative Address values
+--     |     |      | - Added debug messages for VMT table search
+--     |     |      | - Remove 'S' for action column (only 's')
+--     |     |      | - Remove 's' for response column (only 'S')
+--     |     |      | - Remove 'X' for action and response columns
+-- 0.8 | jdc |061298| Implemented VitalMemoryViolation()
+--     |     |      | - Minimal functionality violation tables
+--     |     |      | - Missing:
+--     |     |      |   - Cannot handle wide violation variables
+--     |     |      |   - Cannot handle sub-word cases
+--     |     |      | Fixed IIC version of MemoryMatch
+--     |     |      | Fixed 'M' vs 'm' switched on debug output
+--     |     |      | TO BE DONE:
+--     |     |      | - Implement 'd' corrupting a single bit
+--     |     |      | - Implement 'D' corrupting a single bit
+-- 0.9 |eb/sc|080498| Added UNDEF value for VitalPortFlagType
+-- 0.10|eb/sc|080798| Added CORRUPT value for VitalPortFlagType
+-- 0.11|eb/sc|081798| Added overloaded function interface for
+--     |     |      |       VitalDeclareMemory
+-- 0.14| jdc |113198| Merging of memory functionality and version
+--     |     |      | 1.4 9/17/98 of timing package from Prakash
+-- 0.15| jdc |120198| Major development of VMV functionality
+-- 0.16| jdc |120298| Complete VMV functionlality for initial testing
+--     |     |      | - New ViolationTableCorruptMask() procedure
+--     |     |      | - New MemoryTableCorruptMask() procedure
+--     |     |      | - HandleMemoryAction():
+--     |     |      |   - Removed DataOutBus bogus output
+--     |     |      |   - Replaced DataOutTmp with DataInTmp
+--     |     |      |   - Added CorruptMask input handling
+--     |     |      |   - Implemented 'd','D' using CorruptMask
+--     |     |      |   - CorruptMask on 'd','C','L','D','E'
+--     |     |      |   - CorruptMask ignored on 'c','l','e'
+--     |     |      |   - Changed 'l','d','e' to set PortFlag to CORRUPT
+--     |     |      |   - Changed 'L','D','E' to set PortFlag to CORRUPT
+--     |     |      |   - Changed 'c','l','d','e' to ignore HighBit, LowBit
+--     |     |      |   - Changed 'C','L','D','E' to use HighBit, LowBit
+--     |     |      | - HandleDataAction():
+--     |     |      |   - Added CorruptMask input handling
+--     |     |      |   - Implemented 'd','D' using CorruptMask
+--     |     |      |   - CorruptMask on 'd','C','L','D','E'
+--     |     |      |   - CorruptMask ignored on 'l','e'
+--     |     |      |   - Changed 'l','d','e' to set PortFlag to CORRUPT
+--     |     |      |   - Changed 'L','D','E' to set PortFlag to CORRUPT
+--     |     |      |   - Changed 'l','d','e' to ignore HighBit, LowBit
+--     |     |      |   - Changed 'L','D','E' to use HighBit, LowBit
+--     |     |      | - MemoryTableLookUp():
+--     |     |      |   - Added MsgOn table debug output
+--     |     |      |   - Uses new MemoryTableCorruptMask()
+--     |     |      | - ViolationTableLookUp():
+--     |     |      |   - Uses new ViolationTableCorruptMask()
+-- 0.17| jdc |120898| - Added VitalMemoryViolationSymbolType,
+--     |     |      |   VitalMemoryViolationTableType data 
+--     |     |      |   types but not used yet (need to discuss)
+--     |     |      | - Added overload for VitalMemoryViolation()
+--     |     |      |   which does not have array flags
+--     |     |      | - Bug fixes for VMV functionality:
+--     |     |      |   - ViolationTableLookUp() not handling '-' in
+--     |     |      |     scalar violation matching
+--     |     |      |   - VitalMemoryViolation() now normalizes
+--     |     |      |     VFlagArrayTmp'LEFT as LSB before calling
+--     |     |      |     ViolationTableLookUp() for proper scanning
+--     |     |      |   - ViolationTableCorruptMask() had to remove 
+--     |     |      |     normalization of CorruptMaskTmp and
+--     |     |      |     ViolMaskTmp for proper MSB:LSB corruption
+--     |     |      |   - HandleMemoryAction(), HandleDataAction() 
+--     |     |      |     - Removed 'D','E' since not being used
+--     |     |      |     - Use XOR instead of OR for corrupt masks
+--     |     |      |     - Now 'd' is sensitive to HighBit, LowBit
+--     |     |      |   - Fixed LowBit overflow in bit writeable case
+--     |     |      |     - MemoryTableCorruptMask()
+--     |     |      |     - ViolationTableCorruptMask()
+--     |     |      |     - VitalMemoryTable()
+--     |     |      |     - VitalMemoryCrossPorts()
+--     |     |      |   - Fixed VitalMemoryViolation() failing on
+--     |     |      |     error AddressValue from earlier VMT()
+--     |     |      | - Minor cleanup of code formatting
+-- 0.18| jdc |032599| - In VitalDeclareMemory()
+--     |     |      |   - Added BinaryLoadFile formal arg and 
+--     |     |      |     modified LoadMemory() to handle bin
+--     |     |      | - Added NOCHANGE to VitalPortFlagType
+--     |     |      | - For VitalCrossPortModeType
+--     |     |      |   - Added CpContention enum
+--     |     |      | - In HandleDataAction()
+--     |     |      |   - Set PortFlag := NOCHANGE for 'S' 
+--     |     |      | - In HandleMemoryAction()
+--     |     |      |   - Set PortFlag := NOCHANGE for 's' 
+--     |     |      | - In VitalMemoryTable() and
+--     |     |      |   VitalMemoryViolation()
+--     |     |      |   - Honor PortFlag = NOCHANGE returned 
+--     |     |      |     from HandleMemoryAction()
+--     |     |      | - In VitalMemoryCrossPorts()
+--     |     |      |   - Fixed Address = AddressJ for all
+--     |     |      |     conditions of DoWrCont & DoCpRead 
+--     |     |      |   - Handle CpContention like WrContOnly
+--     |     |      |     under CpReadOnly conditions, with
+--     |     |      |     associated memory message changes
+--     |     |      |   - Handle PortFlag = NOCHANGE like
+--     |     |      |     PortFlag = READ for actions
+--     |     |      | - Modeling change:
+--     |     |      |   - Need to init PortFlag every delta
+--     |     |      |     PortFlag_A := (OTHES => UNDEF);
+--     |     |      | - Updated InternalTimingCheck code
+-- 0.19| jdc |042599| - Fixes for bit-writeable cases
+--     |     |      | - Check PortFlag after HandleDataAction
+--     |     |      |   in VitalMemoryViolation()
+-- 0.20| jdc |042599| - Merge PortFlag changes from Prakash
+--     |     |      |   and Willian:
+--     |     |      |     VitalMemorySchedulePathDelay()
+--     |     |      |     VitalMemoryExpandPortFlag()
+-- 0.21| jdc |072199| - Changed VitalCrossPortModeType enums,
+--     |     |      |   added new CpReadAndReadContention.
+--     |     |      | - Fixed VitalMemoryCrossPorts() parameter
+--     |     |      |   SamePortFlag to INOUT so that it can
+--     |     |      |   set CORRUPT or READ value.
+--     |     |      | - Fixed VitalMemoryTable() where PortFlag
+--     |     |      |   setting by HandleDataAction() is being
+--     |     |      |   ignored when HandleMemoryAction() sets
+--     |     |      |   PortFlagTmp to NOCHANGE.
+--     |     |      | - Fixed VitalMemoryViolation() to set
+--     |     |      |   all bits of PortFlag when violating.
+-- 0.22| jdc |072399| - Added HIGHZ to PortFlagType. HandleData
+--     |     |      |   checks whether the previous state is HIGHZ.
+--     |     |      |   If yes then portFlag should be NOCHANGE
+--     |     |      |   for VMPD to ignore IORetain corruption.
+--     |     |      |   The idea is that the first Z should be
+--     |     |      |   propagated but later ones should be ignored.
+--     |     |      |
+-- 0.23| jdc |100499| - Took code checked in by Dennis 09/28/99
+--     |     |      | - Changed VitalPortFlagType to record of
+--     |     |      |   new VitalPortStateType to hold current,
+--     |     |      |   previous values and separate disable.
+--     |     |      |   Also created VitalDefaultPortFlag const.
+--     |     |      |   Removed usage of PortFlag NOCHANGE
+--     |     |      | - VitalMemoryTable() changes:
+--     |     |      |   Optimized return when all curr = prev
+--     |     |      |   AddressValue is now INOUT to optimize
+--     |     |      |   Transfer PF.MemoryCurrent to MemoryPrevious
+--     |     |      |   Transfer PF.DataCurrent to DataPrevious
+--     |     |      |   Reset PF.OutputDisable to FALSE
+--     |     |      |   Expects PortFlag init in declaration
+--     |     |      |   No need to init PortFlag every delta
+--     |     |      | - VitalMemorySchedulePathDelay() changes:
+--     |     |      |   Initialize with VitalDefaultPortFlag
+--     |     |      |   Check PortFlag.OutputDisable
+--     |     |      | - HandleMemoryAction() changes:
+--     |     |      |   Set value of PortFlag.MemoryCurrent
+--     |     |      |   Never set PortFlag.OutputDisable
+--     |     |      | - HandleDataAction() changes:
+--     |     |      |   Set value of PortFlag.DataCurrent
+--     |     |      |   Set PortFlag.DataCurrent for HIGHZ
+--     |     |      | - VitalMemoryCrossPorts() changes:
+--     |     |      |   Check/set value of PF.MemoryCurrent
+--     |     |      |   Check value of PF.OutputDisable
+--     |     |      | - VitalMemoryViolation() changes:
+--     |     |      |   Fixed bug - not reading inout PF value
+--     |     |      |   Clean up setting of PortFlag
+-- 0.24| jdc |100899| - Modified update of PF.OutputDisable
+--     |     |      |   to correctly accomodate 2P1W1R case:
+--     |     |      |   the read port should not exhibit
+--     |     |      |   IO retain corrupt when reading
+--     |     |      |   addr unrelated to addr being written.
+-- 0.25| jdc |100999| - VitalMemoryViolation() change:
+--     |     |      |   Fixed bug with RDNWR mode incorrectly
+--     |     |      |   updating the PF.OutputDisable
+-- 0.26| jdc |100999| - VitalMemoryCrossPorts() change:
+--     |     |      |   Fixed bugs with update of PF
+-- 0.27| jdc |101499| - VitalMemoryCrossPorts() change:
+--     |     |      |   Added DoRdWrCont message (ErrMcpRdWrCo,
+--     |     |      |   Memory cross port read/write data only
+--     |     |      |   contention)
+--     |     |      | - VitalMemoryTable() change:
+--     |     |      |   Set PF.OutputDisable := TRUE for the
+--     |     |      |   optimized cases.
+-- 0.28| pb  |112399| - Added 8 VMPD procedures for vector 
+--     |     |      |   PathCondition support. Now the total
+--     |     |      |   number of overloadings for VMPD is 24.
+--     |     |      | - Number of overloadings for SetupHold
+--     |     |      |   procedures increased to 5. Scalar violations
+--     |     |      |   are not supported anymore. Vector checkEnabled
+--     |     |      |   support is provided through the new overloading
+-- 0.29| jdc |120999| - HandleMemoryAction() HandleDataAction()
+--     |     |      |   Reinstated 'D' and 'E' actions but
+--     |     |      |   with new PortFlagType
+--     |     |      | - Updated file handling syntax, must compile
+--     |     |      |   with -93 syntax now.
+-- 0.30| jdc |022300| - Formated for 80 column max width
+-- ----------------------------------------------------------------------------
+
+LIBRARY IEEE;
+USE     IEEE.STD_LOGIC_1164.ALL;
+USE     IEEE.Vital_Timing.all;
+USE     IEEE.Vital_Primitives.all;
+
+LIBRARY STD;
+USE     STD.TEXTIO.ALL;
+
+-- ----------------------------------------------------------------------------
+PACKAGE BODY Vital_Memory IS
+
+-- ----------------------------------------------------------------------------
+-- Timing Section
+-- ----------------------------------------------------------------------------
+
+FILE LogFile : TEXT OPEN write_mode IS "delayLog";
+FILE Output  : TEXT OPEN write_mode IS "STD_OUTPUT";
+
+-- Added for turning off the debug msg..
+CONSTANT PrintDebugMsg : STD_ULOGIC := '0';
+                         -- '0' - don't print in STD OUTPUT
+                         -- '1' - print in STD OUTPUT
+
+-- Type and constant definitions for type conversion.
+TYPE MVL9_TO_CHAR_TBL IS ARRAY (STD_ULOGIC) OF character;
+
+--constant MVL9_to_char: MVL9_TO_CHAR_TBL := "UX01ZWLH-";
+CONSTANT MVL9_to_char: MVL9_TO_CHAR_TBL := "XX01ZX010";
+
+-- ----------------------------------------------------------------------------
+-- STD_LOGIC WRITE UTILITIES
+-- ----------------------------------------------------------------------------
+PROCEDURE WRITE(
+  l       : INOUT line;
+  val     : IN std_logic_vector;
+  justify : IN side := right; 
+  field   : IN width := 0
+) IS
+  VARIABLE invect : std_logic_vector(val'LENGTH DOWNTO 1);
+  VARIABLE ins    : STRING(val'LENGTH DOWNTO 1);
+BEGIN
+  invect := val;
+  FOR I IN invect'length DOWNTO 1 LOOP
+     ins(I) := MVL9_to_char(invect(I));
+  END LOOP;
+  WRITE(L, ins, justify, field);
+END;
+
+PROCEDURE WRITE(
+  l       : INOUT line; 
+  val     : IN std_ulogic;
+  justify : IN side := right;
+  field   : in width := 0
+) IS
+  VARIABLE ins : CHARACTER;
+BEGIN
+  ins := MVL9_to_char(val);
+  WRITE(L, ins, justify, field);
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE DelayValue(
+  InputTime : IN TIME ;
+  outline   : INOUT LINE
+) IS
+  CONSTANT header : STRING := "TIME'HIGH";
+BEGIN
+  IF(InputTime = TIME'HIGH) THEN
+    WRITE(outline, header);
+  ELSE
+    WRITE(outline, InputTime);
+  END IF;
+END DelayValue;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintScheduleDataArray (
+  ScheduleDataArray : IN VitalMemoryScheduleDataVectorType
+) IS
+  VARIABLE outline1 : LINE;
+  VARIABLE outline2 : LINE;
+  VARIABLE value    : TIME;
+  CONSTANT empty    : STRING := "      ";
+  CONSTANT header1  : STRING := "i    Age     PropDly  RetainDly"; 
+  CONSTANT header2  : STRING := "i  Sc.Value  Output  Lastvalue  Sc.Time";
+BEGIN
+  WRITE (outline1, empty);
+  WRITE (outline1, NOW);
+  outline2 := outline1; 
+  WRITELINE (LogFile, outline1);
+  IF (PrintDebugMsg = '1') THEN
+    WRITELINE (output, outline2);
+  END IF;
+  WRITE (outline1, header1);
+  outline2 := outline1; 
+  WRITELINE (LogFile, outline1);
+  IF (PrintDebugMsg = '1') THEN
+    WRITELINE (output, outline2);
+  END IF;
+  FOR i IN ScheduleDataArray'RANGE LOOP
+    WRITE (outline1, i );
+    WRITE (outline1, empty);
+    DelayValue(ScheduleDataArray(i).InputAge, outline1);  
+    WRITE (outline1, empty);
+    DelayValue(ScheduleDataArray(i).PropDelay, outline1);  
+    WRITE (outline1, empty);
+    DelayValue(ScheduleDataArray(i).OutputRetainDelay, outline1);  
+    outline2 := outline1; 
+    WRITELINE (LogFile, outline1);
+    IF (PrintDebugMsg = '1') THEN
+      WRITELINE (output, outline2);
+    END IF;
+  END LOOP;
+  WRITE (outline1, header2);
+  outline2 := outline1; 
+  WRITELINE (LogFile, outline1);
+  IF (PrintDebugMsg = '1') THEN
+    WRITELINE (output, outline2);
+  END IF;
+  FOR i IN ScheduleDataArray'RANGE LOOP
+    WRITE (outline1, i ); 
+    WRITE (outline1, empty);
+    WRITE (outline1, ScheduleDataArray(i).ScheduleValue); 
+    WRITE (outline1, empty);
+    WRITE (outline1, ScheduleDataArray(i).OutputData);
+    WRITE (outline1, empty);
+    WRITE (outline1, ScheduleDataArray(i).LastOutputValue );
+    WRITE (outline1, empty);
+    DelayValue(ScheduleDataArray(i).ScheduleTime, outline1);
+    outline2 := outline1; 
+    WRITELINE (LogFile, outline1);
+    IF (PrintDebugMsg = '1') THEN
+      WRITELINE (output, outline2);
+    END IF;
+  END LOOP;
+  WRITE (outline1, empty);
+  WRITE (outline2, empty);
+  WRITELINE (LogFile, outline1);
+  IF (PrintDebugMsg = '1') THEN
+    WRITELINE (Output, outline2);
+  END IF;
+END PrintScheduleDataArray;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintArcType (
+  ArcType : IN VitalMemoryArcType
+) IS
+  VARIABLE outline1, outline2 : LINE;
+  CONSTANT empty : STRING := " ";
+  CONSTANT cross : STRING := "CrossArc";
+  CONSTANT para : STRING := "ParallelArc";
+  CONSTANT sub : STRING := "SubWordArc";
+  CONSTANT Header1 : STRING := "Path considered @ ";
+  CONSTANT Header2 : STRING := " is  ";
+BEGIN
+  WRITELINE (LogFile, outline1);
+  WRITE (outline1, header1);
+  WRITE (outline1, NOW);
+  WRITE (outline1, empty);
+  WRITE (outline1, header2);
+  WRITE (outline1, empty);
+  case ArcType is
+  WHEN CrossArc =>
+    WRITE (outline1, cross);
+  WHEN ParallelArc =>
+    WRITE (outline1, para);
+  WHEN SubwordArc =>
+    WRITE (outline1, sub);
+  END CASE;
+  outline2 := outline1 ;
+  -- Appears on STD OUT
+  IF (PrintDebugMsg = '1') THEN
+    WRITELINE (Output, outline1);
+  END IF;
+  WRITELINE (LogFile, outline2);
+END PrintArcType;
+
+-- ----------------------------------------------------------------------------
+-- This returns the value picked from the delay array
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintDelay (
+  outbitpos         : IN INTEGER;
+  InputArrayLow     : IN INTEGER; 
+  InputArrayHigh    : IN INTEGER;
+  debugprop         : IN VitalTimeArrayT;
+  debugretain       : IN VitalTimeArrayT
+) IS
+  VARIABLE outline1 : LINE;
+  VARIABLE outline2 : LINE;
+  VARIABLE outline3 : LINE;
+  VARIABLE outline4 : LINE;
+  VARIABLE outline5 : LINE;
+  VARIABLE outline6 : LINE;
+  CONSTANT empty    : STRING := "  ";
+  CONSTANT empty5   : STRING := "  ";
+  CONSTANT header1  : STRING := "Prop. delays : ";
+  CONSTANT header2  : STRING := "Retain delays : ";
+  CONSTANT header3  : STRING := "output bit :  ";
+BEGIN
+  WRITE(outline1, header3);
+  WRITE(outline1, outbitpos);
+  outline2 := outline1;
+  WRITELINE(LogFile, outline1);
+  IF (PrintDebugMsg = '1') THEN
+    WRITELINE(output, outline2);
+  END IF;
+  WRITE(outline1, header1);
+  WRITE (outline1, empty5);
+  FOR i IN InputArrayHigh DOWNTO InputArrayLow LOOP
+    DelayValue(debugprop(i), outline1);
+    WRITE(outline1, empty);
+  END LOOP;
+  outline2 := outline1;
+  WRITELINE(LogFile, outline1);
+  IF (PrintDebugMsg = '1') THEN
+    WRITELINE(output, outline2);
+  END IF;
+  WRITE(outline1, header2);
+  WRITE (outline1, empty5);
+  FOR i in InputArrayHigh DOWNTO InputArrayLow LOOP
+    DelayValue(debugretain(i), outline1);
+    WRITE(outline1, empty);
+  END LOOP;
+  outline2 := outline1;
+  WRITELINE(LogFile, outline1);
+  IF (PrintDebugMsg = '1') THEN
+    WRITELINE(output, outline2);
+  END IF;
+END PrintDelay;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE DebugMsg1 IS
+    CONSTANT header1:STRING:= "******************************************";
+    CONSTANT header2 :STRING:="Entering the process because of an i/p change";
+    variable outline1, outline2 : LINE;
+BEGIN
+    WRITE(outline1, header1);
+    outline2 := outline1;
+    WRITELINE (Logfile, outline1); 
+    IF (PrintDebugMsg = '1') THEN
+       WRITELINE (output, outline2); 
+    END IF;
+    WRITE(outline1, header2);
+    outline2 := outline1;
+    WRITELINE (Logfile, outline1); 
+    IF (PrintDebugMsg = '1') THEN 
+       WRITELINE (output, outline2); 
+    END IF;
+    WRITE(outline1, header1);
+    outline2 := outline1;
+    WRITELINE (Logfile, outline1);
+    IF (PrintDebugMsg = '1') THEN 
+       WRITELINE (output, outline2); 
+    END IF;
+END DebugMsg1;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE ScheduleDebugMsg IS
+  CONSTANT header1  : STRING := "******************************************";
+  CONSTANT header2  : STRING := "Finished executing all the procedures";
+  VARIABLE outline1 : LINE;
+  VARIABLE outline2 : LINE;
+BEGIN
+  WRITE(outline1, header1);
+  outline2 := outline1;
+  IF (PrintDebugMsg = '1') THEN 
+    WRITELINE (output, outline2); 
+  END IF;
+  WRITELINE (Logfile, outline1); 
+  WRITE(outline1, header2);
+  outline2 := outline1;
+  IF (PrintDebugMsg = '1') THEN 
+    WRITELINE (output, outline2);
+  END IF; 
+  WRITELINE (Logfile, outline1);    
+  WRITE(outline1, header1);
+  outline2 := outline1;
+  IF (PrintDebugMsg = '1') THEN 
+    WRITELINE (output, outline2); 
+  END IF;
+  WRITELINE (Logfile, outline1);
+END ScheduleDebugMsg;   
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintInputName(
+  InputSignalName : IN STRING
+) IS
+  VARIABLE outline1 : LINE;
+  VARIABLE outline2 : LINE;
+  CONSTANT header1  : STRING := "***Changing input is ";
+  CONSTANT header2  : STRING := "(";
+  CONSTANT header3  : STRING := ")";
+  CONSTANT header4  : STRING :=  "****";
+  CONSTANT header5  : STRING := "******************************************";
+  CONSTANT header6  : STRING:="Entering the process because of an i/p change";
+  CONSTANT empty    : STRING := "  ";
+BEGIN
+  WRITE(outline1, header5);
+  outline2 := outline1;
+  WRITELINE (output, outline1); 
+  WRITELINE (Logfile, outline2); 
+  WRITE(outline1, header6);
+  outline2 := outline1;
+  WRITELINE (output, outline1); 
+  WRITELINE (Logfile, outline2); 
+  WRITE(outline1, header5);
+  outline2 := outline1;
+  WRITELINE (output, outline1); 
+  WRITELINE (Logfile, outline2); 
+  WRITE(outline1, header1);
+  WRITE(outline1, InputSignalName); 
+  WRITE(outline1, empty); 
+  WRITE(outline1, now);
+  WRITE(outline1, empty); 
+  WRITE(outline1, header4);
+  WRITELINE (output, outline1); 
+  WRITELINE (Logfile, outline2);  
+END PrintInputName;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintInputChangeTime(
+  ChangeTimeArray : IN VitalTimeArrayT
+) IS
+  VARIABLE outline1 : LINE;
+  VARIABLE outline2 : LINE;
+  CONSTANT header5  : STRING := "*************************************";
+  CONSTANT header6  : STRING:="ChangeTime Array : ";
+  CONSTANT empty    : STRING := "  ";
+BEGIN
+  WRITE(outline1, header5);
+  outline2 := outline1;
+  IF (PrintDebugMsg = '1') THEN 
+    WRITELINE (output, outline2); 
+  END IF;
+  WRITELINE (Logfile, outline1); 
+  WRITE(outline1, header6);
+  FOR i in ChangeTimeArray'range LOOP
+    WRITE(outline1, ChangeTimeArray(i));
+    WRITE(outline1, empty);
+  END LOOP;
+  outline2 := outline1;
+  IF (PrintDebugMsg = '1') THEN  
+    WRITELINE (output, outline2); 
+  END IF;
+  WRITELINE (Logfile, outline1); 
+  WRITE(outline1, header5);
+  outline2 := outline1;
+  IF (PrintDebugMsg = '1') THEN  
+    WRITELINE (output, outline2); 
+  END IF;
+  WRITELINE (Logfile, outline1);  
+END PrintInputChangeTime;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintInputChangeTime(
+  ChangeTime : IN Time
+) IS
+  VARIABLE ChangeTimeArray : VitalTimeArrayT(0 DOWNTO 0);
+BEGIN
+  ChangeTimeArray(0) := ChangeTime;
+  PrintInputChangeTime(ChangeTimeArray);
+END PrintInputChangeTime;
+
+-- ----------------------------------------------------------------------------
+-- for debug purpose
+CONSTANT MaxNoInputBits : INTEGER := 1000;
+
+TYPE VitalMemoryDelayType IS RECORD
+  PropDelay         : TIME;
+  OutputRetainDelay : TIME;
+END RECORD;
+
+-- ----------------------------------------------------------------------------
+-- PROCEDURE:   IntToStr
+--
+-- PARAMETERS:  InputInt     - Integer to be converted to String.
+--              ResultStr    - String buffer for converted Integer
+--              AppendPos    - Position in buffer to place result
+--
+-- DESCRIPTION: This procedure is used to convert an input integer
+--              into a string representation. The converted string
+--              may be placed at a specific position in the result
+--              buffer.
+--
+-- ----------------------------------------------------------------------------
+
+PROCEDURE IntToStr ( 
+  InputInt    : IN INTEGER ;
+  ResultStr   : INOUT STRING ( 1 TO 256) ;
+  AppendPos   : INOUT NATURAL
+) IS
+  -- Look-up table.  Given an int, we can get the character.
+  TYPE     integer_table_type IS  ARRAY (0 TO 9) OF CHARACTER ;
+  CONSTANT integer_table : integer_table_type :=
+    ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9') ;
+  --  Local variables used in this function.
+  VARIABLE   inpVal      : INTEGER := inputInt ;
+  VARIABLE   divisor     : INTEGER := 10 ;
+  VARIABLE   tmpStrIndex : INTEGER := 1 ;
+  VARIABLE   tmpStr      : STRING ( 1 TO 256 ) ;
+BEGIN
+  IF ( inpVal = 0 ) THEN
+    tmpStr(tmpStrIndex) := integer_table ( 0 ) ;
+    tmpStrIndex := tmpStrIndex + 1 ;
+  ELSE
+    WHILE ( inpVal > 0 )  LOOP
+      tmpStr(tmpStrIndex) := integer_table (inpVal mod divisor);
+      tmpStrIndex := tmpStrIndex + 1 ;
+      inpVal := inpVal / divisor ;
+    END LOOP ;
+  END IF ;
+  IF (appendPos /= 1 ) THEN
+    resultStr(appendPos)  :=  ',' ;
+    appendPos := appendPos + 1 ;
+  END IF ;
+
+  FOR i IN tmpStrIndex-1 DOWNTO 1  LOOP
+    resultStr(appendPos)  :=  tmpStr(i) ;
+    appendPos := appendPos + 1 ;
+  END LOOP ;
+END IntToStr ;
+
+-- ----------------------------------------------------------------------------
+TYPE CheckType IS (
+  SetupCheck,
+  HoldCheck,
+  RecoveryCheck,
+  RemovalCheck,
+  PulseWidCheck,
+  PeriodCheck 
+);
+
+TYPE CheckInfoType IS RECORD
+  Violation : BOOLEAN;
+  CheckKind : CheckType;
+  ObsTime   : TIME;
+  ExpTime   : TIME;
+  DetTime   : TIME;
+  State     : X01;
+END RECORD;
+
+TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; 
+TYPE HiLoStrType IS ARRAY (std_ulogic RANGE 'X' TO '1') OF STRING(1 TO 4); 
+
+CONSTANT LogicCvtTable : LogicCvtTableType 
+               := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); 
+CONSTANT HiLoStr     : HiLoStrType := ("  X ", " Low", "High" ); 
+
+TYPE EdgeSymbolMatchType IS ARRAY (X01,X01,VitalEdgeSymbolType) OF BOOLEAN;
+
+-- last value, present value, edge symbol
+CONSTANT EdgeSymbolMatch : EdgeSymbolMatchType :=  
+  (
+  'X' =>
+    ( 'X'=>(                                 OTHERS => FALSE),
+      '0'=>('N'|'F'|'v'|'E'|'D'|'*' => TRUE, OTHERS => FALSE ),
+      '1'=>('P'|'R'|'^'|'E'|'A'|'*' => TRUE, OTHERS => FALSE ) 
+    ),
+  '0' =>
+    ( 'X'=>(    'r'|'p'|'R'|'A'|'*' => TRUE, OTHERS => FALSE ),
+      '0'=>(                                 OTHERS => FALSE ),
+      '1'=>(    '/'|'P'|'p'|'R'|'*' => TRUE, OTHERS => FALSE ) 
+    ),
+  '1' =>
+    ( 'X'=>(    'f'|'n'|'F'|'D'|'*' => TRUE, OTHERS => FALSE ),
+      '0'=>(    '\'|'N'|'n'|'F'|'*' => TRUE, OTHERS => FALSE ),
+      '1'=>(                                 OTHERS => FALSE ) 
+    ) 
+  );
+
+-- ----------------------------------------------------------------------------
+FUNCTION Minimum (
+  CONSTANT t1, t2 : IN TIME 
+) RETURN TIME IS
+BEGIN
+  IF (t1 < t2) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+END Minimum;
+
+-- ----------------------------------------------------------------------------
+FUNCTION Maximum (
+  CONSTANT t1, t2 : IN TIME
+) RETURN TIME IS
+BEGIN
+  IF (t1 < t2) THEN RETURN (t2); ELSE RETURN (t1); END IF;
+END Maximum;
+
+-- ----------------------------------------------------------------------------
+-- FUNCTION:    VitalMemoryCalcDelay
+-- Description: Select Transition dependent Delay. 
+--              Used internally by VitalMemorySelectDelay.        
+-- ----------------------------------------------------------------------------
+FUNCTION VitalMemoryCalcDelay (
+  CONSTANT NewVal : IN STD_ULOGIC := 'X';
+  CONSTANT OldVal : IN STD_ULOGIC := 'X';
+  CONSTANT Delay  : IN VitalDelayType01ZX
+) RETURN VitalMemoryDelayType IS
+  VARIABLE Result : VitalMemoryDelayType;
+BEGIN
+  CASE Oldval IS
+  WHEN '0' | 'L' =>
+    CASE Newval IS
+      WHEN '0' | 'L' =>
+        Result.PropDelay := Delay(tr10);
+      WHEN '1' | 'H' =>
+        Result.PropDelay := Delay(tr01);
+      WHEN 'Z' =>
+        Result.PropDelay := Delay(tr0Z);
+      WHEN OTHERS =>
+        Result.PropDelay := Minimum(Delay(tr01), Delay(tr0Z));
+    END CASE;
+    Result.OutputRetainDelay := Delay(tr0X);
+  WHEN '1' | 'H' =>
+    CASE Newval IS
+      WHEN '0' | 'L' =>
+        Result.PropDelay := Delay(tr10);
+      WHEN '1' | 'H' =>
+        Result.PropDelay := Delay(tr01);
+      WHEN 'Z' =>
+        Result.PropDelay := Delay(tr1Z);
+      WHEN OTHERS =>
+        Result.PropDelay := Minimum(Delay(tr10), Delay(tr1Z));
+    END CASE;
+    Result.OutputRetainDelay := Delay(tr1X);
+  WHEN 'Z' =>
+    CASE Newval IS
+      WHEN '0' | 'L' =>
+        Result.PropDelay := Delay(trZ0);
+      WHEN '1' | 'H' =>
+        Result.PropDelay := Delay(trZ1);
+      WHEN 'Z' =>
+        Result.PropDelay := Maximum(Delay(tr1Z), Delay(tr0Z));
+      WHEN OTHERS =>
+        Result.PropDelay := Minimum(Delay(trZ1), Delay(trZ0));
+      END CASE;
+      Result.OutputRetainDelay := Delay(trZX);
+  WHEN OTHERS =>
+    CASE Newval IS
+      WHEN '0' | 'L' =>
+        Result.PropDelay := Maximum(Delay(tr10), Delay(trZ0));
+      WHEN '1' | 'H' =>
+        Result.PropDelay := Maximum(Delay(tr01), Delay(trZ1));
+      WHEN 'Z' =>
+        Result.PropDelay := Maximum(Delay(tr1Z), Delay(tr0Z));
+      WHEN OTHERS => 
+        Result.PropDelay := Maximum(Delay(tr10), Delay(tr01));
+    END CASE;
+    Result.OutputRetainDelay := Minimum(Delay(tr1X), Delay(tr0X));
+  END CASE;
+  RETURN Result;
+END VitalMemoryCalcDelay;
+
+-- ----------------------------------------------------------------------------
+FUNCTION VitalMemoryCalcDelay (
+  CONSTANT NewVal : IN STD_ULOGIC   := 'X';
+  CONSTANT OldVal : IN STD_ULOGIC   := 'X';
+  CONSTANT Delay  : IN VitalDelayType01Z
+) RETURN VitalMemoryDelayType IS
+  VARIABLE Result : VitalMemoryDelayType;
+BEGIN
+CASE Oldval IS
+  WHEN '0' | 'L' =>
+    CASE Newval IS
+      WHEN '0' | 'L' => Result.PropDelay := Delay(tr10);
+      WHEN '1' | 'H' => Result.PropDelay := Delay(tr01);
+      WHEN OTHERS =>
+        Result.PropDelay := Minimum(Delay(tr01), Delay(tr10));
+    END CASE;
+    Result.OutputRetainDelay := Delay(tr0Z);
+  WHEN '1' | 'H' =>
+    CASE Newval IS
+      WHEN '0' | 'L' => Result.PropDelay := Delay(tr10);
+      WHEN '1' | 'H' => Result.PropDelay := Delay(tr01);
+      WHEN OTHERS => 
+        Result.PropDelay := Minimum(Delay(tr10), Delay(tr01));
+    END CASE;
+    Result.OutputRetainDelay := Delay(tr1Z);
+  WHEN OTHERS =>
+    Result.PropDelay := Maximum(Delay(tr10),Delay(tr01));
+    Result.OutputRetainDelay := Minimum(Delay(tr1Z),Delay(tr0Z));
+  END CASE;
+  RETURN Result;
+END VitalMemoryCalcDelay;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryUpdateInputChangeTime (
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  VARIABLE NumBitsPerSubword    : INTEGER
+) IS
+  VARIABLE LastInputValue : STD_LOGIC_VECTOR(InputSignal'LENGTH-1 downto 0);
+  VARIABLE InSignalNorm   : STD_LOGIC_VECTOR(InputSignal'LENGTH-1 downto 0);
+  VARIABLE ChangeTimeNorm : VitalTimeArrayT(InputSignal'LENGTH-1 downto 0);
+  VARIABLE BitsPerWord    : INTEGER;
+BEGIN
+  LastInputValue := InputSignal'LAST_VALUE;
+  IF NumBitsPerSubword = DefaultNumBitsPerSubword THEN
+    BitsPerWord := InputSignal'LENGTH;
+  ELSE
+    BitsPerWord := NumBitsPerSubword;
+  END IF;
+
+  FOR i IN InSignalNorm'RANGE LOOP
+    IF (InSignalNorm(i) /= LastInputValue(i)) THEN
+      ChangeTimeNorm(i/BitsPerWord) := NOW - InputSignal'LAST_EVENT;
+    ELSE
+      ChangeTimeNorm(i/BitsPerWord) := InputChangeTimeArray(i);
+    END IF;
+  END LOOP;
+
+  FOR i IN ChangeTimeNorm'RANGE LOOP
+    ChangeTimeNorm(i) := ChangeTimeNorm(i/BitsPerword);
+  END LOOP;
+
+  InputChangeTimeArray := ChangeTimeNorm;
+
+  -- for debug purpose only    
+  PrintInputChangeTime(InputChangeTimeArray);
+END VitalMemoryUpdateInputChangeTime;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryUpdateInputChangeTime
+-- Description: Time since previous event for each bit of the input
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryUpdateInputChangeTime (
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR
+) IS
+  VARIABLE LastInputValue  : STD_LOGIC_VECTOR(InputSignal'RANGE) ;
+BEGIN
+  LastInputValue := InputSignal'LAST_VALUE;        
+  FOR i IN InputSignal'RANGE LOOP
+    IF (InputSignal(i) /= LastInputValue(i)) THEN
+      InputChangeTimeArray(i) := NOW - InputSignal'LAST_EVENT;
+    END IF;
+  END LOOP;
+  -- for debug purpose only    
+  PrintInputChangeTime(InputChangeTimeArray);
+END VitalMemoryUpdateInputChangeTime;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryUpdateInputChangeTime (
+  VARIABLE InputChangeTime      : INOUT TIME;
+  SIGNAL   InputSignal          : IN STD_ULOGIC
+) IS
+BEGIN
+  InputChangeTime := NOW - InputSignal'LAST_EVENT;
+  -- for debug purpose only    
+  PrintInputChangeTime(InputChangeTime);
+END VitalMemoryUpdateInputChangeTime;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryExpandPortFlag (
+  CONSTANT PortFlag             : IN  VitalPortFlagVectorType;
+  CONSTANT NumBitsPerSubword    : IN  INTEGER;
+  VARIABLE ExpandedPortFlag       : OUT VitalPortFlagVectorType
+) IS
+  VARIABLE PortFlagNorm : VitalPortFlagVectorType(
+            PortFlag'LENGTH-1 downto 0) := PortFlag;
+  VARIABLE ExpandedPortFlagNorm : VitalPortFlagVectorType(
+            ExpandedPortFlag'LENGTH-1 downto 0);
+  VARIABLE SubwordIndex : INTEGER;
+BEGIN
+  FOR Index IN INTEGER RANGE 0 to ExpandedPortFlag'LENGTH-1 LOOP
+    IF NumBitsPerSubword = DefaultNumBitsPerSubword THEN
+      SubwordIndex := 0;
+    ELSE
+      SubwordIndex := Index / NumBitsPerSubword;
+    END IF;
+    ExpandedPortFlagNorm(Index) := PortFlagNorm(SubWordIndex);
+  END LOOP;
+  ExpandedPortFlag := ExpandedPortFlagNorm;                               
+END VitalMemoryExpandPortFlag;
+
+-- ----------------------------------------------------------------------------
+-- Procedure: VitalMemorySelectDelay
+-- Description : Select Propagation Delay. Used internally by 
+--               VitalMemoryAddPathDelay.
+-- ----------------------------------------------------------------------------
+
+-- ----------------------------------------------------------------------------
+-- VitalDelayArrayType01ZX
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySelectDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  VARIABLE InputChangeTimeArray : IN VitalTimeArrayT;
+  CONSTANT OutputSignalName     : IN STRING :="";
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType              : IN VitalMemoryArcType;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN
+) IS
+  VARIABLE InputArrayLow      : INTEGER := 0;
+  VARIABLE InputArrayHigh     : INTEGER := 0;
+  VARIABLE DelayArrayIndex    : INTEGER := 0;
+  VARIABLE NumBitsPerSubWord  : INTEGER := DefaultNumBitsPerSubword;
+  VARIABLE NewValue           : STD_ULOGIC;
+  VARIABLE OldValue           : STD_ULOGIC;
+  VARIABLE OutputLength       : INTEGER := 0;
+  VARIABLE OutArrayIndex      : INTEGER;
+  VARIABLE PropDelay          : TIME;
+  VARIABLE RetainDelay        : TIME;
+  VARIABLE CurPropDelay       : TIME;
+  VARIABLE CurRetainDelay     : TIME;
+  VARIABLE InputAge           : TIME;
+  VARIABLE CurInputAge        : TIME;
+  VARIABLE InputChangeTimeNorm  : VitalTimeArrayT(
+     InputChangeTimeArray'LENGTH-1 downto 0):=InputChangeTimeArray;
+  VARIABLE DelayArrayNorm  : VitalDelayArrayType01ZX(
+     PathDelayArray'LENGTH-1 downto 0):= PathDelayArray;
+  VARIABLE ScheduleDataArrayNorm : VitalMemoryScheduleDatavectorType
+     (ScheduleDataArray'LENGTH-1 downto 0):= ScheduleDataArray;
+   
+  -- for debug purpose
+  VARIABLE debugprop : VitalTimeArrayT(MaxNoInputBits-1 downto 0);
+  VARIABLE debugretain : VitalTimeArrayT(MaxNoInputBits-1 downto 0);
+
+BEGIN
+
+  -- for debug purpose
+  PrintArcType(ArcType);
+
+  OutputLength := ScheduleDataArray'LENGTH;        
+  FOR OutBitPos IN 0 to (OutputLength -1) LOOP
+    NEXT WHEN PathConditionArray(OutBitPos) = FALSE;
+
+    NEXT WHEN ((ScheduleDataArrayNorm(OutBitPos).ScheduleValue 
+      = ScheduleDataArrayNorm(OutBitPos).OutputData) AND 
+      (ScheduleDataArrayNorm(OutBitPos).ScheduleTime <= NOW) AND
+       (OutputRetainFlag = FALSE ));
+
+    NewValue := ScheduleDataArrayNorm(OutBitPos).OutputData;
+    OldValue := ScheduleDataArrayNorm(OutBitPos).LastOutputValue;
+    PropDelay :=ScheduleDataArrayNorm(OutBitPos).PropDelay;
+    InputAge := ScheduleDataArrayNorm(OutBitPos).InputAge;
+    RetainDelay:=ScheduleDataArrayNorm(OutBitPos).OutputRetainDelay;
+    NumBitsPerSubWord:=ScheduleDataArrayNorm(OutBitPos).NumBitsPerSubWord;
+
+    CASE ArcType IS
+      WHEN ParallelArc =>
+        InputArrayLow := OutBitPos;
+        InputArrayHigh :=  OutBitPos;
+        DelayArrayIndex :=  OutBitPos;
+      WHEN CrossArc =>
+        InputArrayLow := 0;
+        InputArrayHigh := InputChangeTimeArray'LENGTH - 1 ;              
+        DelayArrayIndex := OutBitPos; 
+      WHEN SubwordArc =>
+        InputArrayLow := OutBitPos / NumBitsPerSubWord;
+        InputArrayHigh := OutBitPos / NumBitsPerSubWord;
+        DelayArrayIndex := OutBitPos + 
+            (OutputLength * (OutBitPos / NumBitsPerSubWord));  
+    END CASE;
+
+    FOR i IN InputArrayLow TO InputArrayHigh LOOP
+      (CurPropDelay,CurRetainDelay) := 
+        VitalMemoryCalcDelay (
+          NewValue, OldValue, DelayArrayNorm(DelayArrayIndex)
+        );
+      IF (OutputRetainFlag = FALSE) THEN
+        CurRetainDelay := TIME'HIGH;
+      END IF;              
+
+      -- for debug purpose
+      debugprop(i) := CurPropDelay;
+      debugretain(i) := CurRetainDelay;
+
+      IF ArcType = CrossArc THEN
+        DelayArrayIndex := DelayArrayIndex + OutputLength;
+      END IF;
+
+      -- If there is one input change at a time, then choose the
+      -- delay from that input. If there is simultaneous input 
+      -- change, then choose the minimum of propagation delays 
+ 
+      IF (InputChangeTimeNorm(i) < 0 ns)THEN
+        CurInputAge := TIME'HIGH;
+      ELSE
+        CurInputAge := NOW - InputChangeTimeNorm(i);
+      END IF;            
+
+      IF (CurInputAge  < InputAge)THEN
+        PropDelay := CurPropDelay;
+        RetainDelay := CurRetainDelay;
+        InputAge := CurInputAge;
+      ELSIF (CurInputAge = InputAge)THEN
+        IF (CurPropDelay < PropDelay) THEN
+          PropDelay := CurPropDelay;
+        END IF;
+        IF (OutputRetainFlag = TRUE) THEN
+          IF (CurRetainDelay < RetainDelay) THEN
+            RetainDelay := CurRetainDelay;
+          END IF;
+        END IF;
+      END IF;
+    END LOOP; 
+
+    -- Store it back to data strucutre
+    ScheduleDataArrayNorm(OutBitPos).PropDelay := PropDelay;
+    ScheduleDataArrayNorm(OutBitPos).OutputRetainDelay:= RetainDelay;
+    ScheduleDataArrayNorm(OutBitPos).InputAge := InputAge;
+
+    -- for debug purpose 
+    PrintDelay(outbitPos,InputArrayLow, InputArrayHigh,
+      debugprop, debugretain);
+  END LOOP;
+
+  ScheduleDataArray := ScheduleDataArrayNorm;
+
+END VitalMemorySelectDelay;
+
+-- ----------------------------------------------------------------------------
+-- VitalDelayArrayType01Z
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySelectDelay (
+  VARIABLE ScheduleDataArray    : INOUT VitalMemoryScheduleDataVectorType;
+  VARIABLE InputChangeTimeArray : IN VitalTimeArrayT;
+  CONSTANT OutputSignalName     : IN STRING :="";
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType              : IN VitalMemoryArcType;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN
+) IS
+  VARIABLE InputArrayLow      : INTEGER := 0;
+  VARIABLE InputArrayHigh     : INTEGER := 0;
+  VARIABLE DelayArrayIndex    : INTEGER := 0;
+  VARIABLE NumBitsPerSubWord  : INTEGER := DefaultNumBitsPerSubword;
+  VARIABLE NewValue           : STD_ULOGIC;
+  VARIABLE OldValue           : STD_ULOGIC;
+  VARIABLE OutputLength       : INTEGER := 0;
+  VARIABLE OutArrayIndex      : INTEGER;
+  VARIABLE PropDelay          : TIME;
+  VARIABLE RetainDelay        : TIME;
+  VARIABLE CurPropDelay       : TIME;
+  VARIABLE CurRetainDelay     : TIME;
+  VARIABLE InputAge           : TIME;
+  VARIABLE CurInputAge        : TIME;
+  VARIABLE InputChangeTimeNorm  : VitalTimeArrayT(
+     InputChangeTimeArray'LENGTH-1 downto 0):=InputChangeTimeArray;
+  VARIABLE DelayArrayNorm  : VitalDelayArrayType01Z(
+     PathDelayArray'LENGTH-1 downto 0):= PathDelayArray;
+  VARIABLE ScheduleDataArrayNorm : VitalMemoryScheduleDatavectorType
+     (ScheduleDataArray'LENGTH-1 downto 0):=ScheduleDataArray;
+   
+  -- for debug purpose
+  VARIABLE debugprop : VitalTimeArrayT(MaxNoInputBits-1 downto 0);
+  VARIABLE debugretain : VitalTimeArrayT(MaxNoInputBits-1 downto 0);
+BEGIN
+
+  -- for debug purpose
+  PrintArcType(ArcType);
+
+  OutputLength := ScheduleDataArray'LENGTH;  
+  FOR OutBitPos IN 0 to (OutputLength -1) LOOP
+    NEXT WHEN PathConditionArray(OutBitPos) = FALSE;
+
+    NEXT WHEN ((ScheduleDataArrayNorm(OutBitPos).ScheduleValue 
+      = ScheduleDataArrayNorm(OutBitPos).OutputData) AND 
+        (ScheduleDataArrayNorm(OutBitPos).ScheduleTime <= NOW) AND
+        (OutputRetainFlag = FALSE));
+
+    NewValue := ScheduleDataArrayNorm(OutBitPos).OutputData;
+    OldValue := ScheduleDataArrayNorm(OutBitPos).LastOutputValue;
+    PropDelay :=ScheduleDataArrayNorm(OutBitPos).PropDelay;
+    InputAge := ScheduleDataArrayNorm(OutBitPos).InputAge;
+    RetainDelay:=ScheduleDataArrayNorm(OutBitPos).OutputRetainDelay;
+    NumBitsPerSubWord:=ScheduleDataArrayNorm(OutBitPos).NumBitsPerSubWord;
+
+    CASE ArcType IS
+      WHEN ParallelArc =>
+        InputArrayLow := OutBitPos;
+        InputArrayHigh :=  OutBitPos;
+        DelayArrayIndex :=  OutBitPos;
+      WHEN CrossArc =>
+        InputArrayLow := 0;
+        InputArrayHigh := InputChangeTimeArray'LENGTH-1;
+        DelayArrayIndex := OutBitPos; 
+      WHEN SubwordArc =>
+        InputArrayLow := OutBitPos / NumBitsPerSubWord;
+        InputArrayHigh := OutBitPos / NumBitsPerSubWord;
+        DelayArrayIndex := OutBitPos + 
+          (OutputLength * (OutBitPos / NumBitsPerSubWord));  
+    END CASE;
+
+    FOR i IN InputArrayLow TO InputArrayHigh LOOP
+      (CurPropDelay, CurRetainDelay) := 
+        VitalMemoryCalcDelay (
+          NewValue, OldValue, DelayArrayNorm(DelayArrayIndex)
+        );
+      IF (OutputRetainFlag = FALSE) THEN
+        CurRetainDelay := TIME'HIGH;
+      END IF;
+        
+      -- for debug purpose
+      debugprop(i) := CurPropDelay;
+      debugretain(i) := CurRetainDelay;
+                       
+      IF (ArcType = CrossArc) THEN
+        DelayArrayIndex := DelayArrayIndex + OutputLength;
+      END IF;
+
+      -- If there is one input change at a time, then choose the
+      -- delay from that input. If there is simultaneous input 
+      -- change, then choose the minimum of propagation delays 
+
+      IF (InputChangeTimeNorm(i) < 0 ns) THEN
+        CurInputAge := TIME'HIGH;
+      ELSE
+        CurInputAge := NOW - InputChangeTimeNorm(i);
+      END IF;            
+
+      IF (CurInputAge  < InputAge) THEN
+        PropDelay := CurPropDelay;
+        RetainDelay := CurRetainDelay;
+        InputAge := CurInputAge;
+      ELSIF (CurInputAge = InputAge) THEN
+        IF (CurPropDelay < PropDelay) THEN
+          PropDelay := CurPropDelay;
+        END IF;
+        IF (OutputRetainFlag = TRUE) THEN
+          IF (CurRetainDelay < RetainDelay) THEN
+            RetainDelay := CurRetainDelay;
+          END IF;
+        END IF;
+      END IF;
+    END LOOP; 
+
+    -- Store it back to data strucutre
+    ScheduleDataArrayNorm(OutBitPos).PropDelay := PropDelay;
+    ScheduleDataArrayNorm(OutBitPos).OutputRetainDelay:= RetainDelay;
+    ScheduleDataArrayNorm(OutBitPos).InputAge := InputAge;
+
+    -- for debug purpose 
+    PrintDelay(outbitPos, InputArrayLow, InputArrayHigh,
+       debugprop, debugretain);
+  END LOOP;
+
+  ScheduleDataArray := ScheduleDataArrayNorm;
+
+END VitalMemorySelectDelay;
+
+-- ----------------------------------------------------------------------------
+-- VitalDelayArrayType01
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySelectDelay (
+  VARIABLE ScheduleDataArray    : INOUT VitalMemoryScheduleDataVectorType;
+  VARIABLE InputChangeTimeArray : IN    VitalTimeArrayT;
+  CONSTANT OutputSignalName     : IN    STRING :="";
+  CONSTANT PathDelayArray       : IN    VitalDelayArrayType01;
+  CONSTANT ArcType              : IN    VitalMemoryArcType;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT
+) IS
+  VARIABLE CurPathDelay       : VitalMemoryDelayType;
+  VARIABLE InputArrayLow      : INTEGER := 0;
+  VARIABLE InputArrayHigh     : INTEGER := 0;
+  VARIABLE DelayArrayIndex    : INTEGER := 0;
+  VARIABLE NumBitsPerSubWord  : INTEGER := DefaultNumBitsPerSubword;
+  VARIABLE NewValue           : STD_ULOGIC;
+  VARIABLE OldValue           : STD_ULOGIC;
+  VARIABLE OutputLength       : INTEGER := 0;
+  VARIABLE OutArrayIndex      : INTEGER;
+  VARIABLE PropDelay          : TIME;
+  VARIABLE CurPropDelay       : TIME;
+  VARIABLE InputAge           : TIME;
+  VARIABLE CurInputAge        : TIME;
+  VARIABLE InputChangeTimeNorm  : VitalTimeArrayT(
+     InputChangeTimeArray'LENGTH-1 downto 0):= InputChangeTimeArray;
+  VARIABLE DelayArrayNorm  : VitalDelayArrayType01(
+     PathDelayArray'LENGTH-1 downto 0):= PathDelayArray;
+  VARIABLE ScheduleDataArrayNorm : VitalMemoryScheduleDatavectorType
+     (ScheduleDataArray'LENGTH-1 downto 0):=ScheduleDataArray;
+   
+  -- for debug purpose
+  VARIABLE debugprop : VitalTimeArrayT(MaxNoInputBits-1 downto 0);
+  VARIABLE debugretain : VitalTimeArrayT(MaxNoInputBits-1 downto 0);
+BEGIN
+
+  -- for debug purpose
+  PrintArcType(ArcType);
+
+  OutputLength := ScheduleDataArray'LENGTH;
+  FOR OutBitPos IN 0 to (OutputLength -1) LOOP
+    NEXT WHEN PathConditionArray(OutBitPos) = FALSE;
+
+    NEXT WHEN ((ScheduleDataArrayNorm(OutBitPos).ScheduleValue 
+    = ScheduleDataArrayNorm(OutBitPos).OutputData) AND 
+    (ScheduleDataArrayNorm(OutBitPos).ScheduleTime <= NOW));
+
+    NewValue := ScheduleDataArrayNorm(OutBitPos).OutputData;
+    OldValue := ScheduleDataArrayNorm(OutBitPos).LastOutputValue;
+    PropDelay :=ScheduleDataArrayNorm(OutBitPos).PropDelay;
+    InputAge := ScheduleDataArrayNorm(OutBitPos).InputAge;
+    NumBitsPerSubWord:=ScheduleDataArrayNorm(OutBitPos).NumBitsPerSubWord;
+
+    CASE ArcType IS
+      WHEN ParallelArc =>
+        InputArrayLow := OutBitPos;
+        InputArrayHigh :=  OutBitPos;
+        DelayArrayIndex :=  OutBitPos;
+      WHEN CrossArc =>
+        InputArrayLow := 0;
+        InputArrayHigh := InputChangeTimeArray'LENGTH-1;
+        DelayArrayIndex := OutBitPos; 
+      WHEN SubwordArc =>
+        InputArrayLow := OutBitPos / NumBitsPerSubWord;
+        InputArrayHigh := OutBitPos / NumBitsPerSubWord;
+        DelayArrayIndex := OutBitPos + 
+          (OutputLength * (OutBitPos / NumBitsPerSubWord));  
+    END CASE;
+
+    FOR i IN InputArrayLow TO InputArrayHigh LOOP
+      CurPropDelay:= VitalCalcDelay (NewValue, 
+                  OldValue, DelayArrayNorm(DelayArrayIndex));
+
+      -- for debug purpose
+      debugprop(i) := CurPropDelay;
+      debugretain(i) := TIME'HIGH;
+                       
+      IF (ArcType = CrossArc) THEN
+        DelayArrayIndex := DelayArrayIndex + OutputLength;
+      END IF;
+
+      -- If there is one input change at a time, then choose the
+      -- delay from that input. If there is simultaneous input 
+      -- change, then choose the minimum of propagation delays 
+
+      IF (InputChangeTimeNorm(i) < 0 ns) THEN
+        CurInputAge := TIME'HIGH;
+      ELSE
+        CurInputAge := NOW - InputChangeTimeNorm(i);
+      END IF;            
+      IF (CurInputAge  < InputAge) THEN
+        PropDelay := CurPropDelay;
+        InputAge := CurInputAge;
+      ELSIF (CurInputAge = InputAge) THEN
+        IF (CurPropDelay < PropDelay) THEN
+          PropDelay := CurPropDelay;
+        END IF;
+      END IF;
+    END LOOP;  
+
+    -- Store it back to data strucutre
+    ScheduleDataArrayNorm(OutBitPos).PropDelay := PropDelay;
+    ScheduleDataArrayNorm(OutBitPos).InputAge := InputAge;
+
+    -- for debug purpose 
+    PrintDelay(outbitPos, InputArrayLow, InputArrayHigh,
+      debugprop, debugretain);
+  END LOOP;
+
+  ScheduleDataArray := ScheduleDataArrayNorm;
+
+END VitalMemorySelectDelay;
+
+-- ----------------------------------------------------------------------------
+-- VitalDelayArrayType
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySelectDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  VARIABLE InputChangeTimeArray : IN VitalTimeArrayT;
+  CONSTANT OutputSignalName     : IN STRING :="";
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType;
+  CONSTANT ArcType              : IN VitalMemoryArcType;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT
+) IS
+  VARIABLE InputArrayLow      : INTEGER := 0;
+  VARIABLE InputArrayHigh     : INTEGER := 0;
+  VARIABLE DelayArrayIndex    : INTEGER := 0;
+  VARIABLE NumBitsPerSubWord  : INTEGER := DefaultNumBitsPerSubword;
+  VARIABLE NewValue           : STD_ULOGIC;
+  VARIABLE OldValue           : STD_ULOGIC;
+  VARIABLE OutputLength       : INTEGER := 0;
+  VARIABLE OutArrayIndex      : INTEGER;
+  VARIABLE PropDelay          : TIME;
+  VARIABLE CurPropDelay       : TIME;
+  VARIABLE InputAge           : TIME;
+  VARIABLE CurInputAge        : TIME;
+  VARIABLE InputChangeTimeNorm  : VitalTimeArrayT(
+     InputChangeTimeArray'LENGTH-1 downto 0) := InputChangeTimeArray;
+  VARIABLE DelayArrayNorm  : VitalDelayArrayType(
+     PathDelayArray'LENGTH-1 downto 0) := PathDelayArray;
+  VARIABLE ScheduleDataArrayNorm : VitalMemoryScheduleDatavectorType
+     (ScheduleDataArray'LENGTH-1 downto 0) := ScheduleDataArray;
+   
+  -- for debug purpose
+  VARIABLE debugprop : VitalTimeArrayT(MaxNoInputBits-1 downto 0);
+  VARIABLE debugretain : VitalTimeArrayT(MaxNoInputBits-1 downto 0);
+BEGIN
+  
+  -- for debug purpose
+  PrintArcType(ArcType);
+
+  OutputLength := ScheduleDataArray'LENGTH;
+  FOR OutBitPos IN 0 to (OutputLength -1) LOOP
+    NEXT WHEN PathConditionArray(OutBitPos) = FALSE;
+
+    NEXT WHEN ((ScheduleDataArrayNorm(OutBitPos).ScheduleValue 
+      = ScheduleDataArrayNorm(OutBitPos).OutputData) AND 
+        (ScheduleDataArrayNorm(OutBitPos).ScheduleTime <= NOW));
+
+    NewValue := ScheduleDataArrayNorm(OutBitPos).OutputData;
+    OldValue := ScheduleDataArrayNorm(OutBitPos).LastOutputValue;
+    PropDelay :=ScheduleDataArrayNorm(OutBitPos).PropDelay;
+    InputAge := ScheduleDataArrayNorm(OutBitPos).InputAge;
+    NumBitsPerSubWord:=ScheduleDataArrayNorm(OutBitPos).NumBitsPerSubWord;
+
+    CASE ArcType IS
+      WHEN ParallelArc =>
+        InputArrayLow := OutBitPos;
+        InputArrayHigh :=  OutBitPos;
+        DelayArrayIndex :=  OutBitPos;
+      WHEN CrossArc =>
+        InputArrayLow := 0;
+        InputArrayHigh := InputChangeTimeArray'LENGTH-1;
+        DelayArrayIndex := OutBitPos; 
+      WHEN SubwordArc =>
+        InputArrayLow := OutBitPos / NumBitsPerSubWord;
+        InputArrayHigh := OutBitPos / NumBitsPerSubWord;
+        DelayArrayIndex := OutBitPos + 
+          (OutputLength * (OutBitPos / NumBitsPerSubWord));  
+    END CASE;
+
+    FOR i IN InputArrayLow TO InputArrayHigh LOOP
+      CurPropDelay := VitalCalcDelay (NewValue, 
+        OldValue, DelayArrayNorm(DelayArrayIndex)); 
+
+      -- for debug purpose
+      debugprop(i) := CurPropDelay;
+      debugretain(i) := TIME'HIGH;
+                   
+      IF (ArcType = CrossArc) THEN
+        DelayArrayIndex := DelayArrayIndex + OutputLength;
+      END IF;
+
+      -- If there is one input change at a time, then choose the
+      -- delay from that input. If there is simultaneous input 
+      -- change, then choose the minimum of propagation delays 
+
+      IF (InputChangeTimeNorm(i) < 0 ns) THEN
+        CurInputAge := TIME'HIGH;
+      ELSE
+        CurInputAge := NOW - InputChangeTimeNorm(i);
+      END IF;            
+
+      IF (CurInputAge  < InputAge) THEN
+        PropDelay := CurPropDelay;
+        InputAge := CurInputAge;
+      ELSIF (CurInputAge = InputAge) THEN
+        IF (CurPropDelay < PropDelay) THEN
+          PropDelay := CurPropDelay;
+        END IF;
+      END IF;
+    END LOOP;  
+
+    -- Store it back to data strucutre
+    ScheduleDataArrayNorm(OutBitPos).PropDelay := PropDelay;
+    ScheduleDataArrayNorm(OutBitPos).InputAge := InputAge;
+
+    -- for debug purpose 
+    PrintDelay(outbitPos, InputArrayLow, InputArrayHigh,
+      debugprop, debugretain);
+  END LOOP;
+
+  ScheduleDataArray := ScheduleDataArrayNorm;
+
+END VitalMemorySelectDelay;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryInitPathDelay
+-- Description: To initialize Schedule Data structure for an
+--              output.
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryInitPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  VARIABLE OutputDataArray   : IN STD_LOGIC_VECTOR;
+  CONSTANT NumBitsPerSubWord : IN INTEGER := DefaultNumBitsPerSubword
+) IS
+BEGIN
+  -- Initialize the ScheduleData Structure.
+  FOR i IN OutputDataArray'RANGE LOOP        
+    ScheduleDataArray(i).OutputData    := OutputDataArray(i); 
+    ScheduleDataArray(i).PropDelay     := TIME'HIGH;
+    ScheduleDataArray(i).OutputRetainDelay := TIME'HIGH;
+    ScheduleDataArray(i).InputAge      := TIME'HIGH;
+    ScheduleDataArray(i).NumBitsPerSubWord := NumBitsPerSubWord;
+
+    -- Update LastOutputValue of Output if the Output has 
+    -- already been scheduled.
+    IF ((ScheduleDataArray(i).ScheduleValue /= OutputDataArray(i)) AND
+        (ScheduleDataArray(i).ScheduleTime <= NOW)) THEN
+       ScheduleDataArray(i).LastOutputValue 
+                := ScheduleDataArray(i).ScheduleValue;
+    END IF;                                   
+  END LOOP; 
+
+  -- for debug purpose
+  DebugMsg1;
+  PrintScheduleDataArray(ScheduleDataArray);
+
+END VitalMemoryInitPathDelay;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryInitPathDelay (
+  VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType;
+  VARIABLE OutputData   : IN STD_ULOGIC
+) IS
+  VARIABLE ScheduledataArray: VitalMemoryScheduleDataVectorType
+                                        (0 downto 0);
+  VARIABLE OutputDataArray  : STD_LOGIC_VECTOR(0 downto 0);
+BEGIN
+  ScheduledataArray(0) := ScheduleData;
+  OutputDataArray(0)   := OutputData;
+  VitalMemoryInitPathDelay (
+    ScheduleDataArray => ScheduleDataArray,
+    OutputDataArray   => OutputDataArray,
+    NumBitsPerSubWord => DefaultNumBitsPerSubword
+  );
+
+  -- for debug purpose
+  DebugMsg1;
+  PrintScheduleDataArray( ScheduleDataArray);
+
+END VitalMemoryInitPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryAddPathDelay
+-- Description: Declare a path for one scalar/vector input to 
+--              the output for which Schedule Data has been
+--              initialized previously.
+-- ----------------------------------------------------------------------------
+
+-- ----------------------------------------------------------------------------
+-- #1
+-- DelayType - VitalMemoryDelayType
+-- Input     - Scalar 
+-- Output    - Scalar 
+-- Delay     - Scalar 
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData      : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelay         : IN VitalDelayType;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE
+) IS
+  VARIABLE ScheduleDataArray : 
+              VitalMemoryScheduleDataVectorType(0 downto 0);
+  VARIABLE PathDelayArray : VitalDelayArrayType(0 downto 0);
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); 
+  VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); 
+BEGIN
+  PathConditionArray(0) := PathCondition;
+  ScheduleDataArray(0) := ScheduleData;
+  PathDelayArray(0) := PathDelay;
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;          
+   
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #2
+-- DelayType - VitalMemoryDelayType
+-- Input     - Scalar 
+-- Output    - Vector 
+-- Delay     - Vector 
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal        : IN STD_ULOGIC;
+  CONSTANT OutputSignalName   : IN STRING :="";
+  VARIABLE InputChangeTime    : INOUT TIME;
+  CONSTANT PathDelayArray     : IN VitalDelayArrayType;
+  CONSTANT ArcType            : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition      : IN BOOLEAN := TRUE
+) IS
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE PathConditionArray :
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0);
+BEGIN
+  FOR i IN PathConditionArray'RANGE LOOP
+    PathConditionArray(i) := PathCondition;
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime; 
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray
+  );
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #3
+-- DelayType - VitalMemoryDelayType
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal        : IN STD_ULOGIC;
+  CONSTANT OutputSignalName   : IN STRING :="";
+  VARIABLE InputChangeTime    : INOUT TIME;
+  CONSTANT PathDelayArray     : IN VitalDelayArrayType;
+  CONSTANT ArcType            : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray : IN VitalBoolArrayT
+) IS
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArrayNorm : 
+      VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR Mem400 
+  VARIABLE PathConditionArrayExp : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  NumBitsPerSubword := 
+    ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword;
+  FOR i IN PathConditionArrayExp'RANGE LOOP
+    PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword);
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArrayExp);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #4
+-- DelayType - VitalMemoryDelayType
+-- Input     - Vector
+-- Output    - Scalar 
+-- Delay     - Vector 
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE
+) IS
+  VARIABLE ScheduleDataArray : VitalMemoryScheduleDataVectorType(0 downto 0);
+  VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); 
+BEGIN
+  PathConditionArray(0) := PathCondition;
+
+  ScheduleDataArray(0) := ScheduleData;
+  VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal);
+    
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #5
+-- DelayType - VitalMemoryDelayType
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector 
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal        : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName   : IN STRING :="";
+  VARIABLE InputChangeTimeArray  : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray        : IN VitalDelayArrayType;
+  CONSTANT ArcType               : IN VitalMemoryArcType := CrossArc; 
+  CONSTANT PathCondition         : IN BOOLEAN := TRUE
+) IS
+  VARIABLE PathConditionArray : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  FOR i IN PathConditionArray'RANGE LOOP
+    PathConditionArray(i) := PathCondition;
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); 
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray,
+    ArcType, PathConditionArray);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #6
+-- DelayType - VitalMemoryDelayType
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal        : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName   : IN STRING :="";
+  VARIABLE InputChangeTimeArray  : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray        : IN VitalDelayArrayType;
+  CONSTANT ArcType               : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray    : IN VitalBoolArrayT
+) IS
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArrayNorm : 
+      VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; 
+  VARIABLE PathConditionArrayExp : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword;
+  FOR i IN PathConditionArrayExp'RANGE LOOP
+    PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword);
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal);
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArrayExp);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #7
+-- DelayType - VitalMemoryDelayType01
+-- Input     - Scalar
+-- Output    - Scalar
+-- Delay     - Scalar 
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData      : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelay         : IN VitalDelayType01;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc; 
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE
+) IS
+  VARIABLE ScheduleDataArray : 
+           VitalMemoryScheduleDataVectorType(0 downto 0);
+  VARIABLE PathDelayArray : VitalDelayArrayType01(0 downto 0);
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); 
+  VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); 
+BEGIN
+  PathConditionArray(0) := PathCondition;
+  ScheduleDataArray(0) := ScheduleData;
+  PathDelayArray(0) := PathDelay;
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #8
+-- DelayType - VitalMemoryDelayType01
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE
+) IS
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE PathConditionArray : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  FOR i IN PathConditionArray'RANGE LOOP
+    PathConditionArray(i) := PathCondition;
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #9
+-- DelayType - VitalMemoryDelayType01
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray: IN VitalBoolArrayT
+) IS
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArrayNorm : 
+      VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; 
+  VARIABLE PathConditionArrayExp : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword;
+  FOR i IN PathConditionArrayExp'RANGE LOOP
+    PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword);
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArrayExp);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #10
+-- DelayType - VitalMemoryDelayType01
+-- Input     - Vector
+-- Output    - Scalar
+-- Delay     - Vector
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData        : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal         : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName    : IN STRING :="";
+  VARIABLE InputChangeTimeArray: INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray      : IN VitalDelayArrayType01;
+  CONSTANT ArcType             : IN VitalMemoryArcType := CrossArc; 
+  CONSTANT PathCondition       : IN BOOLEAN := TRUE
+)IS 
+  VARIABLE ScheduleDataArray : 
+      VitalMemoryScheduleDataVectorType(0 downto 0);
+  VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); 
+BEGIN
+  PathConditionArray(0) := PathCondition;
+  ScheduleDataArray(0) := ScheduleData;
+  VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); 
+                                         
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray); 
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #11
+-- DelayType - VitalMemoryDelayType01
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal        : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName   : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01;
+  CONSTANT ArcType              : IN VitalMemoryArcType  := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE
+) IS
+  VARIABLE PathConditionArray : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  FOR i IN PathConditionArray'RANGE LOOP
+    PathConditionArray(i) := PathCondition;
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); 
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #12
+-- DelayType - VitalMemoryDelayType01
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01;
+  CONSTANT ArcType              : IN VitalMemoryArcType  := CrossArc;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT
+) IS
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArrayNorm : 
+      VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; 
+  VARIABLE PathConditionArrayExp : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword;
+  FOR i IN PathConditionArrayExp'RANGE LOOP
+    PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword);
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal);
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArrayExp);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #13
+-- DelayType - VitalMemoryDelayType01Z
+-- Input     - Scalar
+-- Output    - Scalar
+-- Delay     - Scalar
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData     : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal      : IN STD_ULOGIC;
+  CONSTANT OutputSignalName : IN STRING :="";
+  VARIABLE InputChangeTime  : INOUT TIME;
+  CONSTANT PathDelay        : IN VitalDelayType01Z;
+  CONSTANT ArcType          : IN VitalMemoryArcType := CrossArc; 
+  CONSTANT PathCondition    : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE
+) IS
+  VARIABLE ScheduleDataArray : 
+           VitalMemoryScheduleDataVectorType(0 downto 0);
+  VARIABLE PathDelayArray : VitalDelayArrayType01Z(0 downto 0);
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); 
+BEGIN
+  PathConditionArray(0) := PathCondition;
+  ScheduleDataArray(0) := ScheduleData;
+  PathDelayArray(0) := PathDelay;
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray, OutputRetainFlag);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #14
+-- DelayType - VitalMemoryDelayType01Z
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType           : IN VitalMemoryArcType  := CrossArc;
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+) IS
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE PathConditionArray : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  FOR i IN PathConditionArray'RANGE LOOP
+    PathConditionArray(i) := PathCondition;
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime; 
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray, OutputRetainFlag);
+
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #15
+-- DelayType - VitalMemoryDelayType01Z
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType           : IN VitalMemoryArcType  := CrossArc;
+  CONSTANT PathConditionArray: IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+) IS
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArrayNorm : VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0); 
+  VARIABLE PathConditionArrayExp : VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  NumBitsPerSubword := ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword;
+  FOR i IN PathConditionArrayExp'RANGE LOOP
+    PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword);
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArrayExp, OutputRetainFlag);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #16
+-- DelayType - VitalMemoryDelayType01Z
+-- Input     - Vector
+-- Output    - Scalar
+-- Delay     - Vector
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType              : IN VitalMemoryArcType  := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+) IS
+  VARIABLE ScheduleDataArray : 
+              VitalMemoryScheduleDataVectorType(0 downto 0);
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); 
+BEGIN
+  PathConditionArray(0) := PathCondition;
+  ScheduleDataArray(0) := ScheduleData;
+  NumBitsPerSubword := ScheduleDataArray(0).NumBitsPerSubword;
+  IF (OutputRetainBehavior = WordCorrupt AND 
+      ArcType = ParallelArc AND
+      OutputRetainFlag = TRUE) THEN
+    VitalMemoryUpdateInputChangeTime(
+      InputChangeTimeArray, 
+      InputSignal,
+      NumBitsPerSubword
+    ); 
+  ELSE
+    VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); 
+  END IF;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray, OutputRetainFlag);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #17
+-- DelayType - VitalMemoryDelayType01Z
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector  
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+) IS
+  VARIABLE NumBitsPerSubword  : INTEGER;
+  VARIABLE PathConditionArray : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  FOR i IN PathConditionArray'RANGE LOOP
+    PathConditionArray(i) := PathCondition;
+  END LOOP;
+
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'LEFT).NumBitsPerSubword;
+  IF (OutputRetainBehavior = WordCorrupt AND 
+      ArcType = ParallelArc AND
+      OutputRetainFlag = TRUE) THEN
+    VitalMemoryUpdateInputChangeTime(
+      InputChangeTimeArray, 
+      InputSignal,
+      NumBitsPerSubword
+    ); 
+  ELSE
+    VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); 
+  END IF;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray, OutputRetainFlag);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #18
+-- DelayType - VitalMemoryDelayType01Z
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector 
+-- Condition - Vector
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+) IS
+VARIABLE NumBitsPerSubword : INTEGER;
+VARIABLE PathConditionArrayNorm : 
+    VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0); 
+VARIABLE PathConditionArrayExp : 
+    VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  NumBitsPerSubword := ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword;
+  FOR i IN PathConditionArrayExp'RANGE LOOP
+    PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword);
+  END LOOP;
+
+  IF (OutputRetainBehavior = WordCorrupt AND 
+      ArcType = ParallelArc AND
+      OutputRetainFlag = TRUE) THEN
+    VitalMemoryUpdateInputChangeTime(
+        InputChangeTimeArray, InputSignal,
+        NumBitsPerSubword);
+  ELSE
+    VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal);
+  END IF;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArrayExp, OutputRetainFlag);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #19
+-- DelayType - VitalMemoryDelayType01XZ
+-- Input     - Scalar
+-- Output    - Scalar
+-- Delay     - Scalar
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData      : INOUT  VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelay         : IN VitalDelayType01ZX;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc; 
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+) IS
+  VARIABLE ScheduleDataArray : 
+         VitalMemoryScheduleDataVectorType(0 downto 0);
+  VARIABLE PathDelayArray : VitalDelayArrayType01ZX(0 downto 0);
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); 
+BEGIN
+  PathConditionArray(0) := PathCondition;
+  ScheduleDataArray(0) := ScheduleData;
+  PathDelayArray(0) := PathDelay;
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray, OutputRetainFlag); 
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #20
+-- DelayType - VitalMemoryDelayType01XZ
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray :INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc; 
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+) IS
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE PathConditionArray : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  FOR i IN PathConditionArray'RANGE LOOP
+    PathConditionArray(i) := PathCondition;
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime; 
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,  
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray, OutputRetainFlag); 
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #21
+-- DelayType - VitalMemoryDelayType01XZ
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray :INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTime   : INOUT TIME;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray: IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+) IS
+  VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0);
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArrayNorm : 
+      VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; 
+  VARIABLE PathConditionArrayExp : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword;
+  FOR i IN PathConditionArrayExp'RANGE LOOP
+    PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword);
+  END LOOP;
+
+  VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal);
+  InputChangeTimeArray(0) := InputChangeTime;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArrayExp, OutputRetainFlag);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #22
+-- DelayType - VitalMemoryDelayType01XZ
+-- Input     - Vector
+-- Output    - Scalar
+-- Delay     - Vector
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT  VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc; 
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+) IS 
+  VARIABLE ScheduleDataArray : 
+    VitalMemoryScheduleDataVectorType(0 downto 0);
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); 
+BEGIN
+  PathConditionArray(0) := PathCondition;
+  ScheduleDataArray(0) := ScheduleData;
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'LEFT).NumBitsPerSubword;
+  IF (OutputRetainBehavior = WordCorrupt AND 
+      ArcType = ParallelArc AND
+      OutputRetainFlag = TRUE) THEN
+    VitalMemoryUpdateInputChangeTime(
+      InputChangeTimeArray, InputSignal,
+      NumBitsPerSubword); 
+  ELSE
+    VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); 
+  END IF;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray, 
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray, OutputRetainFlag);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #23
+-- DelayType - VitalMemoryDelayType01XZ
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar 
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType              : IN VitalMemoryArcType  := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+) IS
+  VARIABLE NumBitsPerSubword  : INTEGER;
+  VARIABLE PathConditionArray : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  FOR i IN PathConditionArray'RANGE LOOP
+    PathConditionArray(i) := PathCondition;
+  END LOOP;
+
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'LEFT).NumBitsPerSubword;
+  IF (OutputRetainBehavior = WordCorrupt AND 
+      ArcType = ParallelArc AND
+      OutputRetainFlag = TRUE) THEN
+    VitalMemoryUpdateInputChangeTime(
+      InputChangeTimeArray, InputSignal,
+      NumBitsPerSubword); 
+  ELSE
+    VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); 
+  END IF;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArray, OutputRetainFlag); 
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- #24
+-- DelayType - VitalMemoryDelayType01XZ
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING :="";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType              : IN VitalMemoryArcType  := CrossArc;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+) IS
+  VARIABLE NumBitsPerSubword : INTEGER;
+  VARIABLE PathConditionArrayNorm : 
+      VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; 
+  VARIABLE PathConditionArrayExp : 
+      VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); 
+BEGIN
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword;
+  FOR i IN PathConditionArrayExp'RANGE LOOP
+    PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword);
+  END LOOP;
+
+  IF (OutputRetainBehavior = WordCorrupt AND 
+      ArcType = ParallelArc AND
+      OutputRetainFlag = TRUE) THEN
+    VitalMemoryUpdateInputChangeTime(
+      InputChangeTimeArray, InputSignal,
+      NumBitsPerSubword);
+  ELSE
+    VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal);
+  END IF;
+
+  VitalMemorySelectDelay(
+    ScheduleDataArray, InputChangeTimeArray,
+    OutputSignalName, PathDelayArray, 
+    ArcType, PathConditionArrayExp, OutputRetainFlag);
+END VitalMemoryAddPathDelay;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemorySchedulePathDelay
+-- Description: Schedule Output after Propagation Delay selected
+--              by checking all the paths added thru' 
+--              VitalMemoryAddPathDelay.
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySchedulePathDelay (
+  SIGNAL   OutSignal        : OUT STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName : IN STRING :="";
+  CONSTANT PortFlag         : IN VitalPortFlagType := VitalDefaultPortFlag;
+  CONSTANT OutputMap        : IN VitalOutputMapType:= VitalDefaultOutputMap;
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType
+) IS
+  VARIABLE Age               : TIME;
+  VARIABLE PropDelay         : TIME;
+  VARIABLE RetainDelay       : TIME;
+  VARIABLE Data              : STD_ULOGIC;
+BEGIN
+  IF (PortFlag.OutputDisable /= TRUE) THEN
+    FOR i IN ScheduleDataArray'RANGE LOOP
+      PropDelay := ScheduleDataArray(i).PropDelay;
+      RetainDelay := ScheduleDataArray(i).OutputRetainDelay;   
+
+      NEXT WHEN PropDelay = TIME'HIGH;
+
+      Age := ScheduleDataArray(i).InputAge; 
+      Data := ScheduleDataArray(i).OutputData;
+
+      IF (Age < RetainDelay and RetainDelay < PropDelay) THEN
+        OutSignal(i) <= TRANSPORT 'X' AFTER (RetainDelay - Age);
+      END IF;
+
+      IF (Age <= PropDelay) THEN
+        OutSignal(i)<= TRANSPORT OutputMap(Data)AFTER (PropDelay-Age);
+        ScheduleDataArray(i).ScheduleValue := Data;
+        ScheduleDataArray(i).ScheduleTime := NOW + PropDelay - Age;
+      END IF;
+    END LOOP;
+  END IF;
+
+  -- for debug purpose
+  PrintScheduleDataArray(ScheduleDataArray);
+
+  -- for debug purpose
+  ScheduleDebugMsg;
+END VitalMemorySchedulePathDelay;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemorySchedulePathDelay
+-- Description: Schedule Output after Propagation Delay selected
+--              by checking all the paths added thru' 
+--              VitalMemoryAddPathDelay.
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySchedulePathDelay (
+  SIGNAL   OutSignal        : OUT STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName : IN STRING :="";
+  CONSTANT PortFlag         : IN VitalPortFlagVectorType;
+  CONSTANT OutputMap        : IN VitalOutputMapType:= VitalDefaultOutputMap;
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType
+) IS
+  VARIABLE Age               : TIME;
+  VARIABLE PropDelay         : TIME;
+  VARIABLE RetainDelay       : TIME;
+  VARIABLE Data              : STD_ULOGIC;
+  VARIABLE ExpandedPortFlag  : 
+      VitalPortFlagVectorType(ScheduleDataArray'RANGE);
+  VARIABLE NumBitsPerSubword : INTEGER;
+BEGIN
+  NumBitsPerSubword := 
+      ScheduleDataArray(ScheduleDataArray'LEFT).NumBitsPerSubword;
+  VitalMemoryExpandPortFlag( PortFlag, NumBitsPerSubword, ExpandedPortFlag );
+  FOR i IN ScheduleDataArray'RANGE LOOP
+    NEXT WHEN ExpandedPortFlag(i).OutputDisable = TRUE;
+
+    PropDelay := ScheduleDataArray(i).PropDelay;
+    RetainDelay := ScheduleDataArray(i).OutputRetainDelay;   
+    
+    NEXT WHEN PropDelay = TIME'HIGH;
+
+    Age  := ScheduleDataArray(i).InputAge; 
+    Data := ScheduleDataArray(i).OutputData;
+
+    IF (Age < RetainDelay and RetainDelay < PropDelay) THEN
+      OutSignal(i) <= TRANSPORT 'X' AFTER (RetainDelay - Age);
+    END IF;
+
+    IF (Age <= PropDelay) THEN
+      OutSignal(i)<= TRANSPORT OutputMap(Data)AFTER (PropDelay-Age);
+      ScheduleDataArray(i).ScheduleValue := Data;
+      ScheduleDataArray(i).ScheduleTime := NOW + PropDelay - Age;
+    END IF;
+  END LOOP;
+
+  -- for debug purpose
+  PrintScheduleDataArray(ScheduleDataArray);
+
+  -- for debug purpose
+  ScheduleDebugMsg;
+END VitalMemorySchedulePathDelay;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySchedulePathDelay (
+  SIGNAL   OutSignal       : OUT STD_ULOGIC;
+  CONSTANT OutputSignalName: IN STRING :="";
+  CONSTANT PortFlag        : IN VitalPortFlagType := VitalDefaultPortFlag;
+  CONSTANT OutputMap       : IN VitalOutputMapType := VitalDefaultOutputMap;
+  VARIABLE ScheduleData    : INOUT VitalMemoryScheduleDataType
+) IS
+  VARIABLE Age               : TIME;
+  VARIABLE PropDelay         : TIME;
+  VARIABLE RetainDelay       : TIME;
+  VARIABLE Data              : STD_ULOGIC;
+  VARIABLE ScheduleDataArray : VitalMemoryScheduleDataVectorType (0 downto 0);
+BEGIN
+  IF (PortFlag.OutputDisable /= TRUE) THEN
+    ScheduledataArray(0) := ScheduleData;
+    PropDelay := ScheduleDataArray(0).PropDelay;
+    RetainDelay := ScheduleDataArray(0).OutputRetainDelay;
+    Age := ScheduleDataArray(0).InputAge; 
+    Data := ScheduleDataArray(0).OutputData;
+
+    IF (Age < RetainDelay and RetainDelay < PropDelay) THEN
+      OutSignal <= TRANSPORT 'X' AFTER (RetainDelay - Age);
+    END IF;
+
+    IF (Age <= PropDelay and PropDelay /= TIME'HIGH) THEN
+      OutSignal <= TRANSPORT OutputMap(Data)  AFTER (PropDelay - Age);
+      ScheduleDataArray(0).ScheduleValue := Data;
+      ScheduleDataArray(0).ScheduleTime := NOW + PropDelay - Age;
+    END IF;
+  END IF;
+
+  -- for debug purpose
+  PrintScheduleDataArray(ScheduleDataArray);
+
+  -- for debug purpose
+  ScheduleDebugMsg;
+
+END VitalMemorySchedulePathDelay;
+
+-- ----------------------------------------------------------------------------
+-- Procedure  : InternalTimingCheck
+-- ----------------------------------------------------------------------------
+PROCEDURE InternalTimingCheck (
+  CONSTANT TestSignal    : IN     std_ulogic;
+  CONSTANT RefSignal     : IN     std_ulogic;
+  CONSTANT TestDelay     : IN     TIME := 0 ns;
+  CONSTANT RefDelay      : IN     TIME := 0 ns;
+  CONSTANT SetupHigh     : IN     TIME := 0 ns;
+  CONSTANT SetupLow      : IN     TIME := 0 ns;
+  CONSTANT HoldHigh      : IN     TIME := 0 ns;
+  CONSTANT HoldLow       : IN     TIME := 0 ns;
+  VARIABLE RefTime       : IN     TIME;
+  VARIABLE RefEdge       : IN     BOOLEAN;
+  VARIABLE TestTime      : IN     TIME;
+  VARIABLE TestEvent     : IN     BOOLEAN;
+  VARIABLE SetupEn       : INOUT  BOOLEAN;
+  VARIABLE HoldEn        : INOUT  BOOLEAN;
+  VARIABLE CheckInfo     : INOUT  CheckInfoType;
+  CONSTANT MsgOn         : IN     BOOLEAN
+) IS
+  VARIABLE bias           : TIME;
+  VARIABLE actualObsTime  : TIME;
+  VARIABLE BC             : TIME;
+  VARIABLE Message        :LINE;
+BEGIN
+  -- Check SETUP constraint
+  IF (RefEdge) THEN
+    IF (SetupEn) THEN
+      CheckInfo.ObsTime   := RefTime - TestTime;
+      CheckInfo.State     := To_X01(TestSignal);
+      CASE CheckInfo.State IS
+        WHEN '0' =>
+          CheckInfo.ExpTime := SetupLow;
+          -- start of new code IR245-246
+          BC := HoldHigh;
+          -- end of new code IR245-246
+        WHEN '1' =>
+          CheckInfo.ExpTime := SetupHigh;
+          -- start of new code IR245-246
+          BC := HoldLow;
+          -- end of new code IR245-246
+        WHEN 'X' => 
+          CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow);
+          -- start of new code IR245-246
+          BC := Maximum(HoldHigh,HoldLow);
+          -- end of new code IR245-246
+      END CASE;
+      -- added the second condition for IR 245-246
+      CheckInfo.Violation := 
+          ((CheckInfo.ObsTime < CheckInfo.ExpTime) 
+            AND ( NOT ((CheckInfo.ObsTime = BC) and (BC = 0 ns))));
+      -- start of new code IR245-246
+      IF (CheckInfo.ExpTime = 0 ns) THEN
+        CheckInfo.CheckKind := HoldCheck;
+      ELSE
+        CheckInfo.CheckKind := SetupCheck;
+      END IF;
+      -- end of new code IR245-246
+      SetupEn  := FALSE;
+    ELSE
+      CheckInfo.Violation := FALSE;
+    END IF;
+
+  -- Check HOLD constraint
+  ELSIF (TestEvent) THEN
+    IF HoldEn THEN
+      CheckInfo.ObsTime := TestTime - RefTime;
+      CheckInfo.State := To_X01(TestSignal);
+      CASE CheckInfo.State IS
+        WHEN '0' =>
+          CheckInfo.ExpTime := HoldHigh;
+          -- new code for unnamed IR 
+          CheckInfo.State := '1';
+          -- start of new code IR245-246
+          BC := SetupLow;
+          -- end of new code IR245-246
+        WHEN '1' =>
+          CheckInfo.ExpTime := HoldLow;
+          -- new code for unnamed IR 
+          CheckInfo.State := '0';
+          -- start of new code IR245-246
+          BC := SetupHigh;
+          -- end of new code IR245-246
+        WHEN 'X' =>
+          CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow);
+          -- start of new code IR245-246
+          BC := Maximum(SetupHigh,SetupLow);
+          -- end of new code IR245-246
+      END CASE;
+      -- added the second condition for IR 245-246
+      CheckInfo.Violation := 
+        ((CheckInfo.ObsTime < CheckInfo.ExpTime) 
+          AND ( NOT ((CheckInfo.ObsTime = BC) and (BC = 0 ns))));
+      -- start of new code IR245-246
+      IF (CheckInfo.ExpTime = 0 ns) THEN
+        CheckInfo.CheckKind := SetupCheck;
+      ELSE
+        CheckInfo.CheckKind := HoldCheck;
+      END IF;
+      -- end of new code IR245-246
+      HoldEn := NOT CheckInfo.Violation;
+    ELSE
+      CheckInfo.Violation := FALSE;
+    END IF;
+  ELSE
+    CheckInfo.Violation := FALSE;
+  END IF;
+
+  -- Adjust report values to account for internal model delays
+  -- Note: TestDelay, RefDelay, TestTime, RefTime are non-negative
+  -- Note: bias may be negative or positive
+  IF MsgOn AND CheckInfo.Violation THEN
+    -- modified the code for correct reporting of violation in case of 
+    -- order of signals being reversed because of internal delays
+    -- new variable 
+    actualObsTime := (TestTime-TestDelay)-(RefTime-RefDelay);
+    bias := TestDelay - RefDelay;
+    IF (actualObsTime < 0 ns) THEN -- It should be a setup check
+      IF ( CheckInfo.CheckKind = HoldCheck) THEN
+        CheckInfo.CheckKind := SetupCheck;
+        CASE CheckInfo.State IS
+          WHEN '0' => CheckInfo.ExpTime := SetupLow; 
+          WHEN '1' => CheckInfo.ExpTime := SetupHigh;
+          WHEN 'X' => CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow);
+        END CASE;	       	  
+      END IF;
+      CheckInfo.ObsTime := -actualObsTime;
+      CheckInfo.ExpTime := CheckInfo.ExpTime + bias;
+      CheckInfo.DetTime := RefTime - RefDelay;
+    ELSE -- It should be a hold check
+      IF (CheckInfo.CheckKind = SetupCheck) THEN
+        CheckInfo.CheckKind :=  HoldCheck;
+        CASE CheckInfo.State IS
+          WHEN '0' =>
+            CheckInfo.ExpTime := HoldHigh;
+            CheckInfo.State   := '1';
+          WHEN '1' =>
+            CheckInfo.ExpTime := HoldLow;
+            CheckInfo.State   := '0';
+          WHEN 'X' =>
+            CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow);
+        END CASE;
+      END IF;
+      CheckInfo.ObsTime := actualObsTime;
+      CheckInfo.ExpTime := CheckInfo.ExpTime - bias;
+      CheckInfo.DetTime := TestTime - TestDelay;
+    END IF;
+  END IF;
+END InternalTimingCheck;
+
+
+-- ----------------------------------------------------------------------------
+-- Setup and Hold Time Check Routine 
+-- ----------------------------------------------------------------------------
+PROCEDURE TimingArrayIndex (
+  SIGNAL InputSignal      : IN Std_logic_vector;
+  CONSTANT ArrayIndexNorm : IN INTEGER;
+  VARIABLE Index          : OUT INTEGER
+) IS
+BEGIN
+  IF (InputSignal'LEFT > InputSignal'RIGHT) THEN
+    Index  := ArrayIndexNorm + InputSignal'RIGHT;
+  ELSE
+    Index  := InputSignal'RIGHT - ArrayIndexNorm;
+  END IF;
+END TimingArrayIndex;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryReportViolation (
+  CONSTANT TestSignalName : IN STRING := "";
+  CONSTANT RefSignalName  : IN STRING := "";
+  CONSTANT HeaderMsg      : IN STRING := " ";
+  CONSTANT CheckInfo      : IN CheckInfoType;
+  CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+) IS
+  VARIABLE Message : LINE;
+BEGIN
+  IF (NOT CheckInfo.Violation) THEN
+    RETURN;
+  END IF;
+  Write ( Message, HeaderMsg );
+  CASE CheckInfo.CheckKind IS
+    WHEN    SetupCheck => Write ( Message, STRING'(" SETUP ")      );
+    WHEN     HoldCheck => Write ( Message, STRING'(" HOLD ")       );
+    WHEN RecoveryCheck => Write ( Message, STRING'(" RECOVERY ")   );
+    WHEN  RemovalCheck => Write ( Message, STRING'(" REMOVAL ")    );
+    WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH "));
+    WHEN   PeriodCheck => Write ( Message, STRING'(" PERIOD ")     );
+  END CASE;
+  Write ( Message, HiLoStr(CheckInfo.State) );
+  Write ( Message, STRING'(" VIOLATION ON ") );
+  Write ( Message, TestSignalName );
+  IF (RefSignalName'LENGTH > 0) THEN
+    Write ( Message, STRING'(" WITH RESPECT TO ") );
+    Write ( Message, RefSignalName );
+  END IF;
+  Write ( Message, ';' & LF );
+  Write ( Message, STRING'("  Expected := ")  );
+  Write ( Message, CheckInfo.ExpTime);
+  Write ( Message, STRING'("; Observed := ")  );
+  Write ( Message, CheckInfo.ObsTime);
+  Write ( Message, STRING'("; At : ")         );
+  Write ( Message, CheckInfo.DetTime);
+  ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity;
+  DEALLOCATE (Message);
+END VitalMemoryReportViolation;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryReportViolation (
+  CONSTANT TestSignalName : IN STRING := "";
+  CONSTANT RefSignalName  : IN STRING := "";
+  CONSTANT TestArrayIndex : IN INTEGER;
+  CONSTANT RefArrayIndex  : IN INTEGER;
+  SIGNAL TestSignal       : IN std_logic_vector;
+  SIGNAL RefSignal        : IN std_logic_vector;
+  CONSTANT HeaderMsg      : IN STRING := " ";
+  CONSTANT CheckInfo      : IN CheckInfoType;
+  CONSTANT MsgFormat      : IN VitalMemoryMsgFormatType;
+  CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+) IS
+  VARIABLE Message : LINE;
+  VARIABLE i, j : INTEGER;
+BEGIN
+  IF (NOT CheckInfo.Violation) THEN 
+    RETURN; 
+  END IF;
+
+  Write ( Message, HeaderMsg );
+  CASE CheckInfo.CheckKind IS
+    WHEN    SetupCheck => Write ( Message, STRING'(" SETUP ")      );
+    WHEN     HoldCheck => Write ( Message, STRING'(" HOLD ")       );
+    WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH "));
+    WHEN   PeriodCheck => Write ( Message, STRING'(" PERIOD ")     );
+    WHEN OTHERS        => Write ( Message, STRING'(" UNKNOWN ")     );
+  END CASE;
+  Write ( Message, HiLoStr(CheckInfo.State) );
+  Write ( Message, STRING'(" VIOLATION ON ") );
+  Write ( Message, TestSignalName );
+  TimingArrayIndex(TestSignal, TestArrayIndex, i);
+  CASE MsgFormat IS
+    WHEN Scalar => 
+      NULL;
+    WHEN VectorEnum =>
+      Write ( Message, '_');
+      Write ( Message, i);  
+    WHEN Vector =>
+      Write ( Message, '(');
+      Write ( Message, i); 
+      Write ( Message, ')'); 
+  END CASE;
+
+  IF (RefSignalName'LENGTH > 0) THEN
+    Write ( Message, STRING'(" WITH RESPECT TO ") );
+    Write ( Message, RefSignalName );
+  END IF;
+
+  IF(RefSignal'LENGTH > 0) THEN
+    TimingArrayIndex(RefSignal, RefArrayIndex, j);
+    CASE MsgFormat IS
+      WHEN Scalar => 
+        NULL;
+      WHEN VectorEnum =>
+        Write ( Message, '_');
+        Write ( Message, j);  
+      WHEN Vector =>
+        Write ( Message, '(');
+        Write ( Message, j); 
+        Write ( Message, ')');
+    END CASE;
+  END IF;
+
+  Write ( Message, ';' & LF );
+  Write ( Message, STRING'("  Expected := ")  );
+  Write ( Message, CheckInfo.ExpTime);
+  Write ( Message, STRING'("; Observed := ")  );
+  Write ( Message, CheckInfo.ObsTime);
+  Write ( Message, STRING'("; At : ")         );
+  Write ( Message, CheckInfo.DetTime);
+
+  ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity;
+
+  DEALLOCATE (Message);
+END VitalMemoryReportViolation;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryReportViolation (
+  CONSTANT TestSignalName : IN STRING := "";
+  CONSTANT RefSignalName  : IN STRING := "";
+  CONSTANT TestArrayIndex : IN INTEGER;
+  CONSTANT HeaderMsg      : IN STRING := " ";
+  CONSTANT CheckInfo      : IN CheckInfoType;
+  CONSTANT MsgFormat      : IN VitalMemoryMsgFormatType;
+  CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+) IS
+  VARIABLE Message : LINE;
+BEGIN
+  IF (NOT CheckInfo.Violation) THEN 
+    RETURN; 
+  END IF;
+
+  Write ( Message, HeaderMsg );
+  CASE CheckInfo.CheckKind IS
+    WHEN    SetupCheck => Write ( Message, STRING'(" SETUP ")      );
+    WHEN     HoldCheck => Write ( Message, STRING'(" HOLD ")       );
+    WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH "));
+    WHEN   PeriodCheck => Write ( Message, STRING'(" PERIOD ")     );
+    WHEN        OTHERS => Write ( Message, STRING'(" UNKNOWN ")     );
+  END CASE;
+
+  Write ( Message, HiLoStr(CheckInfo.State) );
+  Write ( Message, STRING'(" VIOLATION ON ") );
+  Write ( Message, TestSignalName );
+
+  CASE MsgFormat IS
+    WHEN Scalar => 
+      NULL;
+    WHEN VectorEnum =>
+      Write ( Message, '_');
+      Write ( Message, TestArrayIndex);  
+    WHEN Vector =>
+      Write ( Message, '(');
+      Write ( Message, TestArrayIndex); 
+      Write ( Message, ')');
+  END CASE;
+
+  IF (RefSignalName'LENGTH > 0) THEN
+    Write ( Message, STRING'(" WITH RESPECT TO ") );
+    Write ( Message, RefSignalName );
+  END IF;
+
+  Write ( Message, ';' & LF );
+  Write ( Message, STRING'("  Expected := ")  );
+  Write ( Message, CheckInfo.ExpTime);
+  Write ( Message, STRING'("; Observed := ")  );
+  Write ( Message, CheckInfo.ObsTime);
+  Write ( Message, STRING'("; At : ")         );
+  Write ( Message, CheckInfo.DetTime);
+
+  ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity;
+
+  DEALLOCATE (Message);
+END VitalMemoryReportViolation;
+
+-- ----------------------------------------------------------------------------
+FUNCTION VitalMemoryTimingDataInit 
+RETURN VitalMemoryTimingDataType IS
+BEGIN
+  RETURN (FALSE, 'X', 0 ns, FALSE, 'X', 0 ns, FALSE, 
+          NULL, NULL, NULL, NULL, NULL, NULL);
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalSetupHoldCheck
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation     : OUT    X01ArrayT;
+  VARIABLE TimingData    : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal    : IN     std_ulogic;
+  CONSTANT TestSignalName: IN     STRING := "";
+  CONSTANT TestDelay     : IN     TIME := 0 ns;
+  SIGNAL   RefSignal     : IN     std_ulogic;
+  CONSTANT RefSignalName : IN     STRING := "";
+  CONSTANT RefDelay      : IN     TIME := 0 ns;
+  CONSTANT SetupHigh     : IN     VitalDelayType;
+  CONSTANT SetupLow      : IN     VitalDelayType;
+  CONSTANT HoldHigh      : IN     VitalDelayType;
+  CONSTANT HoldLow       : IN     VitalDelayType;
+  CONSTANT CheckEnabled  : IN     VitalBoolArrayT;
+  CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+  CONSTANT HeaderMsg     : IN     STRING := " ";
+  CONSTANT XOn           : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+  --IR252 3/23/98
+  CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE  
+) IS
+  VARIABLE CheckInfo       : CheckInfoType;
+  VARIABLE CheckEnScalar   : BOOLEAN := FALSE;
+  VARIABLE ViolationInt    : X01ArrayT(CheckEnabled'RANGE);
+  VARIABLE RefEdge         : BOOLEAN;
+  VARIABLE TestEvent       : BOOLEAN;
+  VARIABLE TestDly         : TIME := Maximum(0 ns, TestDelay);
+  VARIABLE RefDly          : TIME := Maximum(0 ns, RefDelay);
+  VARIABLE bias            : TIME;
+BEGIN
+
+  -- Initialization of working area. 
+  IF (TimingData.NotFirstFlag = FALSE) THEN
+    TimingData.TestLast     := To_X01(TestSignal);
+    TimingData.RefLast      := To_X01(RefSignal);
+    TimingData.NotFirstFlag := TRUE;
+  END IF;
+
+  -- Detect reference edges and record the time of the last edge
+  RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+               RefTransition);
+  TimingData.RefLast := To_X01(RefSignal);
+  IF (RefEdge) THEN
+    TimingData.RefTime     := NOW;
+    --TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE);
+    --IR252 3/23/98
+    TimingData.SetupEn := TimingData.SetupEn AND EnableSetupOnRef; 
+    TimingData.HoldEn  := EnableHoldOnRef; 
+  END IF;
+
+  -- Detect test (data) changes and record the time of the last change
+  TestEvent := TimingData.TestLast /= To_X01Z(TestSignal);
+  TimingData.TestLast := To_X01Z(TestSignal);
+  IF TestEvent THEN
+    TimingData.SetupEn  := EnableSetupOnTest ; --IR252 3/23/98
+    TimingData.HoldEn := TimingData.HoldEn AND EnableHoldOnTest ;
+                                                --IR252 3/23/98
+    TimingData.TestTime := NOW;
+  END IF;
+
+  FOR i IN CheckEnabled'RANGE LOOP
+    IF CheckEnabled(i) = TRUE THEN
+      CheckEnScalar := TRUE;
+    END IF;
+    ViolationInt(i) := '0'; 
+  END LOOP;
+
+  IF (CheckEnScalar) THEN
+    InternalTimingCheck (
+      TestSignal   => TestSignal,
+      RefSignal    => RefSignal,
+      TestDelay    => TestDly,
+      RefDelay     => RefDly,
+      SetupHigh    => SetupHigh,
+      SetupLow     => SetupLow,
+      HoldHigh     => HoldHigh,
+      HoldLow      => HoldLow,
+      RefTime      => TimingData.RefTime,
+      RefEdge      => RefEdge,
+      TestTime     => TimingData.TestTime,
+      TestEvent    => TestEvent,
+      SetupEn      => TimingData.SetupEn,
+      HoldEn       => TimingData.HoldEn,
+      CheckInfo    => CheckInfo,
+      MsgOn        => MsgOn 
+    );
+
+    -- Report any detected violations and set return violation flag
+    IF CheckInfo.Violation THEN
+      IF (MsgOn) THEN
+        VitalMemoryReportViolation (TestSignalName, RefSignalName,
+          HeaderMsg, CheckInfo, MsgSeverity );
+      END IF;
+      IF (XOn) THEN 
+        FOR i IN CheckEnabled'RANGE LOOP
+          IF CheckEnabled(i) = TRUE THEN
+              ViolationInt(i) := 'X'; 
+          END IF;
+        END LOOP;
+      END IF;
+    END IF;
+  END IF;
+  Violation := ViolationInt;
+END VitalMemorySetupHoldCheck;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation     : OUT    X01ArrayT;
+  VARIABLE TimingData    : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal    : IN     std_logic_vector;
+  CONSTANT TestSignalName: IN     STRING := "";
+  CONSTANT TestDelay     : IN     VitalDelayArraytype;
+  SIGNAL   RefSignal     : IN     std_ulogic;
+  CONSTANT RefSignalName : IN     STRING := "";
+  CONSTANT RefDelay      : IN     TIME := 0 ns;
+  CONSTANT SetupHigh     : IN     VitalDelayArraytype;
+  CONSTANT SetupLow      : IN     VitalDelayArraytype;
+  CONSTANT HoldHigh      : IN     VitalDelayArraytype;
+  CONSTANT HoldLow       : IN     VitalDelayArraytype;
+  CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+  CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+  CONSTANT HeaderMsg     : IN     STRING := " ";
+  CONSTANT XOn           : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat     : IN     VitalMemoryMsgFormatType;
+  --IR252 3/23/98
+  CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE  
+) IS
+  VARIABLE CheckInfo     : CheckInfoType;
+  VARIABLE RefEdge       : BOOLEAN;
+  VARIABLE TestEvent     : VitalBoolArrayT(TestSignal'RANGE);
+  VARIABLE TestDly       : TIME;
+  VARIABLE RefDly        : TIME := Maximum(0 ns, RefDelay);
+  VARIABLE bias          : TIME;
+BEGIN
+
+  -- Initialization of working area. 
+  IF (TimingData.NotFirstFlag = FALSE) THEN
+    TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE);
+    TimingData.TestTimeA := NEW VitalTimeArrayT(TestSignal'RANGE);
+    TimingData.HoldEnA   := NEW VitalBoolArrayT(TestSignal'RANGE);
+    TimingData.SetupEnA  := NEW VitalBoolArrayT(TestSignal'RANGE);
+    FOR i IN TestSignal'RANGE LOOP
+      TimingData.TestLastA(i) := To_X01(TestSignal(i));
+    END LOOP;
+    TimingData.RefLast := To_X01(RefSignal);
+    TimingData.NotFirstFlag := TRUE;
+  END IF;
+
+  -- Detect reference edges and record the time of the last edge
+  RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+               RefTransition);
+  TimingData.RefLast := To_X01(RefSignal);
+  IF (RefEdge) THEN
+    TimingData.RefTime     := NOW;
+    --TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE);
+    --IR252 3/23/98
+    FOR i IN TestSignal'RANGE LOOP
+      TimingData.SetupEnA(i) 
+        := TimingData.SetupEnA(i) AND EnableSetupOnRef; 
+      TimingData.HoldEnA(i)  := EnableHoldOnRef; 
+    END LOOP;
+  END IF;
+
+  -- Detect test (data) changes and record the time of the last change
+  FOR i IN TestSignal'RANGE LOOP
+    TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i));
+    TimingData.TestLastA(i) := To_X01Z(TestSignal(i));
+    IF TestEvent(i) THEN
+      TimingData.SetupEnA(i)  := EnableSetupOnTest ; --IR252 3/23/98
+      TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest ;
+                                                  --IR252 3/23/98
+      TimingData.TestTimeA(i) := NOW;
+      --TimingData.SetupEnA(i)  := TRUE;
+      TimingData.TestTime := NOW;
+    END IF;
+  END LOOP;
+
+  FOR i IN TestSignal'RANGE LOOP
+    Violation(i) := '0';
+
+    IF (CheckEnabled) THEN
+      TestDly := Maximum(0 ns, TestDelay(i));
+      InternalTimingCheck (
+        TestSignal   => TestSignal(i),
+        RefSignal    => RefSignal,
+        TestDelay    => TestDly,
+        RefDelay     => RefDly,
+        SetupHigh    => SetupHigh(i),
+        SetupLow     => SetupLow(i),
+        HoldHigh     => HoldHigh(i),
+        HoldLow      => HoldLow(i),
+        RefTime      => TimingData.RefTime,
+        RefEdge      => RefEdge,
+        TestTime     => TimingData.TestTimeA(i),
+        TestEvent    => TestEvent(i),
+        SetupEn      => TimingData.SetupEnA(i),
+        HoldEn       => TimingData.HoldEnA(i),
+        CheckInfo    => CheckInfo,
+        MsgOn        => MsgOn 
+      );
+
+      -- Report any detected violations and set return violation flag
+      IF CheckInfo.Violation THEN
+        IF (MsgOn) THEN
+          VitalMemoryReportViolation (TestSignalName, RefSignalName, i ,
+            HeaderMsg, CheckInfo, MsgFormat, MsgSeverity );
+        END IF;
+        IF (XOn) THEN
+          Violation(i) := 'X';
+        END IF;
+      END IF;
+    END IF;
+  END LOOP;
+
+END VitalMemorySetupHoldCheck;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation     : OUT    X01ArrayT;
+  VARIABLE TimingData    : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal    : IN     std_logic_vector;
+  CONSTANT TestSignalName: IN     STRING := "";
+  CONSTANT TestDelay     : IN     VitalDelayArraytype;
+  SIGNAL   RefSignal     : IN     std_ulogic;
+  CONSTANT RefSignalName : IN     STRING := "";
+  CONSTANT RefDelay      : IN     TIME := 0 ns;
+  CONSTANT SetupHigh     : IN     VitalDelayArraytype;
+  CONSTANT SetupLow      : IN     VitalDelayArraytype;
+  CONSTANT HoldHigh      : IN     VitalDelayArraytype;
+  CONSTANT HoldLow       : IN     VitalDelayArraytype;
+  CONSTANT CheckEnabled  : IN     VitalBoolArrayT;
+  CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+  CONSTANT ArcType       : IN     VitalMemoryArcType := CrossArc;
+  CONSTANT NumBitsPerSubWord : IN INTEGER := 1;
+  CONSTANT HeaderMsg     : IN     STRING := " ";
+  CONSTANT XOn           : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat     : IN     VitalMemoryMsgFormatType;
+  --IR252 3/23/98
+  CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE  
+) IS
+  VARIABLE CheckInfo       : CheckInfoType;
+  VARIABLE ViolationInt    : X01ArrayT(TestSignal'RANGE);
+  VARIABLE ViolationIntNorm: X01ArrayT(TestSignal'LENGTH-1 downto 0);
+  VARIABLE ViolationNorm   : X01ArrayT(Violation'LENGTH-1 downto 0);
+  VARIABLE CheckEnInt      : VitalBoolArrayT(TestSignal'RANGE);
+  VARIABLE CheckEnIntNorm  : VitalBoolArrayT(TestSignal'LENGTH-1 downto 0);
+  VARIABLE CheckEnScalar   : BOOLEAN := FALSE; --Mem IR 401
+  VARIABLE CheckEnabledNorm: VitalBoolArrayT(CheckEnabled'LENGTH-1 downto 0);
+  VARIABLE RefEdge         : BOOLEAN;
+  VARIABLE TestEvent       : VitalBoolArrayT(TestSignal'RANGE);
+  VARIABLE TestDly         : TIME;
+  VARIABLE RefDly          : TIME := Maximum(0 ns, RefDelay);
+  VARIABLE bias            : TIME;
+BEGIN
+
+  -- Initialization of working area. 
+  IF (TimingData.NotFirstFlag = FALSE) THEN
+    TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE);
+    TimingData.TestTimeA := NEW VitalTimeArrayT(TestSignal'RANGE);
+    TimingData.HoldEnA   := NEW VitalBoolArrayT(TestSignal'RANGE);
+    TimingData.SetupEnA  := NEW VitalBoolArrayT(TestSignal'RANGE);
+    FOR i IN TestSignal'RANGE LOOP
+      TimingData.TestLastA(i) := To_X01(TestSignal(i));
+    END LOOP;
+    TimingData.RefLast := To_X01(RefSignal);
+    TimingData.NotFirstFlag := TRUE;
+  END IF;
+
+  -- Detect reference edges and record the time of the last edge
+  RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+               RefTransition);
+  TimingData.RefLast := To_X01(RefSignal);
+  IF RefEdge THEN
+    TimingData.RefTime     := NOW;
+    --TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE);
+    --IR252 3/23/98
+    FOR i IN TestSignal'RANGE LOOP
+      TimingData.SetupEnA(i) 
+        := TimingData.SetupEnA(i) AND EnableSetupOnRef; 
+      TimingData.HoldEnA(i)  := EnableHoldOnRef; 
+    END LOOP;
+  END IF;
+
+  -- Detect test (data) changes and record the time of the last change
+  FOR i IN TestSignal'RANGE LOOP
+    TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i));
+    TimingData.TestLastA(i) := To_X01Z(TestSignal(i));
+    IF TestEvent(i) THEN
+      TimingData.SetupEnA(i)  := EnableSetupOnTest ; --IR252 3/23/98
+      TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest ;
+                                                  --IR252 3/23/98
+      TimingData.TestTimeA(i) := NOW;
+      --TimingData.SetupEnA(i)  := TRUE;
+      TimingData.TestTime := NOW;
+    END IF;
+  END LOOP;
+
+  IF ArcType = CrossArc THEN
+    CheckEnScalar := FALSE;
+    FOR i IN CheckEnabled'RANGE LOOP
+      IF CheckEnabled(i) = TRUE THEN
+        CheckEnScalar := TRUE;
+      END IF;
+    END LOOP;
+    FOR i IN CheckEnInt'RANGE LOOP
+      CheckEnInt(i) := CheckEnScalar;
+    END LOOP;
+  ELSE
+    FOR i IN CheckEnIntNorm'RANGE LOOP
+      CheckEnIntNorm(i) := CheckEnabledNorm(i / NumBitsPerSubWord );
+    END LOOP;
+    CheckEnInt := CheckEnIntNorm;
+  END IF;
+
+  FOR i IN TestSignal'RANGE LOOP
+    ViolationInt(i) := '0';
+
+    IF (CheckEnInt(i)) THEN
+      TestDly := Maximum(0 ns, TestDelay(i));
+      InternalTimingCheck (
+        TestSignal   => TestSignal(i),
+        RefSignal    => RefSignal,
+        TestDelay    => TestDly,
+        RefDelay     => RefDly,
+        SetupHigh    => SetupHigh(i),
+        SetupLow     => SetupLow(i),
+        HoldHigh     => HoldHigh(i),
+        HoldLow      => HoldLow(i),
+        RefTime      => TimingData.RefTime,
+        RefEdge      => RefEdge,
+        TestTime     => TimingData.TestTimeA(i),
+        TestEvent    => TestEvent(i),
+        SetupEn      => TimingData.SetupEnA(i),
+        HoldEn       => TimingData.HoldEnA(i),
+        CheckInfo    => CheckInfo,
+        MsgOn        => MsgOn 
+      );
+
+      -- Report any detected violations and set return violation flag
+      IF CheckInfo.Violation THEN
+        IF (MsgOn) THEN
+          VitalMemoryReportViolation (TestSignalName, RefSignalName, i ,
+            HeaderMsg, CheckInfo, MsgFormat, MsgSeverity );
+        END IF;
+        IF (XOn) THEN
+          ViolationInt(i) := 'X';
+        END IF;
+      END IF;
+    END IF;
+  END LOOP;
+
+  IF (ViolationInt'LENGTH = Violation'LENGTH) THEN
+    Violation := ViolationInt;
+  ELSE
+    ViolationIntNorm := ViolationInt;
+    FOR i IN ViolationNorm'RANGE LOOP
+      ViolationNorm(i) := '0';
+    END LOOP;
+    FOR i IN ViolationIntNorm'RANGE LOOP
+      IF (ViolationIntNorm(i) = 'X') THEN
+        ViolationNorm(i / NumBitsPerSubWord) := 'X';
+      END IF;
+    END LOOP;
+    Violation := ViolationNorm;
+  END IF;
+
+END VitalMemorySetupHoldCheck;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation     : OUT    X01ArrayT;
+  VARIABLE TimingData    : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal    : IN     std_logic_vector;
+  CONSTANT TestSignalName: IN     STRING := "";
+  CONSTANT TestDelay     : IN     VitalDelayArraytype;
+  SIGNAL   RefSignal     : IN     std_logic_vector;
+  CONSTANT RefSignalName : IN     STRING := "";
+  CONSTANT RefDelay      : IN     VitalDelayArraytype;
+  CONSTANT SetupHigh     : IN     VitalDelayArraytype;
+  CONSTANT SetupLow      : IN     VitalDelayArraytype;
+  CONSTANT HoldHigh      : IN     VitalDelayArraytype;
+  CONSTANT HoldLow       : IN     VitalDelayArraytype;
+  CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+  CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+  CONSTANT ArcType       : IN     VitalMemoryArcType := CrossArc;
+  CONSTANT NumBitsPerSubWord : IN INTEGER := 1;
+  CONSTANT HeaderMsg     : IN     STRING := " ";
+  CONSTANT XOn           : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat     : IN     VitalMemoryMsgFormatType;
+  --IR252 3/23/98
+  CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE;
+  CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE 
+) IS
+  VARIABLE CheckInfo       : CheckInfoType;
+  VARIABLE RefEdge         : VitalBoolArrayT(RefSignal'LENGTH-1 downto 0);
+  VARIABLE TestEvent       : VitalBoolArrayT(TestSignal'LENGTH-1 downto 0);
+  VARIABLE TestDly         : TIME;
+  VARIABLE RefDly          : TIME;
+  VARIABLE bias            : TIME;
+  VARIABLE NumTestBits     : NATURAL := TestSignal'LENGTH;
+  VARIABLE NumRefBits      : NATURAL := RefSignal'LENGTH;
+  VARIABLE NumChecks       : NATURAL;
+
+  VARIABLE ViolationTest   : X01ArrayT(NumTestBits-1 downto 0);
+  VARIABLE ViolationRef    : X01ArrayT(NumRefBits-1 downto 0);
+
+  VARIABLE TestSignalNorm  : std_logic_vector(NumTestBits-1 downto 0)
+                              := TestSignal;
+  VARIABLE TestDelayNorm   : VitalDelayArraytype(NumTestBits-1 downto 0)
+                              := TestDelay;
+  VARIABLE RefSignalNorm   : std_logic_vector(NumRefBits-1 downto 0)
+                              := RefSignal;
+  VARIABLE RefDelayNorm    : VitalDelayArraytype(NumRefBits-1 downto 0)
+                              := RefDelay;
+  VARIABLE SetupHighNorm   : VitalDelayArraytype(SetupHigh'LENGTH-1 downto 0)
+                              := SetupHigh;
+  VARIABLE SetupLowNorm    : VitalDelayArraytype(SetupLow'LENGTH-1 downto 0)
+                              := SetupLow;
+  VARIABLE HoldHighNorm    : VitalDelayArraytype(HoldHigh'LENGTH-1 downto 0)
+                              := HoldHigh;
+  VARIABLE HoldLowNorm     : VitalDelayArraytype(HoldLow'LENGTH-1 downto 0)
+                              := HoldLow;
+
+  VARIABLE RefBitLow       : NATURAL;
+  VARIABLE RefBitHigh      : NATURAL;
+  VARIABLE EnArrayIndex    : NATURAL;
+  VARIABLE TimingArrayIndex: NATURAL;
+BEGIN
+
+  -- Initialization of working area. 
+  IF (TimingData.NotFirstFlag = FALSE) THEN
+    TimingData.TestLastA := NEW std_logic_vector(NumTestBits-1 downto 0);
+    TimingData.TestTimeA := NEW VitalTimeArrayT(NumTestBits-1 downto 0);
+    TimingData.RefTimeA  := NEW VitalTimeArrayT(NumRefBits-1 downto 0);
+    TimingData.RefLastA  := NEW X01ArrayT(NumRefBits-1 downto 0);
+    IF (ArcType = CrossArc) THEN
+      NumChecks := RefSignal'LENGTH * TestSignal'LENGTH;
+    ELSE
+      NumChecks := TestSignal'LENGTH;
+    END IF;
+    TimingData.HoldEnA   := NEW VitalBoolArrayT(NumChecks-1 downto 0);
+    TimingData.SetupEnA  := NEW VitalBoolArrayT(NumChecks-1 downto 0);
+
+    FOR i IN TestSignalNorm'RANGE LOOP
+      TimingData.TestLastA(i) := To_X01(TestSignalNorm(i));
+    END LOOP;
+
+    FOR i IN RefSignalNorm'RANGE LOOP
+      TimingData.RefLastA(i) := To_X01(RefSignalNorm(i));
+    END LOOP;
+    TimingData.NotFirstFlag := TRUE;
+  END IF;
+
+  -- Detect reference edges and record the time of the last edge
+  FOR i IN RefSignalNorm'RANGE LOOP
+    RefEdge(i) := EdgeSymbolMatch(TimingData.RefLastA(i), 
+                  To_X01(RefSignalNorm(i)), RefTransition);
+    TimingData.RefLastA(i) := To_X01(RefSignalNorm(i));
+    IF (RefEdge(i)) THEN
+      TimingData.RefTimeA(i)  := NOW;
+    END IF;
+  END LOOP;
+
+  -- Detect test (data) changes and record the time of the last change
+  FOR i IN TestSignalNorm'RANGE LOOP
+    TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignalNorm(i));
+    TimingData.TestLastA(i) := To_X01Z(TestSignalNorm(i));
+    IF (TestEvent(i)) THEN
+      TimingData.TestTimeA(i) := NOW;
+    END IF;
+  END LOOP;
+
+  FOR i IN ViolationTest'RANGE LOOP
+    ViolationTest(i) := '0'; 
+  END LOOP;
+  FOR i IN ViolationRef'RANGE LOOP
+    ViolationRef(i) := '0'; 
+  END LOOP;
+
+  FOR i IN TestSignalNorm'RANGE LOOP
+    IF (ArcType = CrossArc) THEN
+      FOR j IN RefSignalNorm'RANGE LOOP
+        IF (TestEvent(i)) THEN
+          --TimingData.SetupEnA(i*NumRefBits+j) := TRUE;
+          --IR252
+          TimingData.SetupEnA(i*NumRefBits+j) := EnableSetupOnTest;
+          TimingData.HoldEnA(i*NumRefBits+j) 
+               := TimingData.HoldEnA(i*NumRefBits+j) AND EnableHoldOnTest;
+        END IF;
+        IF (RefEdge(j)) THEN
+          --TimingData.HoldEnA(i*NumRefBits+j) := TRUE;
+          --IR252 
+          TimingData.HoldEnA(i*NumRefBits+j) := EnableHoldOnRef; 
+          TimingData.SetupEnA(i*NumRefBits+j) 
+               := TimingData.SetupEnA(i*NumRefBits+j) AND EnableSetupOnRef;
+        END IF;
+      END LOOP;
+      RefBitLow := 0;
+      RefBitHigh := NumRefBits-1;
+      TimingArrayIndex := i;
+    ELSE
+      IF ArcType = SubwordArc THEN
+        RefBitLow  := i / NumBitsPerSubWord;
+        TimingArrayIndex := i + NumTestBits * RefBitLow;
+      ELSE
+        RefBitLow  := i;
+        TimingArrayIndex := i;
+      END IF;
+      RefBitHigh := RefBitLow;
+      IF TestEvent(i) THEN
+        --TimingData.SetupEnA(i) := TRUE;
+        --IR252
+        TimingData.SetupEnA(i) := EnableSetupOnTest;
+        TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest;
+      END IF;
+      IF RefEdge(RefBitLow) THEN
+        --TimingData.HoldEnA(i) := TRUE;
+        --IR252
+        TimingData.HoldEnA(i) := EnableHoldOnRef;
+        TimingData.SetupEnA(i) := TimingData.SetupEnA(i) AND EnableSetupOnRef;
+      END IF;
+    END IF;
+
+    EnArrayIndex := i;
+    FOR j IN RefBitLow to RefBitHigh LOOP
+
+      IF (CheckEnabled) THEN
+        TestDly := Maximum(0 ns, TestDelayNorm(i));
+        RefDly  := Maximum(0 ns, RefDelayNorm(j));
+
+        InternalTimingCheck (
+          TestSignal   => TestSignalNorm(i),
+          RefSignal    => RefSignalNorm(j),
+          TestDelay    => TestDly,
+          RefDelay     => RefDly,
+          SetupHigh    => SetupHighNorm(TimingArrayIndex),
+          SetupLow     => SetupLowNorm(TimingArrayIndex),
+          HoldHigh     => HoldHighNorm(TimingArrayIndex),
+          HoldLow      => HoldLowNorm(TimingArrayIndex),
+          RefTime      => TimingData.RefTimeA(j),
+          RefEdge      => RefEdge(j),
+          TestTime     => TimingData.TestTimeA(i),
+          TestEvent    => TestEvent(i),
+          SetupEn      => TimingData.SetupEnA(EnArrayIndex),
+          HoldEn       => TimingData.HoldEnA(EnArrayIndex),
+          CheckInfo    => CheckInfo,
+          MsgOn        => MsgOn 
+        );
+
+        -- Report any detected violations and set return violation flag
+        IF (CheckInfo.Violation) THEN
+          IF (MsgOn) THEN
+             VitalMemoryReportViolation (TestSignalName, RefSignalName, i, j,
+                    TestSignal, RefSignal, HeaderMsg, CheckInfo, 
+                    MsgFormat, MsgSeverity );
+          END IF;
+          IF (XOn) THEN
+              ViolationTest(i) := 'X'; 
+              ViolationRef(j) := 'X'; 
+          END IF;
+        END IF;
+      END IF;
+
+      TimingArrayIndex := TimingArrayIndex + NumRefBits;
+      EnArrayIndex    := EnArrayIndex + NumRefBits;
+
+    END LOOP;
+  END LOOP;
+
+  IF (ArcType = CrossArc) THEN
+    Violation := ViolationRef;
+  ELSE
+    IF (Violation'LENGTH = ViolationRef'LENGTH) THEN
+      Violation := ViolationRef;
+    ELSE
+      Violation := ViolationTest;
+    END IF;
+  END IF;
+
+END VitalMemorySetupHoldCheck;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation     : OUT    X01ArrayT;
+  VARIABLE TimingData    : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal    : IN     std_logic_vector;
+  CONSTANT TestSignalName: IN     STRING := "";
+  CONSTANT TestDelay     : IN     VitalDelayArraytype;
+  SIGNAL   RefSignal     : IN     std_logic_vector;
+  CONSTANT RefSignalName : IN     STRING := "";
+  CONSTANT RefDelay      : IN     VitalDelayArraytype;
+  CONSTANT SetupHigh     : IN     VitalDelayArraytype;
+  CONSTANT SetupLow      : IN     VitalDelayArraytype;
+  CONSTANT HoldHigh      : IN     VitalDelayArraytype;
+  CONSTANT HoldLow       : IN     VitalDelayArraytype;
+  CONSTANT CheckEnabled  : IN     VitalBoolArrayT;
+  CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+  CONSTANT ArcType       : IN     VitalMemoryArcType := CrossArc;
+  CONSTANT NumBitsPerSubWord : IN INTEGER := 1;
+  CONSTANT HeaderMsg     : IN     STRING := " ";
+  CONSTANT XOn           : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat     : IN     VitalMemoryMsgFormatType;
+  --IR252 3/23/98
+  CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE;
+  CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE 
+) IS
+
+  VARIABLE CheckInfo       : CheckInfoType;
+  VARIABLE RefEdge         : VitalBoolArrayT(RefSignal'LENGTH-1 downto 0);
+  VARIABLE TestEvent       : VitalBoolArrayT(TestSignal'LENGTH-1 downto 0);
+  VARIABLE TestDly         : TIME;
+  VARIABLE RefDly          : TIME;
+  VARIABLE bias            : TIME;
+  VARIABLE NumTestBits     : NATURAL := TestSignal'LENGTH;
+  VARIABLE NumRefBits      : NATURAL := RefSignal'LENGTH;
+  VARIABLE NumChecks       : NATURAL;
+
+  VARIABLE ViolationTest   : X01ArrayT(NumTestBits-1 downto 0);
+  VARIABLE ViolationRef    : X01ArrayT(NumRefBits-1 downto 0);
+
+  VARIABLE TestSignalNorm  : std_logic_vector(NumTestBits-1 downto 0)
+                              := TestSignal;
+  VARIABLE TestDelayNorm   : VitalDelayArraytype(NumTestBits-1 downto 0)
+                              := TestDelay;
+  VARIABLE RefSignalNorm   : std_logic_vector(NumRefBits-1 downto 0)
+                              := RefSignal;
+  VARIABLE RefDelayNorm    : VitalDelayArraytype(NumRefBits-1 downto 0)
+                              := RefDelay;
+  VARIABLE CheckEnNorm     : VitalBoolArrayT(NumRefBits-1 downto 0)
+                              := CheckEnabled;
+  VARIABLE SetupHighNorm   : VitalDelayArraytype(SetupHigh'LENGTH-1 downto 0)
+                              := SetupHigh;
+  VARIABLE SetupLowNorm    : VitalDelayArraytype(SetupLow'LENGTH-1 downto 0)
+                              := SetupLow;
+  VARIABLE HoldHighNorm    : VitalDelayArraytype(HoldHigh'LENGTH-1 downto 0)
+                              := HoldHigh;
+  VARIABLE HoldLowNorm     : VitalDelayArraytype(HoldLow'LENGTH-1 downto 0)
+                              := HoldLow;
+
+  VARIABLE RefBitLow       : NATURAL;
+  VARIABLE RefBitHigh      : NATURAL;
+  VARIABLE EnArrayIndex    : NATURAL;
+  VARIABLE TimingArrayIndex: NATURAL;
+BEGIN
+
+  -- Initialization of working area. 
+  IF (TimingData.NotFirstFlag = FALSE) THEN
+    TimingData.TestLastA := NEW std_logic_vector(NumTestBits-1 downto 0);
+    TimingData.TestTimeA := NEW VitalTimeArrayT(NumTestBits-1 downto 0);
+    TimingData.RefTimeA  := NEW VitalTimeArrayT(NumRefBits-1 downto 0);
+    TimingData.RefLastA  := NEW X01ArrayT(NumRefBits-1 downto 0);
+    IF ArcType = CrossArc THEN
+      NumChecks := RefSignal'LENGTH * TestSignal'LENGTH;
+    ELSE
+      NumChecks := TestSignal'LENGTH;
+    END IF;
+    TimingData.HoldEnA   := NEW VitalBoolArrayT(NumChecks-1 downto 0);
+    TimingData.SetupEnA  := NEW VitalBoolArrayT(NumChecks-1 downto 0);
+
+    FOR i IN TestSignalNorm'RANGE LOOP
+      TimingData.TestLastA(i) := To_X01(TestSignalNorm(i));
+    END LOOP;
+
+    FOR i IN RefSignalNorm'RANGE LOOP
+      TimingData.RefLastA(i) := To_X01(RefSignalNorm(i));
+    END LOOP;
+    TimingData.NotFirstFlag := TRUE;
+  END IF;
+
+  -- Detect reference edges and record the time of the last edge
+  FOR i IN RefSignalNorm'RANGE LOOP
+    RefEdge(i) := EdgeSymbolMatch(TimingData.RefLastA(i), 
+                  To_X01(RefSignalNorm(i)), RefTransition);
+    TimingData.RefLastA(i) := To_X01(RefSignalNorm(i));
+    IF RefEdge(i) THEN
+      TimingData.RefTimeA(i)  := NOW;
+    END IF;
+  END LOOP;
+
+  -- Detect test (data) changes and record the time of the last change
+  FOR i IN TestSignalNorm'RANGE LOOP
+    TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignalNorm(i));
+    TimingData.TestLastA(i) := To_X01Z(TestSignalNorm(i));
+    IF TestEvent(i) THEN
+      TimingData.TestTimeA(i) := NOW;
+    END IF;
+  END LOOP;
+
+  FOR i IN ViolationTest'RANGE LOOP
+    ViolationTest(i) := '0'; 
+  END LOOP;
+  FOR i IN ViolationRef'RANGE LOOP
+    ViolationRef(i) := '0'; 
+  END LOOP;
+
+  FOR i IN TestSignalNorm'RANGE LOOP
+    IF (ArcType = CrossArc) THEN
+      FOR j IN RefSignalNorm'RANGE LOOP
+        IF (TestEvent(i)) THEN
+          --TimingData.SetupEnA(i*NumRefBits+j) := TRUE;
+          --IR252
+          TimingData.SetupEnA(i*NumRefBits+j) := EnableSetupOnTest;
+          TimingData.HoldEnA(i*NumRefBits+j) 
+               := TimingData.HoldEnA(i*NumRefBits+j) AND EnableHoldOnTest;
+        END IF;
+        IF (RefEdge(j)) THEN
+          --TimingData.HoldEnA(i*NumRefBits+j) := TRUE;
+          --IR252 
+          TimingData.HoldEnA(i*NumRefBits+j) := EnableHoldOnRef; 
+          TimingData.SetupEnA(i*NumRefBits+j) 
+               := TimingData.SetupEnA(i*NumRefBits+j) AND EnableSetupOnRef;
+        END IF;
+      END LOOP;
+      RefBitLow := 0;
+      RefBitHigh := NumRefBits-1;
+      TimingArrayIndex := i;
+    ELSE
+      IF (ArcType = SubwordArc) THEN
+        RefBitLow  := i / NumBitsPerSubWord;
+        TimingArrayIndex := i + NumTestBits * RefBitLow;
+      ELSE
+        RefBitLow  := i;
+        TimingArrayIndex := i;
+      END IF;
+      RefBitHigh := RefBitLow;
+      IF (TestEvent(i)) THEN
+        --TimingData.SetupEnA(i) := TRUE;
+        --IR252
+        TimingData.SetupEnA(i) := EnableSetupOnTest;
+        TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest;
+      END IF;
+      IF (RefEdge(RefBitLow)) THEN
+        --TimingData.HoldEnA(i) := TRUE;
+        --IR252
+        TimingData.HoldEnA(i) := EnableHoldOnRef;
+        TimingData.SetupEnA(i) := TimingData.SetupEnA(i) AND EnableSetupOnRef;
+      END IF;
+    END IF;
+
+    EnArrayIndex := i;
+    FOR j IN RefBitLow to RefBitHigh LOOP
+      IF (CheckEnNorm(j)) THEN
+        TestDly := Maximum(0 ns, TestDelayNorm(i));
+        RefDly  := Maximum(0 ns, RefDelayNorm(j));
+
+        InternalTimingCheck (
+          TestSignal   => TestSignalNorm(i),
+          RefSignal    => RefSignalNorm(j),
+          TestDelay    => TestDly,
+          RefDelay     => RefDly,
+          SetupHigh    => SetupHighNorm(TimingArrayIndex),
+          SetupLow     => SetupLowNorm(TimingArrayIndex),
+          HoldHigh     => HoldHighNorm(TimingArrayIndex),
+          HoldLow      => HoldLowNorm(TimingArrayIndex),
+          RefTime      => TimingData.RefTimeA(j),
+          RefEdge      => RefEdge(j),
+          TestTime     => TimingData.TestTimeA(i),
+          TestEvent    => TestEvent(i),
+          SetupEn      => TimingData.SetupEnA(EnArrayIndex),
+          HoldEn       => TimingData.HoldEnA(EnArrayIndex),
+          CheckInfo    => CheckInfo,
+          MsgOn        => MsgOn 
+        );
+
+        -- Report any detected violations and set return violation flag
+        IF (CheckInfo.Violation) THEN
+          IF (MsgOn) THEN
+            VitalMemoryReportViolation (TestSignalName, RefSignalName, i, j,
+                    TestSignal, RefSignal, HeaderMsg, CheckInfo, 
+                    MsgFormat, MsgSeverity );
+          END IF;
+
+          IF (XOn) THEN
+            ViolationTest(i) := 'X'; 
+            ViolationRef(j) := 'X'; 
+          END IF;
+        END IF;
+      END IF;
+
+      TimingArrayIndex := TimingArrayIndex + NumRefBits;
+      EnArrayIndex    := EnArrayIndex + NumRefBits;
+    END LOOP;
+  END LOOP;
+
+  IF (ArcType = CrossArc) THEN
+    Violation := ViolationRef;
+  ELSE
+    IF (Violation'LENGTH = ViolationRef'LENGTH) THEN
+      Violation := ViolationRef;
+    ELSE
+      Violation := ViolationTest;
+    END IF;
+  END IF;
+
+END VitalMemorySetupHoldCheck;
+
+-- ----------------------------------------------------------------------------
+-- scalar violations not needed 
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation     : OUT    X01;
+  VARIABLE TimingData    : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal    : IN     std_logic_vector;
+  CONSTANT TestSignalName: IN     STRING := "";
+  CONSTANT TestDelay     : IN     VitalDelayArraytype;
+  SIGNAL   RefSignal     : IN     std_ulogic;
+  CONSTANT RefSignalName : IN     STRING := "";
+  CONSTANT RefDelay      : IN     TIME := 0 ns;
+  CONSTANT SetupHigh     : IN     VitalDelayArraytype;
+  CONSTANT SetupLow      : IN     VitalDelayArraytype;
+  CONSTANT HoldHigh      : IN     VitalDelayArraytype;
+  CONSTANT HoldLow       : IN     VitalDelayArraytype;
+  CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+  CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+  CONSTANT HeaderMsg     : IN     STRING := " ";
+  CONSTANT XOn           : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat     : IN     VitalMemoryMsgFormatType;
+  --IR252 3/23/98
+  CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE  
+) IS
+  VARIABLE CheckInfo     : CheckInfoType;
+  VARIABLE RefEdge       : BOOLEAN;
+  VARIABLE TestEvent     : VitalBoolArrayT(TestSignal'RANGE);
+  VARIABLE TestDly       : TIME;
+  VARIABLE RefDly        : TIME := Maximum(0 ns, RefDelay);
+  VARIABLE bias          : TIME;
+
+BEGIN
+
+  -- Initialization of working area. 
+  IF (TimingData.NotFirstFlag = FALSE) THEN
+    TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE);
+    TimingData.TestTimeA := NEW VitalTimeArrayT(TestSignal'RANGE);
+    TimingData.HoldEnA   := NEW VitalBoolArrayT(TestSignal'RANGE);
+    TimingData.SetupEnA  := NEW VitalBoolArrayT(TestSignal'RANGE);
+    FOR i IN TestSignal'RANGE LOOP
+      TimingData.TestLastA(i) := To_X01(TestSignal(i));
+    END LOOP;
+    TimingData.RefLast := To_X01(RefSignal);
+    TimingData.NotFirstFlag := TRUE;
+  END IF;
+
+  -- Detect reference edges and record the time of the last edge
+  RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+               RefTransition);
+  TimingData.RefLast := To_X01(RefSignal);
+  IF (RefEdge) THEN
+    TimingData.RefTime     := NOW;
+    --TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE);
+    --IR252 3/23/98
+    FOR i IN TestSignal'RANGE LOOP
+      TimingData.SetupEnA(i) 
+        := TimingData.SetupEnA(i) AND EnableSetupOnRef; 
+      TimingData.HoldEnA(i)  := EnableHoldOnRef; 
+    END LOOP;
+  END IF;
+
+  -- Detect test (data) changes and record the time of the last change
+  FOR i IN TestSignal'RANGE LOOP
+    TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i));
+    TimingData.TestLastA(i) := To_X01Z(TestSignal(i));
+    IF TestEvent(i) THEN
+      TimingData.SetupEnA(i)  := EnableSetupOnTest ; --IR252 3/23/98
+      TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest ;
+                                                  --IR252 3/23/98
+      TimingData.TestTimeA(i) := NOW;
+      --TimingData.SetupEnA(i)  := TRUE;
+      TimingData.TestTime := NOW;
+    END IF;
+  END LOOP;
+
+  Violation := '0';
+  FOR i IN TestSignal'RANGE LOOP
+    IF (CheckEnabled) THEN
+      TestDly := Maximum(0 ns, TestDelay(i));
+      InternalTimingCheck (
+        TestSignal   => TestSignal(i),
+        RefSignal    => RefSignal,
+        TestDelay    => TestDly,
+        RefDelay     => RefDly,
+        SetupHigh    => SetupHigh(i),
+        SetupLow     => SetupLow(i),
+        HoldHigh     => HoldHigh(i),
+        HoldLow      => HoldLow(i),
+        RefTime      => TimingData.RefTime,
+        RefEdge      => RefEdge,
+        TestTime     => TimingData.TestTimeA(i),
+        TestEvent    => TestEvent(i),
+        SetupEn      => TimingData.SetupEnA(i),
+        HoldEn       => TimingData.HoldEnA(i),
+        CheckInfo    => CheckInfo,
+        MsgOn        => MsgOn 
+      );
+
+      -- Report any detected violations and set return violation flag
+      IF CheckInfo.Violation THEN
+        IF (MsgOn) THEN
+          VitalMemoryReportViolation (TestSignalName, RefSignalName, i ,
+                  HeaderMsg, CheckInfo, MsgFormat, MsgSeverity );
+        END IF;
+        IF (XOn) THEN
+          Violation := 'X';
+        END IF;
+      END IF;
+    END IF;
+  END LOOP;
+
+END VitalMemorySetupHoldCheck;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation     : OUT    X01;
+  VARIABLE TimingData    : INOUT  VitalMemoryTimingDataType;            
+  SIGNAL   TestSignal    : IN     std_logic_vector;
+  CONSTANT TestSignalName: IN     STRING := "";
+  CONSTANT TestDelay     : IN     VitalDelayArraytype;
+  SIGNAL   RefSignal     : IN     std_logic_vector;
+  CONSTANT RefSignalName : IN     STRING := "";
+  CONSTANT RefDelay      : IN     VitalDelayArraytype;
+  CONSTANT SetupHigh     : IN     VitalDelayArraytype;
+  CONSTANT SetupLow      : IN     VitalDelayArraytype;
+  CONSTANT HoldHigh      : IN     VitalDelayArraytype;
+  CONSTANT HoldLow       : IN     VitalDelayArraytype;
+  CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+  CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+  CONSTANT HeaderMsg     : IN     STRING := " ";
+  CONSTANT XOn           : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT ArcType       : IN     VitalMemoryArcType := CrossArc;
+  CONSTANT NumBitsPerSubWord : IN INTEGER := 1;
+  CONSTANT MsgFormat     : IN     VitalMemoryMsgFormatType;
+  --IR252 3/23/98
+  CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE;
+  CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE 
+) IS
+  VARIABLE CheckInfo       : CheckInfoType;
+  VARIABLE RefEdge         : VitalBoolArrayT(RefSignal'LENGTH-1 downto 0);
+  VARIABLE TestEvent       : VitalBoolArrayT(TestSignal'LENGTH-1 downto 0);
+  VARIABLE TestDly         : TIME;
+  VARIABLE RefDly          : TIME;
+  VARIABLE bias            : TIME;
+  VARIABLE NumTestBits     : NATURAL := TestSignal'LENGTH;
+  VARIABLE NumRefBits      : NATURAL := RefSignal'LENGTH;
+  VARIABLE NumChecks       : NATURAL;
+
+  VARIABLE TestSignalNorm  : std_logic_vector(NumTestBits-1 downto 0)
+                              := TestSignal;
+  VARIABLE TestDelayNorm   : VitalDelayArraytype(NumTestBits-1 downto 0)
+                              := TestDelay;
+  VARIABLE RefSignalNorm   : std_logic_vector(NumRefBits-1 downto 0)
+                              := RefSignal;
+  VARIABLE RefDelayNorm    : VitalDelayArraytype(NumRefBits-1 downto 0)
+                              := RefDelay;
+  VARIABLE SetupHighNorm   : VitalDelayArraytype(SetupHigh'LENGTH-1 downto 0)
+                              := SetupHigh;
+  VARIABLE SetupLowNorm    : VitalDelayArraytype(SetupLow'LENGTH-1 downto 0)
+                              := SetupLow;
+  VARIABLE HoldHighNorm    : VitalDelayArraytype(HoldHigh'LENGTH-1 downto 0)
+                              := HoldHigh;
+  VARIABLE HoldLowNorm     : VitalDelayArraytype(HoldLow'LENGTH-1 downto 0)
+                              := HoldLow;
+
+  VARIABLE RefBitLow       : NATURAL;
+  VARIABLE RefBitHigh      : NATURAL;
+  VARIABLE EnArrayIndex    : NATURAL;
+  VARIABLE TimingArrayIndex: NATURAL;
+BEGIN
+
+  -- Initialization of working area. 
+  IF (TimingData.NotFirstFlag = FALSE) THEN
+    TimingData.TestLastA := NEW std_logic_vector(NumTestBits-1 downto 0);
+    TimingData.TestTimeA := NEW VitalTimeArrayT(NumTestBits-1 downto 0);
+    TimingData.RefTimeA  := NEW VitalTimeArrayT(NumRefBits-1 downto 0);
+    TimingData.RefLastA  := NEW X01ArrayT(NumRefBits-1 downto 0);
+    IF (ArcType = CrossArc) THEN
+      NumChecks := RefSignal'LENGTH * TestSignal'LENGTH;
+    ELSE
+      NumChecks := TestSignal'LENGTH;
+    END IF;
+    TimingData.HoldEnA   := NEW VitalBoolArrayT(NumChecks-1 downto 0);
+    TimingData.SetupEnA  := NEW VitalBoolArrayT(NumChecks-1 downto 0);
+
+    FOR i IN TestSignalNorm'RANGE LOOP
+      TimingData.TestLastA(i) := To_X01(TestSignalNorm(i));
+    END LOOP;
+
+    FOR i IN RefSignalNorm'RANGE LOOP
+      TimingData.RefLastA(i) := To_X01(RefSignalNorm(i));
+    END LOOP;
+    TimingData.NotFirstFlag := TRUE;
+  END IF;
+
+  -- Detect reference edges and record the time of the last edge
+  FOR i IN RefSignalNorm'RANGE LOOP
+    RefEdge(i) := EdgeSymbolMatch(TimingData.RefLastA(i), 
+                  To_X01(RefSignalNorm(i)), RefTransition);
+    TimingData.RefLastA(i) := To_X01(RefSignalNorm(i));
+    IF (RefEdge(i)) THEN
+      TimingData.RefTimeA(i)  := NOW;
+    END IF;
+  END LOOP;
+
+  -- Detect test (data) changes and record the time of the last change
+  FOR i IN TestSignalNorm'RANGE LOOP
+    TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignalNorm(i));
+    TimingData.TestLastA(i) := To_X01Z(TestSignalNorm(i));
+    IF (TestEvent(i)) THEN
+      TimingData.TestTimeA(i) := NOW;
+    END IF;
+  END LOOP;
+
+  FOR i IN TestSignalNorm'RANGE LOOP
+    IF (ArcType = CrossArc) THEN
+      FOR j IN RefSignalNorm'RANGE LOOP
+        IF (TestEvent(i)) THEN
+          --TimingData.SetupEnA(i*NumRefBits+j) := TRUE;
+          --IR252
+          TimingData.SetupEnA(i*NumRefBits+j) := EnableSetupOnTest;
+          TimingData.HoldEnA(i*NumRefBits+j) 
+                 := TimingData.HoldEnA(i*NumRefBits+j) AND EnableHoldOnTest;
+        END IF;
+        IF (RefEdge(j)) THEN
+          --TimingData.HoldEnA(i*NumRefBits+j) := TRUE;
+          --IR252 
+          TimingData.HoldEnA(i*NumRefBits+j) := EnableHoldOnRef; 
+          TimingData.SetupEnA(i*NumRefBits+j) 
+                 := TimingData.SetupEnA(i*NumRefBits+j) AND EnableSetupOnRef;
+        END IF;
+      END LOOP;
+      RefBitLow := 0;
+      RefBitHigh := NumRefBits-1;
+      TimingArrayIndex := i;
+    ELSE
+      IF (ArcType = SubwordArc) THEN
+        RefBitLow  := i / NumBitsPerSubWord;
+        TimingArrayIndex := i + NumTestBits * RefBitLow;
+      ELSE
+        RefBitLow  := i;
+        TimingArrayIndex := i;
+      END IF;
+      RefBitHigh := RefBitLow;
+      IF (TestEvent(i)) THEN
+        --TimingData.SetupEnA(i) := TRUE;
+        --IR252
+        TimingData.SetupEnA(i) := EnableSetupOnTest;
+        TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest;
+      END IF;
+      IF (RefEdge(RefBitLow)) THEN
+        --TimingData.HoldEnA(i) := TRUE;
+        --IR252
+        TimingData.HoldEnA(i) := EnableHoldOnRef;
+        TimingData.SetupEnA(i) := TimingData.SetupEnA(i) AND EnableSetupOnRef;
+      END IF;
+    END IF;
+
+    EnArrayIndex := i;
+    Violation := '0';
+    FOR j IN RefBitLow to RefBitHigh LOOP
+
+      IF (CheckEnabled) THEN
+        TestDly := Maximum(0 ns, TestDelayNorm(i));
+        RefDly  := Maximum(0 ns, RefDelayNorm(j));
+
+        InternalTimingCheck (
+          TestSignal   => TestSignalNorm(i),
+          RefSignal    => RefSignalNorm(j),
+          TestDelay    => TestDly,
+          RefDelay     => RefDly,
+          SetupHigh    => SetupHighNorm(TimingArrayIndex),
+          SetupLow     => SetupLowNorm(TimingArrayIndex),
+          HoldHigh     => HoldHighNorm(TimingArrayIndex),
+          HoldLow      => HoldLowNorm(TimingArrayIndex),
+          RefTime      => TimingData.RefTimeA(j),
+          RefEdge      => RefEdge(j),
+          TestTime     => TimingData.TestTimeA(i),
+          TestEvent    => TestEvent(i),
+          SetupEn      => TimingData.SetupEnA(EnArrayIndex),
+          HoldEn       => TimingData.HoldEnA(EnArrayIndex),
+          CheckInfo    => CheckInfo,
+          MsgOn        => MsgOn 
+        );
+
+        -- Report any detected violations and set return violation flag
+        IF (CheckInfo.Violation) THEN
+          IF (MsgOn) THEN
+            VitalMemoryReportViolation (TestSignalName, RefSignalName, i, j,
+                    TestSignal, RefSignal, HeaderMsg, CheckInfo, 
+                    MsgFormat, MsgSeverity );
+          END IF;
+
+          IF (XOn) THEN
+            Violation := 'X'; 
+          END IF;
+        END IF;
+      END IF;
+
+      TimingArrayIndex := TimingArrayIndex + NumRefBits;
+      EnArrayIndex    := EnArrayIndex + NumRefBits;
+
+    END LOOP;
+  END LOOP;
+
+END VitalMemorySetupHoldCheck;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE  VitalMemoryPeriodPulseCheck  (
+  VARIABLE Violation      : OUT   X01; 
+  VARIABLE PeriodData     : INOUT VitalPeriodDataArrayType;
+  SIGNAL   TestSignal     : IN    std_logic_vector;
+  CONSTANT TestSignalName : IN    STRING := "";
+  CONSTANT TestDelay      : IN    VitalDelayArraytype;
+  CONSTANT Period         : IN    VitalDelayArraytype;
+  CONSTANT PulseWidthHigh : IN    VitalDelayArraytype;
+  CONSTANT PulseWidthLow  : IN    VitalDelayArraytype;
+  CONSTANT CheckEnabled   : IN    BOOLEAN := TRUE;
+  CONSTANT HeaderMsg      : IN    STRING := " ";
+  CONSTANT XOn            : IN    BOOLEAN := TRUE;
+  CONSTANT MsgOn          : IN    BOOLEAN := TRUE;
+  CONSTANT MsgSeverity    : IN    SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat      : IN    VitalMemoryMsgFormatType
+) IS
+  VARIABLE TestDly   : VitalDelayType;
+  VARIABLE CheckInfo : CheckInfoType;
+  VARIABLE PeriodObs : VitalDelayType;
+  VARIABLE PulseTest : BOOLEAN;
+  VARIABLE PeriodTest: BOOLEAN;
+  VARIABLE TestValue : X01;
+BEGIN
+
+    -- Initialize for no violation
+    Violation := '0';  --MEM IR 402
+
+  FOR i IN TestSignal'RANGE LOOP
+    TestDly := Maximum(0 ns, TestDelay(i));
+    TestValue := To_X01(TestSignal(i));
+
+    IF (PeriodData(i).NotFirstFlag = FALSE) THEN
+      PeriodData(i).Rise := -Maximum(Period(i), 
+          Maximum(PulseWidthHigh(i),PulseWidthLow(i)));
+      PeriodData(i).Fall := -Maximum(Period(i), 
+          Maximum(PulseWidthHigh(i),PulseWidthLow(i)));
+      PeriodData(i).Last := TestValue;
+      PeriodData(i).NotFirstFlag := TRUE;
+    END IF;
+
+    -- Initialize for no violation
+  --  Violation := '0'; --Mem IR 402
+
+    -- No violation possible if no test signal change
+    NEXT WHEN (PeriodData(i).Last = TestValue);
+
+    -- record starting pulse times
+    IF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'P')) THEN
+      -- Compute period times, then record the High Rise Time
+      PeriodObs := NOW - PeriodData(i).Rise;
+      PeriodData(i).Rise := NOW;
+      PeriodTest := TRUE;
+    ELSIF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'N')) THEN
+      -- Compute period times, then record the Low Fall Time
+      PeriodObs := NOW - PeriodData(i).Fall;
+      PeriodData(i).Fall := NOW;
+      PeriodTest := TRUE;
+    ELSE
+      PeriodTest := FALSE;
+    END IF;
+
+    -- do checks on pulse ends
+    IF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'p')) THEN
+      -- Compute pulse times
+      CheckInfo.ObsTime := NOW - PeriodData(i).Fall;
+      CheckInfo.ExpTime := PulseWidthLow(i);
+      PulseTest := TRUE;
+    ELSIF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'n')) THEN
+      -- Compute pulse times
+      CheckInfo.ObsTime := NOW - PeriodData(i).Rise;
+      CheckInfo.ExpTime := PulseWidthHigh(i);
+      PulseTest := TRUE;
+    ELSE
+      PulseTest := FALSE;
+    END IF;
+
+    IF (PulseTest AND CheckEnabled) THEN
+      -- Verify Pulse Width [ignore 1st edge]
+      IF (CheckInfo.ObsTime < CheckInfo.ExpTime) THEN
+        IF (XOn) THEN 
+         Violation := 'X';
+        END IF;
+        IF (MsgOn) THEN
+          CheckInfo.Violation := TRUE;
+          CheckInfo.CheckKind := PulseWidCheck;
+          CheckInfo.DetTime   := NOW - TestDly;
+          CheckInfo.State     := PeriodData(i).Last;
+          VitalMemoryReportViolation (TestSignalName, "", i, 
+               HeaderMsg, CheckInfo, MsgFormat, MsgSeverity );
+        END IF; -- MsgOn
+      END IF;
+    END IF;
+
+    IF (PeriodTest AND CheckEnabled) THEN
+      -- Verify the Period [ignore 1st edge]
+      CheckInfo.ObsTime := PeriodObs;
+      CheckInfo.ExpTime := Period(i);
+      IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN
+        IF (XOn) THEN 
+          Violation := 'X'; 
+        END IF;
+        IF (MsgOn) THEN
+          CheckInfo.Violation := TRUE;
+          CheckInfo.CheckKind := PeriodCheck;
+          CheckInfo.DetTime   := NOW - TestDly;
+          CheckInfo.State     := TestValue;
+          VitalMemoryReportViolation (TestSignalName, "", i,
+               HeaderMsg, CheckInfo, MsgFormat, MsgSeverity );
+        END IF; -- MsgOn
+      END IF;
+    END IF;
+
+    PeriodData(i).Last := TestValue;
+  END LOOP;
+
+END VitalMemoryPeriodPulseCheck;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE  VitalMemoryPeriodPulseCheck  (
+  VARIABLE Violation      : OUT   X01ArrayT; 
+  VARIABLE PeriodData     : INOUT VitalPeriodDataArrayType; 
+  SIGNAL   TestSignal     : IN    std_logic_vector;
+  CONSTANT TestSignalName : IN    STRING := "";
+  CONSTANT TestDelay      : IN    VitalDelayArraytype;
+  CONSTANT Period         : IN    VitalDelayArraytype;
+  CONSTANT PulseWidthHigh : IN    VitalDelayArraytype;
+  CONSTANT PulseWidthLow  : IN    VitalDelayArraytype;
+  CONSTANT CheckEnabled   : IN    BOOLEAN := TRUE;
+  CONSTANT HeaderMsg      : IN    STRING := " ";
+  CONSTANT XOn            : IN    BOOLEAN := TRUE;
+  CONSTANT MsgOn          : IN    BOOLEAN := TRUE;
+  CONSTANT MsgSeverity    : IN    SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat      : IN    VitalMemoryMsgFormatType
+)IS
+  VARIABLE TestDly   : VitalDelayType;
+  VARIABLE CheckInfo : CheckInfoType;
+  VARIABLE PeriodObs : VitalDelayType;
+  VARIABLE PulseTest : BOOLEAN;
+  VARIABLE PeriodTest: BOOLEAN;
+  VARIABLE TestValue : X01;
+BEGIN
+
+  FOR i IN TestSignal'RANGE LOOP
+    TestDly := Maximum(0 ns, TestDelay(i));
+    TestValue := To_X01(TestSignal(i));
+
+    IF (PeriodData(i).NotFirstFlag = FALSE) THEN
+      PeriodData(i).Rise := -Maximum(Period(i), 
+          Maximum(PulseWidthHigh(i),PulseWidthLow(i)));
+      PeriodData(i).Fall := -Maximum(Period(i), 
+          Maximum(PulseWidthHigh(i),PulseWidthLow(i)));
+      PeriodData(i).Last := TestValue;
+      PeriodData(i).NotFirstFlag := TRUE;
+    END IF;
+
+    -- Initialize for no violation
+    Violation(i) := '0';
+
+    -- No violation possible if no test signal change
+    NEXT WHEN (PeriodData(i).Last = TestValue);
+
+    -- record starting pulse times
+    IF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'P')) THEN
+      -- Compute period times, then record the High Rise Time
+      PeriodObs := NOW - PeriodData(i).Rise;
+      PeriodData(i).Rise := NOW;
+      PeriodTest := TRUE;
+    ELSIF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'N')) THEN
+      -- Compute period times, then record the Low Fall Time
+      PeriodObs := NOW - PeriodData(i).Fall;
+      PeriodData(i).Fall := NOW;
+      PeriodTest := TRUE;
+    ELSE
+      PeriodTest := FALSE;
+    END IF;
+
+    -- do checks on pulse ends
+    IF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'p')) THEN
+      -- Compute pulse times
+      CheckInfo.ObsTime := NOW - PeriodData(i).Fall;
+      CheckInfo.ExpTime := PulseWidthLow(i);
+      PulseTest := TRUE;
+    ELSIF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'n')) THEN
+      -- Compute pulse times
+      CheckInfo.ObsTime := NOW - PeriodData(i).Rise;
+      CheckInfo.ExpTime := PulseWidthHigh(i);
+      PulseTest := TRUE;
+    ELSE
+      PulseTest := FALSE;
+    END IF;
+
+    IF (PulseTest AND CheckEnabled) THEN
+      -- Verify Pulse Width [ignore 1st edge]
+      IF (CheckInfo.ObsTime < CheckInfo.ExpTime) THEN
+        IF (XOn) THEN 
+          Violation(i) := 'X';
+        END IF;
+        IF (MsgOn) THEN
+          CheckInfo.Violation := TRUE;
+          CheckInfo.CheckKind := PulseWidCheck;
+          CheckInfo.DetTime   := NOW - TestDly;
+          CheckInfo.State     := PeriodData(i).Last;
+          VitalMemoryReportViolation (TestSignalName, "", i, 
+              HeaderMsg, CheckInfo, MsgFormat, MsgSeverity );
+        END IF; -- MsgOn
+      END IF;
+    END IF;
+
+    IF (PeriodTest AND CheckEnabled) THEN
+      -- Verify the Period [ignore 1st edge]
+      CheckInfo.ObsTime := PeriodObs;
+      CheckInfo.ExpTime := Period(i);
+      IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN
+        IF (XOn) THEN 
+          Violation(i) := 'X'; 
+        END IF;
+        IF (MsgOn) THEN
+          CheckInfo.Violation := TRUE;
+          CheckInfo.CheckKind := PeriodCheck;
+          CheckInfo.DetTime   := NOW - TestDly;
+          CheckInfo.State     := TestValue;
+          VitalMemoryReportViolation (TestSignalName, "", i,
+              HeaderMsg, CheckInfo, MsgFOrmat, MsgSeverity );
+        END IF; -- MsgOn
+      END IF;
+    END IF;
+
+    PeriodData(i).Last := TestValue;
+  END LOOP;
+
+END VitalMemoryPeriodPulseCheck;
+
+-- ----------------------------------------------------------------------------
+-- Functionality Section
+-- ----------------------------------------------------------------------------
+
+-- Look-up table.  Given an int, we can get the 4-bit bit_vector.
+TYPE HexToBitvTableType IS  ARRAY (NATURAL RANGE <>) OF 
+  std_logic_vector(3 DOWNTO 0) ;
+
+CONSTANT HexToBitvTable : HexToBitvTableType (0 TO 15) :=
+  (
+    "0000", "0001", "0010", "0011",
+    "0100", "0101", "0110", "0111",
+    "1000", "1001", "1010", "1011",
+    "1100", "1101", "1110", "1111"
+  ) ;
+
+-- ----------------------------------------------------------------------------
+-- Misc Utilities Local Utilities
+-- ----------------------------------------------------------------------------
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   IsSpace
+-- Parameters:  ch      -- input character
+-- Description: Returns TRUE or FALSE depending on the input character
+--              being white space or not.
+-- ----------------------------------------------------------------------------
+FUNCTION IsSpace (ch : character) 
+RETURN boolean IS
+BEGIN
+  RETURN ((ch = ' ') OR (ch = CR) OR (ch = HT) OR (ch = NUL));
+END IsSpace;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   LenOfString
+-- Parameters:  Str         -- input string
+-- Description: Returns the NATURAL length of the input string.
+--              as terminated by the first NUL character.
+-- ----------------------------------------------------------------------------
+FUNCTION LenOfString (Str : STRING) 
+RETURN NATURAL IS
+  VARIABLE StrRight : NATURAL;
+BEGIN
+  StrRight := Str'RIGHT;
+  FOR i IN Str'RANGE LOOP
+    IF (Str(i) = NUL) THEN
+      StrRight := i - 1;
+      EXIT;
+    END IF;
+  END LOOP;
+  RETURN (StrRight);
+END LenOfString;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   HexToInt
+-- Parameters:  Hex         -- input character or string
+-- Description: Converts input character or string interpreted as a
+--              hexadecimal representation to integer value.
+-- ----------------------------------------------------------------------------
+FUNCTION HexToInt(Hex : CHARACTER) RETURN INTEGER IS
+  CONSTANT HexChars : STRING := "0123456789ABCDEFabcdef";
+  CONSTANT XHiChar  : CHARACTER := 'X';
+  CONSTANT XLoChar  : CHARACTER := 'x';
+BEGIN
+  IF (Hex = XLoChar OR Hex = XHiChar) THEN
+    RETURN (23);
+  END IF;
+  FOR i IN 1 TO 16 LOOP
+    IF(Hex = HexChars(i)) THEN
+      RETURN (i-1);
+    END IF;
+  END LOOP;
+  FOR i IN 17 TO 22 LOOP
+    IF (Hex = HexChars(i)) THEN
+      RETURN (i-7);
+    END IF;
+  END LOOP;
+  ASSERT FALSE REPORT
+    "Invalid character received by HexToInt function"
+    SEVERITY WARNING;
+  RETURN (0);
+END HexToInt;
+
+-- ----------------------------------------------------------------------------
+FUNCTION HexToInt (Hex : STRING) RETURN INTEGER IS
+  VARIABLE Value  : INTEGER := 0;
+  VARIABLE Length : INTEGER;
+BEGIN
+  Length := LenOfString(hex);
+  IF (Length > 8) THEN
+    ASSERT FALSE REPORT
+      "Invalid string length received by HexToInt function"
+      SEVERITY WARNING;
+  ELSE
+    FOR i IN 1 TO Length LOOP
+      Value := Value + HexToInt(Hex(i)) * 16 ** (Length - i);
+    END LOOP;
+  END IF;
+  RETURN (Value);
+END HexToInt;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   HexToBitv
+-- Parameters:  Hex         -- Input hex string
+-- Description: Converts input hex string to a std_logic_vector 
+-- ----------------------------------------------------------------------------
+FUNCTION HexToBitv( 
+  Hex     : STRING
+) RETURN std_logic_vector is
+  VARIABLE   Index       : INTEGER := 0 ;
+  VARIABLE   ValHexToInt : INTEGER ;
+  VARIABLE   BitsPerHex  : INTEGER := 4 ; -- Denotes no. of bits per hex char.
+  VARIABLE   HexLen      : NATURAL := (BitsPerHex * LenOfString(Hex)) ;
+  VARIABLE   TableVal    : std_logic_vector(3 DOWNTO 0) ;  
+  VARIABLE   Result      : std_logic_vector(HexLen-1 DOWNTO 0) ;
+BEGIN
+  --  Assign 4-bit wide bit vector to result directly from a look-up table.
+  Index := 0 ;
+  WHILE ( Index < HexLen )  LOOP
+    ValHexToInt := HexToInt( Hex((HexLen - Index)/BitsPerHex ) );
+    IF ( ValHexToInt = 23 ) THEN
+      TableVal := "XXXX";
+    ELSE
+      -- Look up from the table.
+      TableVal := HexToBitvTable( ValHexToInt ) ;
+    END IF;
+    -- Assign now.
+    Result(Index+3 DOWNTO Index) := TableVal ;
+    -- Get ready for next block of 4-bits.
+    Index := Index + 4 ;
+  END LOOP ;
+  RETURN Result ;
+END HexToBitv ;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   BinToBitv
+-- Parameters:  Bin         -- Input bin string
+-- Description: Converts input bin string to a std_logic_vector 
+-- ----------------------------------------------------------------------------
+FUNCTION BinToBitv( 
+  Bin     : STRING
+) RETURN std_logic_vector is
+  VARIABLE   Index        : INTEGER := 0 ;
+  VARIABLE   Length       : NATURAL := LenOfString(Bin);
+  VARIABLE   BitVal       : std_ulogic;
+  VARIABLE   Result       : std_logic_vector(Length-1 DOWNTO 0) ;  
+BEGIN
+  Index := 0 ;
+  WHILE ( Index < Length )  LOOP
+    IF (Bin(Length-Index) = '0') THEN
+      BitVal := '0';
+    ELSIF (Bin(Length-Index) = '1') THEN
+      BitVal := '1';
+    ELSE
+      BitVal := 'X';
+    END IF ;
+    -- Assign now.
+    Result(Index) := BitVal ;
+    Index := Index + 1 ;
+  END LOOP ;
+  RETURN Result ;
+END BinToBitv ;
+
+-- ----------------------------------------------------------------------------
+-- For Memory Table Modeling
+-- ----------------------------------------------------------------------------
+
+TYPE To_MemoryCharType IS ARRAY (VitalMemorySymbolType) OF CHARACTER;
+CONSTANT To_MemoryChar : To_MemoryCharType :=
+  ( '/', '\', 'P', 'N', 'r', 'f', 'p', 'n', 'R', 'F', '^', 'v',
+    'E', 'A', 'D', '*', 'X', '0', '1', '-', 'B', 'Z', 'S',
+    'g', 'u', 'i', 'G', 'U', 'I', 
+    'w', 's',
+    'c', 'l', 'd', 'e', 'C', 'L',
+    'M', 'm', 't' );
+
+TYPE ValidMemoryTableInputType IS ARRAY (VitalMemorySymbolType) OF BOOLEAN;
+CONSTANT ValidMemoryTableInput : ValidMemoryTableInputType :=
+    -- '/',   '\',   'P',   'N',   'r',   'f',
+  (   TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,
+    -- 'p',   'n',   'R',   'F',   '^',   'v',
+      TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,
+    -- 'E',   'A',    'D',  '*',
+      TRUE,  TRUE,  TRUE,  TRUE,
+    -- 'X',   '0',   '1',   '-',   'B',   'Z',
+      TRUE,  TRUE,  TRUE,  TRUE,  TRUE, FALSE,
+    -- 'S',
+      TRUE, 
+    -- 'g',   'u',   'i',   'G',   'U',   'I', 
+      FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+    -- 'w',   's',
+      FALSE, FALSE, 
+    -- 'c',   'l',   'd',   'e',   'C',   'L',  
+      FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+  -- 'M',   'm',   't' 
+      FALSE, FALSE, FALSE);
+
+TYPE MemoryTableMatchType IS ARRAY (X01,X01,VitalMemorySymbolType) OF BOOLEAN;
+-- last value, present value, table symbol
+CONSTANT MemoryTableMatch : MemoryTableMatchType :=  (
+  ( -- X (lastvalue)
+    -- /     \     P     N     r     f
+    -- p     n     R     F     ^     v
+    -- E     A     D     *
+    -- X     0     1     -     B     Z     S
+    -- g     u     i     G     U     I  
+    -- w     s
+    -- c     l     d     e,    C     L
+    -- m     t 
+    ( FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,
+      TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE),
+    ( FALSE,FALSE,FALSE,TRUE, FALSE,FALSE,
+      FALSE,FALSE,FALSE,TRUE, FALSE,TRUE,
+      TRUE, FALSE,TRUE, TRUE,
+      FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE),
+    ( FALSE,FALSE,TRUE, FALSE,FALSE,FALSE,
+      FALSE,FALSE,TRUE, FALSE,TRUE, FALSE,
+      TRUE, TRUE, FALSE,TRUE,
+      FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE)
+    ),
+
+    (-- 0 (lastvalue)
+    -- /     \     P     N     r     f
+    -- p     n     R     F     ^     v
+    -- E     A     D     *
+    -- X     0     1     -     B     Z     S
+    -- g     u     i     G     U     I  
+    -- w     s
+    -- c     l     d     e,    C     L 
+    -- m     t 
+    ( FALSE,FALSE,FALSE,FALSE,TRUE, FALSE,
+      TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+      FALSE,TRUE, FALSE,TRUE,
+      TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE),
+    ( FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,
+      FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,TRUE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE),
+    ( TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+      TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,TRUE,
+      FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE)
+    ),
+
+    (-- 1 (lastvalue)
+    -- /     \     P     N     r     f
+    -- p     n     R     F     ^     v
+    -- E     A     D     *
+    -- X     0     1     -     B     Z     S
+    -- g     u     i     G     U     I  
+    -- w     s
+    -- c     l     d     e,    C     L
+    -- m     t 
+    ( FALSE,FALSE,FALSE,FALSE,FALSE,TRUE ,
+      FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+      FALSE,FALSE,TRUE, TRUE,
+      TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE),
+    ( FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+      FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+      FALSE,FALSE,FALSE,TRUE,
+      FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE),
+    ( FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,TRUE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,
+      FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+      FALSE,FALSE,FALSE)
+    )
+  );
+
+
+-- ----------------------------------------------------------------------------
+-- Error Message Types and Tables
+-- ----------------------------------------------------------------------------
+
+TYPE VitalMemoryErrorType IS (
+  ErrGoodAddr,   -- 'g' Good address (no transition)
+  ErrUnknAddr,   -- 'u' 'X' levels in address (no transition)
+  ErrInvaAddr,   -- 'i' Invalid address (no transition)
+  ErrGoodTrAddr, -- 'G' Good address (with transition)
+  ErrUnknTrAddr, -- 'U' 'X' levels in address (with transition)
+  ErrInvaTrAddr, -- 'I' Invalid address (with transition)
+  ErrWrDatMem,   -- 'w' Writing data to memory
+  ErrNoChgMem,   -- 's' Retaining previous memory contents
+  ErrCrAllMem,   -- 'c' Corrupting entire memory with 'X'
+  ErrCrWrdMem,   -- 'l' Corrupting a word in memory with 'X'
+  ErrCrBitMem,   -- 'd' Corrupting a single bit in memory with 'X'
+  ErrCrDatMem,   -- 'e' Corrupting a word with 'X' based on data in
+  ErrCrAllSubMem,-- 'C' Corrupting a sub-word entire memory with 'X'
+  ErrCrWrdSubMem,-- 'L' Corrupting a sub-word in memory with 'X'
+  ErrCrBitSubMem,-- 'D' Corrupting a single bit of a memory sub-word with 'X'
+  ErrCrDatSubMem,-- 'E' Corrupting a sub-word with 'X' based on data in
+  ErrCrWrdOut,   -- 'l' Corrupting data out with 'X'
+  ErrCrBitOut,   -- 'd' Corrupting a single bit of data out with 'X'
+  ErrCrDatOut,   -- 'e' Corrupting data out with 'X' based on data in
+  ErrCrWrdSubOut,-- 'L' Corrupting data out sub-word with 'X'
+  ErrCrBitSubOut,-- 'D' Corrupting a single bit of data out sub-word with 'X'
+  ErrCrDatSubOut,-- 'E' Corrupting data out sub-word with 'X' based on data in
+  ErrImplOut,    -- 'M' Implicit read from memory to data out
+  ErrReadOut,    -- 'm' Reading data from memory to data out
+  ErrAssgOut,    -- 't' Transfering from data in to data out
+  ErrAsgXOut,    -- 'X' Assigning unknown level to data out
+  ErrAsg0Out,    -- '0' Assigning low level to data out
+  ErrAsg1Out,    -- '1' Assigning high level to data out
+  ErrAsgZOut,    -- 'Z' Assigning high impedence to data out
+  ErrAsgSOut,    -- 'S' Keeping data out at steady value
+  ErrAsgXMem,    -- 'X' Assigning unknown level to memory location
+  ErrAsg0Mem,    -- '0' Assigning low level to memory location
+  ErrAsg1Mem,    -- '1' Assigning high level to memory location
+  ErrAsgZMem,    -- 'Z' Assigning high impedence to memory location
+  ErrDefMemAct,  --     No memory table match, using default action
+  ErrInitMem,    --     Initialize memory contents
+  ErrMcpWrCont,  --     Memory cross port to same port write contention
+  ErrMcpCpCont,  --     Memory cross port read/write data/memory contention
+  ErrMcpCpRead,  --     Memory cross port read to same port
+  ErrMcpRdWrCo,  --     Memory cross port read/write data only contention
+  ErrMcpCpWrCont,--     Memory cross port to cross port write contention
+  ErrUnknMemDo,  --     Unknown memory action
+  ErrUnknDatDo,  --     Unknown data action
+  ErrUnknSymbol, --     Illegal memory symbol
+  ErrLdIlgArg,
+  ErrLdAddrRng,
+  ErrLdMemInfo,
+  ErrLdFileEmpty,
+  ErrPrintString
+);
+
+TYPE VitalMemoryErrorSeverityType IS
+ARRAY (VitalMemoryErrorType) OF SEVERITY_LEVEL;
+CONSTANT VitalMemoryErrorSeverity : 
+  VitalMemoryErrorSeverityType := (
+    ErrGoodAddr     => NOTE,
+    ErrUnknAddr     => WARNING,
+    ErrInvaAddr     => WARNING,
+    ErrGoodTrAddr   => NOTE,
+    ErrUnknTrAddr   => WARNING,
+    ErrInvaTrAddr   => WARNING,
+    ErrWrDatMem     => NOTE,
+    ErrNoChgMem     => NOTE,
+    ErrCrAllMem     => WARNING,
+    ErrCrWrdMem     => WARNING,
+    ErrCrBitMem     => WARNING,
+    ErrCrDatMem     => WARNING,
+    ErrCrAllSubMem  => WARNING,
+    ErrCrWrdSubMem  => WARNING,
+    ErrCrBitSubMem  => WARNING,
+    ErrCrDatSubMem  => WARNING,
+    ErrCrWrdOut     => WARNING,
+    ErrCrBitOut     => WARNING,
+    ErrCrDatOut     => WARNING,
+    ErrCrWrdSubOut  => WARNING,
+    ErrCrBitSubOut  => WARNING,
+    ErrCrDatSubOut  => WARNING,
+    ErrImplOut      => NOTE,
+    ErrReadOut      => NOTE,
+    ErrAssgOut      => NOTE,
+    ErrAsgXOut      => NOTE,
+    ErrAsg0Out      => NOTE,
+    ErrAsg1Out      => NOTE,
+    ErrAsgZOut      => NOTE,
+    ErrAsgSOut      => NOTE,
+    ErrAsgXMem      => NOTE,
+    ErrAsg0Mem      => NOTE,
+    ErrAsg1Mem      => NOTE,
+    ErrAsgZMem      => NOTE,
+    ErrDefMemAct    => NOTE,
+    ErrInitMem      => NOTE,
+    ErrMcpWrCont    => WARNING,
+    ErrMcpCpCont    => WARNING,
+    ErrMcpCpRead    => WARNING,
+    ErrMcpRdWrCo    => WARNING,
+    ErrMcpCpWrCont  => WARNING,
+    ErrUnknMemDo    => ERROR,
+    ErrUnknDatDo    => ERROR,
+    ErrUnknSymbol   => ERROR,
+    ErrLdIlgArg     => ERROR,
+    ErrLdAddrRng    => WARNING,
+    ErrLdMemInfo    => NOTE,
+    ErrLdFileEmpty  => ERROR,
+    ErrPrintString  => WARNING
+  );
+
+-- ----------------------------------------------------------------------------
+CONSTANT MsgGoodAddr    : STRING
+          := "Good address (no transition)";
+CONSTANT MsgUnknAddr    : STRING
+          := "Unknown address (no transition)";
+CONSTANT MsgInvaAddr    : STRING
+          := "Invalid address (no transition)";
+CONSTANT MsgGoodTrAddr  : STRING
+          := "Good address (with transition)"; 
+CONSTANT MsgUnknTrAddr  : STRING
+          := "Unknown address (with transition)"; 
+CONSTANT MsgInvaTrAddr  : STRING
+          := "Invalid address (with transition)"; 
+CONSTANT MsgNoChgMem    : STRING
+          := "Retaining previous memory contents";
+CONSTANT MsgWrDatMem    : STRING
+          := "Writing data to memory";
+CONSTANT MsgCrAllMem    : STRING
+          := "Corrupting entire memory with 'X'";
+CONSTANT MsgCrWrdMem    : STRING
+          := "Corrupting a word in memory with 'X'";
+CONSTANT MsgCrBitMem    : STRING
+          := "Corrupting a single bit in memory with 'X'";
+CONSTANT MsgCrDatMem    : STRING
+          := "Corrupting a word with 'X' based on data in";
+CONSTANT MsgCrAllSubMem : STRING
+          := "Corrupting a sub-word entire memory with 'X'";
+CONSTANT MsgCrWrdSubMem : STRING
+          := "Corrupting a sub-word in memory with 'X'";
+CONSTANT MsgCrBitSubMem : STRING
+          := "Corrupting a single bit of a sub-word with 'X'";
+CONSTANT MsgCrDatSubMem : STRING
+          := "Corrupting a sub-word with 'X' based on data in";
+CONSTANT MsgCrWrdOut    : STRING
+          := "Corrupting data out with 'X'";
+CONSTANT MsgCrBitOut    : STRING
+          := "Corrupting a single bit of data out with 'X'";
+CONSTANT MsgCrDatOut    : STRING
+          := "Corrupting data out with 'X' based on data in";
+CONSTANT MsgCrWrdSubOut : STRING
+          := "Corrupting data out sub-word with 'X'";
+CONSTANT MsgCrBitSubOut : STRING
+          := "Corrupting a single bit of data out sub-word with 'X'";
+CONSTANT MsgCrDatSubOut : STRING
+          := "Corrupting data out sub-word with 'X' based on data in";
+CONSTANT MsgImplOut     : STRING
+          := "Implicit read from memory to data out";
+CONSTANT MsgReadOut     : STRING
+          := "Reading data from memory to data out";
+CONSTANT MsgAssgOut     : STRING
+          := "Transfering from data in to data out";
+CONSTANT MsgAsgXOut     : STRING
+          := "Assigning unknown level to data out";
+CONSTANT MsgAsg0Out     : STRING
+          := "Assigning low level to data out";
+CONSTANT MsgAsg1Out     : STRING
+          := "Assigning high level to data out";
+CONSTANT MsgAsgZOut     : STRING
+          := "Assigning high impedance to data out";
+CONSTANT MsgAsgSOut     : STRING
+          := "Keeping data out at steady value";
+CONSTANT MsgAsgXMem     : STRING
+          := "Assigning unknown level to memory location";
+CONSTANT MsgAsg0Mem     : STRING
+          := "Assigning low level to memory location";
+CONSTANT MsgAsg1Mem     : STRING
+          := "Assigning high level to memory location";
+CONSTANT MsgAsgZMem     : STRING
+          := "Assigning high impedance to memory location";
+CONSTANT MsgDefMemAct   : STRING
+          := "No memory table match, using default action";
+CONSTANT MsgInitMem     : STRING
+          := "Initializing memory contents";
+CONSTANT MsgMcpWrCont   : STRING
+          := "Same port write contention";
+CONSTANT MsgMcpCpCont   : STRING
+          := "Cross port read/write data/memory contention";
+CONSTANT MsgMcpCpRead   : STRING
+          := "Cross port read to same port";
+CONSTANT MsgMcpRdWrCo   : STRING
+          := "Cross port read/write data only contention";
+CONSTANT MsgMcpCpWrCont : STRING
+          := "Cross port write contention";
+CONSTANT MsgUnknMemDo   : STRING
+          := "Unknown memory action";
+CONSTANT MsgUnknDatDo   : STRING
+          := "Unknown data action";
+CONSTANT MsgUnknSymbol  : STRING
+          := "Illegal memory symbol";
+
+CONSTANT MsgLdIlgArg    : STRING
+          := "Illegal bit arguments while loading memory.";
+CONSTANT MsgLdMemInfo   : STRING
+          := "Loading data from the file into memory.";
+CONSTANT MsgLdAddrRng   : STRING
+          := "Address out of range while loading memory.";
+CONSTANT MsgLdFileEmpty : STRING
+          := "Memory load file is empty.";
+CONSTANT MsgPrintString : STRING
+          := "";
+
+CONSTANT MsgUnknown     : STRING
+          := "Unknown error message.";
+
+CONSTANT MsgVMT         : STRING
+          := "VitalMemoryTable";
+CONSTANT MsgVMV         : STRING
+          := "VitalMemoryViolation";
+CONSTANT MsgVDM         : STRING
+          := "VitalDeclareMemory";
+CONSTANT MsgVMCP        : STRING
+          := "VitalMemoryCrossPorts";
+
+-- ----------------------------------------------------------------------------
+-- LOCAL Utilities
+-- ----------------------------------------------------------------------------
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   MemoryMessage
+-- Parameters:  ErrorId     -- Input error code
+-- Description: This function looks up the input error code and returns
+--              the string value of the associated message.
+-- ----------------------------------------------------------------------------
+
+FUNCTION MemoryMessage (
+  CONSTANT ErrorId : IN VitalMemoryErrorType
+) RETURN STRING IS
+BEGIN
+  CASE ErrorId IS
+    WHEN ErrGoodAddr      => RETURN MsgGoodAddr   ;
+    WHEN ErrUnknAddr      => RETURN MsgUnknAddr   ;
+    WHEN ErrInvaAddr      => RETURN MsgInvaAddr   ;
+    WHEN ErrGoodTrAddr    => RETURN MsgGoodTrAddr ;
+    WHEN ErrUnknTrAddr    => RETURN MsgUnknTrAddr ;
+    WHEN ErrInvaTrAddr    => RETURN MsgInvaTrAddr ;
+    WHEN ErrWrDatMem      => RETURN MsgWrDatMem   ;
+    WHEN ErrNoChgMem      => RETURN MsgNoChgMem   ;
+    WHEN ErrCrAllMem      => RETURN MsgCrAllMem   ;
+    WHEN ErrCrWrdMem      => RETURN MsgCrWrdMem   ;
+    WHEN ErrCrBitMem      => RETURN MsgCrBitMem   ;
+    WHEN ErrCrDatMem      => RETURN MsgCrDatMem   ;
+    WHEN ErrCrAllSubMem   => RETURN MsgCrAllSubMem;
+    WHEN ErrCrWrdSubMem   => RETURN MsgCrWrdSubMem;
+    WHEN ErrCrBitSubMem   => RETURN MsgCrBitSubMem;
+    WHEN ErrCrDatSubMem   => RETURN MsgCrDatSubMem;
+    WHEN ErrCrWrdOut      => RETURN MsgCrWrdOut   ;
+    WHEN ErrCrBitOut      => RETURN MsgCrBitOut   ;
+    WHEN ErrCrDatOut      => RETURN MsgCrDatOut   ;
+    WHEN ErrCrWrdSubOut   => RETURN MsgCrWrdSubOut;
+    WHEN ErrCrBitSubOut   => RETURN MsgCrBitSubOut;
+    WHEN ErrCrDatSubOut   => RETURN MsgCrDatSubOut;
+    WHEN ErrImplOut       => RETURN MsgImplOut    ;
+    WHEN ErrReadOut       => RETURN MsgReadOut    ;
+    WHEN ErrAssgOut       => RETURN MsgAssgOut    ;
+    WHEN ErrAsgXOut       => RETURN MsgAsgXOut    ;
+    WHEN ErrAsg0Out       => RETURN MsgAsg0Out    ;
+    WHEN ErrAsg1Out       => RETURN MsgAsg1Out    ;
+    WHEN ErrAsgZOut       => RETURN MsgAsgZOut    ;
+    WHEN ErrAsgSOut       => RETURN MsgAsgSOut    ;
+    WHEN ErrAsgXMem       => RETURN MsgAsgXMem    ;
+    WHEN ErrAsg0Mem       => RETURN MsgAsg0Mem    ;
+    WHEN ErrAsg1Mem       => RETURN MsgAsg1Mem    ;
+    WHEN ErrAsgZMem       => RETURN MsgAsgZMem    ;
+    WHEN ErrDefMemAct     => RETURN MsgDefMemAct  ;
+    WHEN ErrInitMem       => RETURN MsgInitMem    ;
+    WHEN ErrMcpWrCont     => RETURN MsgMcpWrCont  ;
+    WHEN ErrMcpCpCont     => RETURN MsgMcpCpCont  ;
+    WHEN ErrMcpCpRead     => RETURN MsgMcpCpRead  ;
+    WHEN ErrMcpRdWrCo     => RETURN MsgMcpRdWrCo  ;
+    WHEN ErrMcpCpWrCont   => RETURN MsgMcpCpWrCont;
+    WHEN ErrUnknMemDo     => RETURN MsgUnknMemDo  ;
+    WHEN ErrUnknDatDo     => RETURN MsgUnknDatDo  ;
+    WHEN ErrUnknSymbol    => RETURN MsgUnknSymbol ;
+    WHEN ErrLdIlgArg      => RETURN MsgLdIlgArg   ;
+    WHEN ErrLdAddrRng     => RETURN MsgLdAddrRng  ;
+    WHEN ErrLdMemInfo     => RETURN MsgLdMemInfo  ;
+    WHEN ErrLdFileEmpty   => RETURN MsgLdFileEmpty;
+    WHEN ErrPrintString   => RETURN MsgPrintString;
+    WHEN OTHERS           => RETURN MsgUnknown    ;
+  END CASE;
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   PrintMemoryMessage
+-- Parameters:  Routine     -- String identifying the calling routine
+--                  ErrorId     -- Input error code for message lookup
+--                  Info        -- Output string or character
+--                  InfoStr     -- Additional output string
+--                  Info1       -- Additional output integer
+--                  Info2       -- Additional output integer
+--                  Info3       -- Additional output integer
+-- Description: This procedure prints out a memory status message
+--              given the input error id and other status information.
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintMemoryMessage (
+  CONSTANT Routine : IN STRING;
+  CONSTANT ErrorId : IN VitalMemoryErrorType
+) IS
+BEGIN
+  ASSERT FALSE
+    REPORT Routine & ": " & MemoryMessage(ErrorId)
+    SEVERITY VitalMemoryErrorSeverity(ErrorId);
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintMemoryMessage (
+  CONSTANT Routine : IN STRING;
+  CONSTANT ErrorId : IN VitalMemoryErrorType;
+  CONSTANT Info    : IN STRING
+) IS
+BEGIN
+  ASSERT FALSE
+    REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & Info
+    SEVERITY VitalMemoryErrorSeverity(ErrorId);
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintMemoryMessage (
+  CONSTANT Routine : IN STRING;
+  CONSTANT ErrorId : IN VitalMemoryErrorType;
+  CONSTANT Info1   : IN STRING;
+  CONSTANT Info2   : IN STRING
+) IS
+BEGIN
+  ASSERT FALSE
+    REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & Info1 & " " & Info2
+    SEVERITY VitalMemoryErrorSeverity(ErrorId);
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintMemoryMessage (
+  CONSTANT Routine : IN STRING;
+  CONSTANT ErrorId : IN VitalMemoryErrorType;
+  CONSTANT Info    : IN CHARACTER
+) IS
+BEGIN
+  ASSERT FALSE
+    REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & Info
+    SEVERITY VitalMemoryErrorSeverity(ErrorId);
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintMemoryMessage (
+  CONSTANT Routine    : IN STRING;
+  CONSTANT ErrorId    : IN VitalMemoryErrorType;
+  CONSTANT InfoStr    : IN STRING;
+  CONSTANT Info1      : IN NATURAL
+) IS
+  VARIABLE TmpStr         : STRING ( 1 TO 256 ) ;
+  VARIABLE TmpInt         : INTEGER := 1;
+BEGIN
+  IntToStr(Info1,TmpStr,TmpInt);
+  ASSERT FALSE
+    REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & InfoStr & " " & TmpStr
+    SEVERITY VitalMemoryErrorSeverity(ErrorId);
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintMemoryMessage (
+  CONSTANT Routine    : IN STRING;
+  CONSTANT ErrorId    : IN VitalMemoryErrorType;
+  CONSTANT InfoStr    : IN STRING;
+  CONSTANT Info1      : IN NATURAL;
+  CONSTANT Info2      : IN NATURAL
+) IS
+  VARIABLE TmpStr         : STRING ( 1 TO 256 ) ;
+  VARIABLE TmpInt         : INTEGER := 1;
+BEGIN
+  IntToStr(Info1,TmpStr,TmpInt);
+  IntToStr(Info2,TmpStr,TmpInt);
+  ASSERT FALSE
+    REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & InfoStr & " " & TmpStr
+    SEVERITY VitalMemoryErrorSeverity(ErrorId);
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintMemoryMessage (
+  CONSTANT Routine    : IN STRING;
+  CONSTANT ErrorId    : IN VitalMemoryErrorType;
+  CONSTANT InfoStr    : IN STRING;
+  CONSTANT Info1      : IN NATURAL;
+  CONSTANT Info2      : IN NATURAL;
+  CONSTANT Info3      : IN NATURAL
+) IS
+  VARIABLE TmpStr         : STRING ( 1 TO 256 ) ;
+  VARIABLE TmpInt         : INTEGER := 1;
+BEGIN
+  IntToStr(Info1,TmpStr,TmpInt);
+  IntToStr(Info2,TmpStr,TmpInt);
+  IntToStr(Info3,TmpStr,TmpInt);
+  ASSERT FALSE
+    REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & InfoStr & " " & TmpStr
+    SEVERITY VitalMemoryErrorSeverity(ErrorId);
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE PrintMemoryMessage (
+  CONSTANT Routine    : IN STRING;
+  CONSTANT Table      : IN VitalMemoryTableType;
+  CONSTANT Index      : IN INTEGER;
+  CONSTANT InfoStr    : IN STRING
+) IS
+  CONSTANT TableEntries   : INTEGER := Table'LENGTH(1);
+  CONSTANT TableWidth     : INTEGER := Table'LENGTH(2);
+  VARIABLE TmpStr         : STRING ( 1 TO 256 ) ;
+  VARIABLE TmpInt         : INTEGER := 1;
+BEGIN
+  IF (Index < 0 AND Index > TableEntries-1) THEN 
+    ASSERT FALSE
+      REPORT Routine & ": Memory table search failure"
+      SEVERITY ERROR;
+  END IF;
+  ColLoop:
+  FOR i IN 0 TO TableWidth-1 LOOP
+    IF (i >= 64) THEN
+      TmpStr(TmpInt) := '.';
+      TmpInt := TmpInt + 1;
+      TmpStr(TmpInt) := '.';
+      TmpInt := TmpInt + 1;
+      TmpStr(TmpInt) := '.';
+      TmpInt := TmpInt + 1;
+      EXIT ColLoop;
+    END IF;
+    TmpStr(TmpInt) := ''';
+    TmpInt := TmpInt + 1;
+    TmpStr(TmpInt) := To_MemoryChar(Table(Index,i));
+    TmpInt := TmpInt + 1;
+    TmpStr(TmpInt) := ''';
+    TmpInt := TmpInt + 1;
+    IF (i < TableWidth-1) THEN
+      TmpStr(TmpInt) := ',';
+      TmpInt := TmpInt + 1;
+    END IF;
+  END LOOP;
+  ASSERT FALSE
+    REPORT Routine & ": Port=" & InfoStr & " TableRow=" & TmpStr
+    SEVERITY NOTE;
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   DecodeAddress
+-- Parameters:  Address        - Converted address.
+--              AddrFlag       - Flag to indicte address match
+--              MemoryData     - Information about memory characteristics
+--              PrevAddressBus - Previous input address value
+--              AddressBus     - Input address value.
+-- Description: This procedure is used for transforming a valid
+--              address value to an integer in order to access memory.
+--              It performs address bound checking as well.
+--              Sets Address to -1 for unknowns
+--              Sets Address to -2 for out of range
+-- ----------------------------------------------------------------------------
+
+PROCEDURE DecodeAddress (
+  VARIABLE Address        : INOUT INTEGER;
+  VARIABLE AddrFlag       : INOUT VitalMemorySymbolType;
+  VARIABLE MemoryData     : IN VitalMemoryDataType;
+  CONSTANT PrevAddressBus : IN std_logic_vector;
+  CONSTANT AddressBus     : IN std_logic_vector
+) IS
+  VARIABLE Power      : NATURAL;
+  VARIABLE AddrUnkn   : BOOLEAN;
+BEGIN
+  Power := 0;
+  AddrUnkn := FALSE;
+  -- It is assumed that always Address'LEFT represents the Most significant bit.   
+  FOR i IN AddressBus'RANGE LOOP
+    Power := Power * 2;
+    IF (AddressBus(i) /= '1' AND AddressBus(i) /= '0') THEN
+      AddrUnkn := TRUE;
+      Power := 0;
+      EXIT;
+    ELSIF (AddressBus(i) = '1') THEN
+      Power := Power + 1;
+    END IF;
+  END LOOP;
+  Address := Power;
+  AddrFlag := 'g';
+  IF (AddrUnkn) THEN
+    AddrFlag := 'u';    -- unknown addr
+    Address := -1;
+  END IF;
+  IF ( Power > (MemoryData.NoOfWords - 1)) THEN
+    AddrFlag := 'i';    -- invalid addr
+    Address := -2;
+  END IF;
+  IF (PrevAddressBus /= AddressBus) THEN
+    CASE AddrFlag IS
+      WHEN 'g'    => AddrFlag := 'G';
+      WHEN 'u'    => AddrFlag := 'U';
+      WHEN 'i'    => AddrFlag := 'I';
+      WHEN OTHERS => 
+        ASSERT FALSE REPORT
+          "DecodeAddress: Internal error. [AddrFlag]=" 
+          & To_MemoryChar(AddrFlag)
+          SEVERITY ERROR;
+    END CASE;
+  END IF;
+END DecodeAddress;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   DecodeData
+-- Parameters:  DataFlag      - Flag to indicte data match
+--              PrevDataInBus - Previous input data value
+--              DataInBus     - Input data value.
+--              HighBit       - High bit offset value.
+--              LowBit        - Low  bit offset value.
+-- Description: This procedure is used for interpreting the input data
+--              as a data flag for subsequent table matching.
+-- ----------------------------------------------------------------------------
+PROCEDURE DecodeData (
+  VARIABLE DataFlag       : INOUT VitalMemorySymbolType;
+  CONSTANT PrevDataInBus  : IN std_logic_vector;
+  CONSTANT DataInBus      : IN std_logic_vector;
+  CONSTANT HighBit        : IN    NATURAL;
+  CONSTANT LowBit         : IN    NATURAL
+) IS
+  VARIABLE DataUnkn   : BOOLEAN := FALSE;
+BEGIN
+  FOR i IN LowBit TO HighBit LOOP
+    IF DataInBus(i) /= '1' AND DataInBus(i) /= '0' THEN
+      DataUnkn := TRUE;
+      EXIT;
+    END IF;
+  END LOOP;
+  DataFlag := 'g';
+  IF (DataUnkn) THEN
+    DataFlag := 'u';    -- unknown addr
+  END IF;
+  IF (PrevDataInBus(HighBit DOWNTO LowBit) /= 
+      DataInBus(HighBit DOWNTO LowBit)) THEN
+    CASE DataFlag IS
+      WHEN 'g'    => DataFlag := 'G';
+      WHEN 'u'    => DataFlag := 'U';
+      WHEN OTHERS => 
+        ASSERT FALSE REPORT
+          "DecodeData: Internal error. [DataFlag]=" 
+          & To_MemoryChar(DataFlag)
+          SEVERITY ERROR;
+    END CASE;
+  END IF;
+END DecodeData;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   WriteMemory
+-- Parameters:  MemoryPtr   - Pointer to the memory array.
+--              DataInBus   - Input Data to be written.
+--              Address     - Address of the memory location.
+--              BitPosition - Position of bit in memory location.
+--              HighBit     - High bit offset value.
+--              LowBit      - Low  bit offset value.
+-- Description: This procedure is used to write to a memory location
+--              on a bit/byte/word basis. 
+--              The high bit and low bit offset are used for byte write
+--              operations.These parameters specify the data byte for write.
+--              In the case of word write the complete memory word is used.
+--              This procedure is overloaded for bit,byte and word write 
+--              memory operations.The number of parameters may vary.
+-- ----------------------------------------------------------------------------
+PROCEDURE WriteMemory (
+  VARIABLE MemoryPtr   : INOUT VitalMemoryDataType;
+  CONSTANT DataInBus   : IN    std_logic_vector;
+  CONSTANT Address     : IN    INTEGER;
+  CONSTANT HighBit     : IN    NATURAL;
+  CONSTANT LowBit      : IN    NATURAL
+) IS
+  VARIABLE TmpData : std_logic_vector(DataInBus'LENGTH - 1 DOWNTO 0);
+BEGIN
+  -- Address bound checking.
+  IF ( Address < 0 OR Address > (MemoryPtr.NoOfWords - 1)) THEN
+    PrintMemoryMessage ( "WriteMemory", ErrPrintString, 
+      "Aborting write operation as address is out of range.") ;
+    RETURN;
+  END IF;
+  TmpData  := To_UX01(DataInBus);
+  FOR i in LowBit to HighBit LOOP
+    MemoryPtr.MemoryArrayPtr(Address).all(i) := TmpData(i);
+  END LOOP;
+END WriteMemory;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE WriteMemory (
+  VARIABLE MemoryPtr      : INOUT VitalMemoryDataType;
+  CONSTANT DataInBus      : IN    std_logic_vector;
+  CONSTANT Address        : IN    INTEGER;
+  CONSTANT BitPosition    : IN    NATURAL
+) IS
+  VARIABLE HighBit      : NATURAL;
+  VARIABLE LowBit       : NATURAL;
+BEGIN
+  HighBit      := BitPosition;
+  LowBit       := BitPosition;
+  WriteMemory (MemoryPtr, DataInBus, Address, HighBit, LowBit);
+END WriteMemory;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE WriteMemory   (
+  VARIABLE MemoryPtr   : INOUT VitalMemoryDataType;
+  CONSTANT DataInBus   : IN    std_logic_vector;
+  CONSTANT Address     : IN    INTEGER
+) IS
+  VARIABLE HighBit      : NATURAL;
+  VARIABLE LowBit       : NATURAL;
+BEGIN
+  HighBit      := MemoryPtr.NoOfBitsPerWord - 1;
+  LowBit       := 0;
+  WriteMemory (MemoryPtr, DataInBus, Address, HighBit, LowBit);
+END WriteMemory;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   ReadMemory
+-- Parameters:  MemoryPtr    - Pointer to the memory array.
+--              DataOut      - Output Data to be read in this.
+--              Address      - Address of the memory location.
+--              BitPosition  - Position of bit in memory location.
+--              HighBit      - High bit offset value.
+--              LowBit       - Low  bit offset value.
+-- Description: This procedure is used to read from a memory location
+--              on a bit/byte/word basis. 
+--              The high bit and low bit offset are used for byte write
+--              operations.These parameters specify the data byte for 
+--              read.In the case of word write the complete memory word 
+--              is used.This procedure is overloaded for bit,byte and 
+--              word write memory operations.The number of parameters 
+--              may vary.
+-- ----------------------------------------------------------------------------
+PROCEDURE ReadMemory (
+  VARIABLE MemoryPtr  : INOUT VitalMemoryDataType;
+  VARIABLE DataOut    : OUT   std_logic_vector;
+  CONSTANT Address    : IN    INTEGER;
+  CONSTANT HighBit    : IN    NATURAL;
+  CONSTANT LowBit     : IN    NATURAL
+) IS
+  VARIABLE DataOutTmp : std_logic_vector(MemoryPtr.NoOfBitsPerWord-1 DOWNTO 0);
+  VARIABLE length     : NATURAL := (HighBit - LowBit + 1);
+BEGIN
+  -- Address bound checking.
+  IF ( Address > (MemoryPtr.NoOfWords - 1)) THEN
+    PrintMemoryMessage ( 
+      "ReadMemory",ErrInvaAddr,
+      "[Address,NoOfWords]=",Address,MemoryPtr.NoOfWords 
+    );
+    FOR i in LowBit to HighBit LOOP
+      DataOutTmp(i) := 'X';
+    END LOOP;
+  ELSE
+    FOR i in LowBit to HighBit LOOP
+      DataOutTmp(i) := MemoryPtr.MemoryArrayPtr (Address).all(i);
+    END LOOP;
+  END IF;
+  DataOut :=  DataOutTmp;
+END ReadMemory;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE ReadMemory (
+  VARIABLE MemoryPtr   : INOUT VitalMemoryDataType;
+  VARIABLE DataOut     : OUT   std_logic_vector;
+  CONSTANT Address     : IN    INTEGER;
+  CONSTANT BitPosition : IN    NATURAL
+) IS
+  VARIABLE HighBit    : NATURAL;
+  VARIABLE LowBit     : NATURAL;
+BEGIN
+  HighBit      := BitPosition;
+  LowBit       := BitPosition;
+  ReadMemory (MemoryPtr, DataOut, Address, HighBit, LowBit);
+END ReadMemory;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE ReadMemory (
+  VARIABLE MemoryPtr  : INOUT VitalMemoryDataType;
+  VARIABLE DataOut    : OUT   std_logic_vector;
+  CONSTANT Address    : IN    INTEGER
+) IS
+  VARIABLE HighBit    : NATURAL;
+  VARIABLE LowBit     : NATURAL;
+BEGIN
+  HighBit      := MemoryPtr.NoOfBitsPerWord - 1;
+  LowBit       := 0;
+  ReadMemory (MemoryPtr, DataOut, Address, HighBit, LowBit);
+END ReadMemory;
+
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   LoadMemory
+-- Parameters:  MemoryPtr   - Pointer to the memory array.
+--              FileName    - Name of the output file.
+--              HighBit     - High bit offset value.
+--              LowBit      - Low  bit offset value.
+-- Description: This procedure is used to load the contents of the memory
+--              from a specified input file.
+--              The high bit and low bit offset are used so that same task
+--              can be used for all bit/byte/word write operations.
+--              In the case of a bit write RAM the HighBit and LowBit have
+--              the same value.
+--              This procedure is overloaded for word write operations.
+-- ----------------------------------------------------------------------------
+PROCEDURE LoadMemory (
+  VARIABLE MemoryPtr  : INOUT VitalMemoryDataType;
+  CONSTANT FileName   : IN    STRING;
+  CONSTANT BinaryFile : IN BOOLEAN := FALSE
+) IS
+  FILE     Fptr      : TEXT OPEN read_mode IS FileName;
+  VARIABLE OneLine   : LINE;
+  VARIABLE Ignore    : CHARACTER;
+  VARIABLE Index     : NATURAL  := 1;
+  VARIABLE LineNo    : NATURAL  := 0;
+  VARIABLE Address   : INTEGER  := 0;
+  VARIABLE DataInBus : std_logic_vector(MemoryPtr.NoOfBitsPerWord-1  DOWNTO 0);
+  VARIABLE AddrStr   : STRING(1 TO 80) ;    
+  VARIABLE DataInStr : STRING(1 TO 255) ;    
+BEGIN
+  IF (ENDFILE(fptr)) THEN
+    PrintMemoryMessage (MsgVDM, ErrLdFileEmpty, 
+      "[FileName]="&FileName);
+    RETURN;
+  END IF ;
+  PrintMemoryMessage (
+    MsgVDM,ErrLdMemInfo, "[FileName]="&FileName
+  );
+  WHILE (NOT ENDFILE(fptr)) LOOP
+    ReadLine(Fptr, OneLine);
+    LineNo := LineNo + 1 ;
+    --  First ignoring leading spaces.  
+    WHILE (OneLine'LENGTH /= 0 and IsSpace(OneLine(1))) LOOP
+      READ (OneLine, Ignore) ;     -- Ignoring the space character.
+    END LOOP ;
+    --  Note that, by now oneline has been "stripped" of its leading spaces.
+    IF ( OneLine(1) = '@' ) THEN
+      READ (OneLine, Ignore);  -- Ignore the '@' character and read the string.
+      -- Now strip off spaces, if any, between '@' and Address string.
+      WHILE (OneLine'LENGTH /= 0 and IsSpace(OneLine(1))) LOOP
+        READ (OneLine, Ignore) ;     -- Ignoring the space character.
+      END LOOP ;
+      -- Now get the string which represents the address into string variable.
+      Index := 1;
+      WHILE (OneLine'LENGTH /= 0 AND (NOT(IsSpace(OneLine(1))))) LOOP
+        READ(OneLine, AddrStr(Index));
+        Index := Index + 1;
+      END LOOP ;
+      AddrStr(Index) := NUL;
+      -- Now convert the hex string into a hex integer
+      Address := HexToInt(AddrStr) ;
+    ELSE
+      IF ( LineNo /= 1 ) THEN
+        Address := Address + 1;
+      END IF;
+    END IF ;
+    IF ( Address > (MemoryPtr.NoOfWords - 1) ) THEN
+      PrintMemoryMessage (MsgVDM, ErrLdAddrRng, 
+      "[Address,lineno]=", Address, LineNo) ;
+      EXIT ;
+    END IF;
+    -- Now strip off spaces, between Address string and DataInBus string.
+    WHILE (OneLine'LENGTH /= 0 AND IsSpace(OneLine(1))) LOOP
+      READ (OneLine, Ignore) ;     -- Ignoring the space character.
+    END LOOP ;
+    Index := 1;
+    WHILE (OneLine'LENGTH /= 0 AND (NOT(IsSpace(OneLine(1))))) LOOP
+      READ(OneLine, DataInStr(Index));
+      Index := Index + 1;
+    END LOOP ;
+    DataInStr(Index) := NUL;
+    IF (BinaryFile) THEN
+      DataInBus := BinToBitv (DataInStr);
+    ELSE
+      DataInBus := HexToBitv (DataInStr);
+    END IF ;
+    WriteMemory (MemoryPtr, DataInBus, Address);
+  END LOOP ;
+END LoadMemory;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   MemoryMatch
+-- Parameters:  Symbol       - Symbol from memory table
+--              TestFlag     - Interpreted data or address symbol
+--              In2          - input from VitalMemoryTable procedure
+--                             to memory table
+--              In2LastValue - Previous value of input
+--              Err          - TRUE if symbol is not a valid input symbol
+--              ReturnValue  - TRUE if match occurred
+-- Description: This procedure sets ReturnValue to true if in2 matches
+--              symbol (from the memory table).  If symbol is an edge
+--              value edge is set to true and in2 and in2LastValue are
+--              checked against symbol.  Err is set to true if symbol
+--              is an invalid value for the input portion of the memory
+--              table.
+-- ----------------------------------------------------------------------------
+PROCEDURE MemoryMatch (
+  CONSTANT Symbol       : IN VitalMemorySymbolType;
+  CONSTANT In2          : IN std_ulogic;
+  CONSTANT In2LastValue : IN std_ulogic;
+  VARIABLE Err          : OUT BOOLEAN;
+  VARIABLE ReturnValue  : OUT BOOLEAN
+) IS
+BEGIN
+  IF (NOT ValidMemoryTableInput(Symbol) ) THEN
+    PrintMemoryMessage(MsgVMT,ErrUnknSymbol,To_MemoryChar(Symbol));
+    Err := TRUE;
+    ReturnValue := FALSE;
+  ELSE
+    ReturnValue := MemoryTableMatch(To_X01(In2LastValue), To_X01(In2), Symbol);
+    Err := FALSE;
+  END IF;
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE MemoryMatch (
+  CONSTANT Symbol       : IN VitalMemorySymbolType;
+  CONSTANT TestFlag     : IN VitalMemorySymbolType;
+  VARIABLE Err          : OUT BOOLEAN;
+  VARIABLE ReturnValue  : OUT BOOLEAN
+) IS
+BEGIN
+  Err := FALSE;
+  ReturnValue := FALSE;
+  CASE Symbol IS
+    WHEN 'g'|'u'|'i'|'G'|'U'|'I'|'-'|'*'|'S' =>
+      IF (Symbol = TestFlag) THEN
+        ReturnValue := TRUE;
+      ELSE
+        CASE Symbol IS
+          WHEN '-'    =>
+            ReturnValue := TRUE;
+            Err := FALSE;
+          WHEN '*'    =>
+            IF (TestFlag = 'G' OR 
+                TestFlag = 'U' OR 
+                TestFlag = 'I') THEN
+              ReturnValue := TRUE;
+              Err := FALSE;
+            END IF;
+          WHEN 'S'    =>
+            IF (TestFlag = 'g' OR 
+                TestFlag = 'u' OR 
+                TestFlag = 'i') THEN
+                ReturnValue := TRUE;
+              Err := FALSE;
+            END IF;
+          WHEN OTHERS =>
+            ReturnValue := FALSE;
+        END CASE;
+      END IF;
+    WHEN OTHERS =>
+      Err := TRUE;
+      RETURN;
+  END CASE;
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   MemoryTableCorruptMask
+-- Description: Compute memory and data corruption masks for memory table
+-- ----------------------------------------------------------------------------
+PROCEDURE MemoryTableCorruptMask (
+  VARIABLE CorruptMask            : OUT std_logic_vector;
+  CONSTANT Action                 : IN VitalMemorySymbolType;
+  CONSTANT EnableIndex            : IN INTEGER;
+  CONSTANT BitsPerWord            : IN INTEGER;
+  CONSTANT BitsPerSubWord         : IN INTEGER;
+  CONSTANT BitsPerEnable          : IN INTEGER
+) IS
+  VARIABLE CorruptMaskTmp : std_logic_vector (CorruptMask'RANGE)
+                          := (OTHERS => '0');
+  VARIABLE ViolFlAryPosn  : INTEGER;
+  VARIABLE HighBit        : INTEGER;
+  VARIABLE LowBit         : INTEGER;
+BEGIN
+  CASE (Action) IS
+    WHEN 'c'|'l'|'e'  =>
+      -- Corrupt whole word
+      CorruptMaskTmp := (OTHERS => 'X');
+      CorruptMask := CorruptMaskTmp;
+      RETURN;
+    WHEN 'd'|'C'|'L'|'D'|'E' =>
+      -- Process corruption below
+    WHEN OTHERS =>
+      -- No data or memory corruption
+      CorruptMaskTmp := (OTHERS => '0');
+      CorruptMask := CorruptMaskTmp;
+      RETURN;
+  END CASE;
+  IF (Action = 'd') THEN
+    CorruptMaskTmp := (OTHERS => 'X');
+    CorruptMask := CorruptMaskTmp;
+    RETURN;
+  END IF;
+  -- Remaining are subword cases 'C', 'L', 'D', 'E'
+  CorruptMaskTmp := (OTHERS => '0');
+  LowBit := 0;
+  HighBit := BitsPerSubWord-1;
+  SubWordLoop:
+  FOR i IN 0 TO BitsPerEnable-1 LOOP
+    IF (i = EnableIndex) THEN
+      FOR j IN HighBit TO LowBit LOOP
+        CorruptMaskTmp(j) := 'X';
+      END LOOP;
+    END IF;
+    -- Calculate HighBit and LowBit
+    LowBit := LowBit + BitsPerSubWord;
+    IF (LowBit > BitsPerWord) THEN
+      LowBit := BitsPerWord;
+    END IF;
+    HighBit := LowBit + BitsPerSubWord;
+    IF (HighBit > BitsPerWord) THEN
+      HighBit := BitsPerWord;
+    ELSE
+      HighBit := HighBit - 1;
+    END IF;
+  END LOOP;
+  CorruptMask := CorruptMaskTmp;
+  RETURN;
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE MemoryTableCorruptMask (
+  VARIABLE CorruptMask            : OUT std_logic_vector;
+  CONSTANT Action                 : IN VitalMemorySymbolType
+) IS
+  VARIABLE CorruptMaskTmp : std_logic_vector (0 TO CorruptMask'LENGTH-1)
+                          := (OTHERS => '0');
+  VARIABLE ViolFlAryPosn  : INTEGER;
+  VARIABLE HighBit        : INTEGER;
+  VARIABLE LowBit         : INTEGER;
+BEGIN
+  CASE (Action) IS
+    WHEN 'c'|'l'|'d'|'e'|'C'|'L'|'D'|'E' =>
+      -- Corrupt whole word
+      CorruptMaskTmp := (OTHERS => 'X');
+      CorruptMask := CorruptMaskTmp;
+      RETURN;
+    WHEN OTHERS =>
+      -- No data or memory corruption
+      CorruptMaskTmp := (OTHERS => '0');
+      CorruptMask := CorruptMaskTmp;
+      RETURN;
+  END CASE;
+  RETURN;
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   MemoryTableCorruptMask
+-- Description: Compute memory and data corruption masks for violation table
+-- ----------------------------------------------------------------------------
+PROCEDURE ViolationTableCorruptMask (
+  VARIABLE CorruptMask            : OUT std_logic_vector;
+  CONSTANT Action                 : IN VitalMemorySymbolType;
+  CONSTANT ViolationFlags         : IN std_logic_vector;
+  CONSTANT ViolationFlagsArray    : IN std_logic_vector;
+  CONSTANT ViolationSizesArray    : IN VitalMemoryViolFlagSizeType;
+  CONSTANT ViolationTable         : IN VitalMemoryTableType;
+  CONSTANT TableIndex             : IN INTEGER;
+  CONSTANT BitsPerWord            : IN INTEGER;
+  CONSTANT BitsPerSubWord         : IN INTEGER;
+  CONSTANT BitsPerEnable          : IN INTEGER
+) IS
+  VARIABLE CorruptMaskTmp : std_logic_vector (CorruptMask'RANGE)
+                          := (OTHERS => '0');
+  VARIABLE ViolMaskTmp    : std_logic_vector (CorruptMask'RANGE)
+                          := (OTHERS => '0');
+  VARIABLE ViolFlAryPosn  : INTEGER;
+  VARIABLE HighBit        : INTEGER;
+  VARIABLE LowBit         : INTEGER;
+  CONSTANT ViolFlagsSize  : INTEGER := ViolationFlags'LENGTH;
+  CONSTANT ViolFlArySize  : INTEGER := ViolationFlagsArray'LENGTH;
+  CONSTANT TableEntries   : INTEGER := ViolationTable'LENGTH(1);
+  CONSTANT TableWidth     : INTEGER := ViolationTable'LENGTH(2);
+  CONSTANT DatActionNdx   : INTEGER := TableWidth - 1;
+  CONSTANT MemActionNdx   : INTEGER := TableWidth - 2;
+BEGIN
+  CASE (Action) IS
+    WHEN 'c'|'l'|'e'  =>
+      -- Corrupt whole word
+      CorruptMaskTmp := (OTHERS => 'X');
+      CorruptMask := CorruptMaskTmp;
+      RETURN;
+    WHEN 'd'|'C'|'L'|'D'|'E' =>
+      -- Process corruption below
+    WHEN OTHERS =>
+      -- No data or memory corruption
+      CorruptMaskTmp := (OTHERS => '0');
+      CorruptMask := CorruptMaskTmp;
+      RETURN;
+  END CASE;
+  RowLoop: -- Check each element of the ViolationFlags
+  FOR j IN 0 TO ViolFlagsSize LOOP
+    IF (j = ViolFlagsSize) THEN
+      ViolFlAryPosn := 0;
+      RowLoop2: -- Check relevant elements of the ViolationFlagsArray
+      FOR k IN 0 TO MemActionNdx - ViolFlagsSize - 1 LOOP
+        IF (ViolationTable(TableIndex, k + ViolFlagsSize) = 'X') THEN
+          MaskLoop: -- Set the 'X' bits in the violation mask
+          FOR m IN INTEGER RANGE 0 TO CorruptMask'LENGTH-1 LOOP
+            IF (m <= ViolationSizesArray(k)-1) THEN
+              ViolMaskTmp(m) := ViolMaskTmp(m) XOR 
+              ViolationFlagsArray(ViolFlAryPosn+m);
+            ELSE
+              EXIT MaskLoop;
+            END IF;
+          END LOOP;
+        END IF;
+        ViolFlAryPosn := ViolFlAryPosn + ViolationSizesArray(k);
+      END LOOP;
+    ELSE
+      IF (ViolationTable(TableIndex, j) = 'X') THEN
+        ViolMaskTmp(0) := ViolMaskTmp(0) XOR ViolationFlags(j);
+      END IF;
+    END IF;
+  END LOOP;
+  IF (Action = 'd') THEN
+    CorruptMask := ViolMaskTmp;
+    RETURN;
+  END IF;
+  -- Remaining are subword cases 'C', 'L', 'D', 'E'
+  CorruptMaskTmp := (OTHERS => '0');
+  LowBit := 0;
+  HighBit := BitsPerSubWord-1;
+  SubWordLoop:
+  FOR i IN 0 TO BitsPerEnable-1 LOOP
+    IF (ViolMaskTmp(i) = 'X') THEN
+      FOR j IN HighBit TO LowBit LOOP
+        CorruptMaskTmp(j) := 'X';
+      END LOOP;
+    END IF;
+    -- Calculate HighBit and LowBit
+    LowBit := LowBit + BitsPerSubWord;
+    IF (LowBit > BitsPerWord) THEN
+      LowBit := BitsPerWord;
+    END IF;
+    HighBit := LowBit + BitsPerSubWord;
+    IF (HighBit > BitsPerWord) THEN
+      HighBit := BitsPerWord;
+    ELSE
+      HighBit := HighBit - 1;
+    END IF;
+  END LOOP;
+  CorruptMask := CorruptMaskTmp;
+  RETURN;
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   MemoryTableLookUp
+-- Parameters:  MemoryAction  - Output memory action to be performed
+--              DataAction    - Output data action to be performed
+--              PrevControls  - Previous data in for edge detection
+--              PrevEnableBus - Previous enables for edge detection
+--              Controls      - Agregate of scalar control lines
+--              EnableBus     - Concatenation of vector control lines
+--              EnableIndex   - Current slice of vector control lines
+--              AddrFlag      - Matching symbol from address decoding
+--              DataFlag      - Matching symbol from data decoding
+--              MemoryTable   - Input memory action table
+--              PortName      - Port name string for messages
+--              HeaderMsg     - Header string for messages
+--              MsgOn         - Control message output
+--
+-- Description: This function is used to find the output of the
+--              MemoryTable corresponding to a given set of inputs.
+--
+-- ----------------------------------------------------------------------------
+PROCEDURE MemoryTableLookUp (
+  VARIABLE MemoryAction       : OUT VitalMemorySymbolType;
+  VARIABLE DataAction         : OUT VitalMemorySymbolType;
+  VARIABLE MemoryCorruptMask  : OUT std_logic_vector;
+  VARIABLE DataCorruptMask    : OUT std_logic_vector;
+  CONSTANT PrevControls       : IN std_logic_vector;
+  CONSTANT Controls           : IN std_logic_vector;
+  CONSTANT AddrFlag           : IN VitalMemorySymbolType;
+  CONSTANT DataFlag           : IN VitalMemorySymbolType;
+  CONSTANT MemoryTable        : IN VitalMemoryTableType;
+  CONSTANT PortName           : IN STRING := "";
+  CONSTANT HeaderMsg          : IN STRING := "";
+  CONSTANT MsgOn              : IN BOOLEAN := TRUE
+) IS
+  CONSTANT ControlsSize   : INTEGER := Controls'LENGTH;
+  CONSTANT TableEntries   : INTEGER := MemoryTable'LENGTH(1);
+  CONSTANT TableWidth     : INTEGER := MemoryTable'LENGTH(2);
+  CONSTANT DatActionNdx   : INTEGER := TableWidth - 1;
+  CONSTANT MemActionNdx   : INTEGER := TableWidth - 2;
+  CONSTANT DataInBusNdx   : INTEGER := TableWidth - 3;
+  CONSTANT AddressBusNdx  : INTEGER := TableWidth - 4;
+  VARIABLE AddrFlagTable  : VitalMemorySymbolType;
+  VARIABLE Match  : BOOLEAN;
+  VARIABLE Err    : BOOLEAN := FALSE;
+  VARIABLE TableAlias     : VitalMemoryTableType(
+                              0 TO TableEntries - 1,
+                              0 TO TableWidth - 1)
+                              := MemoryTable;
+BEGIN
+  ColLoop: -- Compare each entry in the table
+  FOR i IN TableAlias'RANGE(1) LOOP
+    RowLoop: -- Check each element of the Controls
+    FOR j IN 0 TO ControlsSize LOOP
+      IF (j = ControlsSize) THEN
+        -- a match occurred, now check AddrFlag, DataFlag
+        MemoryMatch(TableAlias(i,AddressBusNdx),AddrFlag,Err,Match);
+        IF (Match) THEN
+          MemoryMatch(TableAlias(i,DataInBusNdx),DataFlag,Err,Match);
+          IF (Match) THEN
+            MemoryTableCorruptMask (
+              CorruptMask     => MemoryCorruptMask    ,
+              Action          => TableAlias(i, MemActionNdx)
+            );
+            MemoryTableCorruptMask (
+              CorruptMask     => DataCorruptMask      ,
+              Action          => TableAlias(i, DatActionNdx)
+            );
+            -- get the return memory and data actions
+            MemoryAction := TableAlias(i, MemActionNdx);
+            DataAction   := TableAlias(i, DatActionNdx);
+            -- DEBUG: The lines below report table search
+            IF (MsgOn) THEN
+              PrintMemoryMessage(MsgVMT,TableAlias,i,PortName);
+            END IF;
+            -- DEBUG: The lines above report table search
+            RETURN;
+          END IF;
+        END IF;
+      ELSE
+        -- Match memory table inputs
+        MemoryMatch (   TableAlias(i,j),
+        Controls(j), PrevControls(j),
+        Err, Match);
+      END IF;
+      EXIT RowLoop WHEN NOT(Match);
+      EXIT ColLoop WHEN Err;
+    END LOOP RowLoop;
+  END LOOP ColLoop;
+  -- no match found, return default action
+  MemoryAction := 's';   -- no change to memory
+  DataAction   := 'S';   -- no change to dataout
+  IF (MsgOn) THEN
+  PrintMemoryMessage(MsgVMT,ErrDefMemAct,HeaderMsg,PortName);
+  END IF;
+  RETURN;
+END;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE MemoryTableLookUp (
+  VARIABLE MemoryAction       : OUT VitalMemorySymbolType;
+  VARIABLE DataAction         : OUT VitalMemorySymbolType;
+  VARIABLE MemoryCorruptMask  : OUT std_logic_vector;
+  VARIABLE DataCorruptMask    : OUT std_logic_vector;
+  CONSTANT PrevControls       : IN std_logic_vector;
+  CONSTANT PrevEnableBus      : IN std_logic_vector;
+  CONSTANT Controls           : IN std_logic_vector;
+  CONSTANT EnableBus          : IN std_logic_vector;
+  CONSTANT EnableIndex        : IN INTEGER;
+  CONSTANT BitsPerWord        : IN INTEGER;
+  CONSTANT BitsPerSubWord     : IN INTEGER;
+  CONSTANT BitsPerEnable      : IN INTEGER;
+  CONSTANT AddrFlag           : IN VitalMemorySymbolType;
+  CONSTANT DataFlag           : IN VitalMemorySymbolType;
+  CONSTANT MemoryTable        : IN VitalMemoryTableType;
+  CONSTANT PortName           : IN STRING := "";
+  CONSTANT HeaderMsg          : IN STRING := "";
+  CONSTANT MsgOn              : IN BOOLEAN := TRUE
+) IS
+  CONSTANT ControlsSize   : INTEGER := Controls'LENGTH;
+  CONSTANT TableEntries   : INTEGER := MemoryTable'LENGTH(1);
+  CONSTANT TableWidth     : INTEGER := MemoryTable'LENGTH(2);
+  CONSTANT DatActionNdx   : INTEGER := TableWidth - 1;
+  CONSTANT MemActionNdx   : INTEGER := TableWidth - 2;
+  CONSTANT DataInBusNdx   : INTEGER := TableWidth - 3;
+  CONSTANT AddressBusNdx  : INTEGER := TableWidth - 4;
+  VARIABLE AddrFlagTable  : VitalMemorySymbolType;
+  VARIABLE Match  : BOOLEAN;
+  VARIABLE Err    : BOOLEAN := FALSE;
+  VARIABLE TableAlias     : VitalMemoryTableType(
+                              0 TO TableEntries - 1,
+                              0 TO TableWidth - 1)
+                                := MemoryTable;
+BEGIN
+  ColLoop: -- Compare each entry in the table
+  FOR i IN TableAlias'RANGE(1) LOOP
+    RowLoop: -- Check each element of the Controls
+    FOR j IN 0 TO ControlsSize LOOP
+      IF (j = ControlsSize) THEN
+        -- a match occurred, now check EnableBus, AddrFlag, DataFlag
+        IF (EnableIndex >= 0) THEN
+          RowLoop2: -- Check relevant elements of the EnableBus
+          FOR k IN 0 TO AddressBusNdx - ControlsSize - 1 LOOP
+            MemoryMatch (   TableAlias(i,k + ControlsSize),
+                            EnableBus(k * BitsPerEnable + EnableIndex),
+                            PrevEnableBus(k * BitsPerEnable + EnableIndex),
+                            Err, Match);
+            EXIT RowLoop2 WHEN NOT(Match);
+          END LOOP;
+        END IF;
+        IF (Match) THEN
+          MemoryMatch(TableAlias(i,AddressBusNdx),AddrFlag,Err,Match);
+          IF (Match) THEN
+            MemoryMatch(TableAlias(i,DataInBusNdx),DataFlag,Err,Match);
+            IF (Match) THEN
+              MemoryTableCorruptMask (
+                CorruptMask     => MemoryCorruptMask    ,
+                Action          => TableAlias(i, MemActionNdx),
+                EnableIndex     => EnableIndex          ,
+                BitsPerWord     => BitsPerWord          ,
+                BitsPerSubWord  => BitsPerSubWord       ,
+                BitsPerEnable   => BitsPerEnable
+              );
+              MemoryTableCorruptMask (
+                CorruptMask     => DataCorruptMask      ,
+                Action          => TableAlias(i, DatActionNdx),
+                EnableIndex     => EnableIndex          ,
+                BitsPerWord     => BitsPerWord          ,
+                BitsPerSubWord  => BitsPerSubWord       ,
+                BitsPerEnable   => BitsPerEnable
+              );
+              -- get the return memory and data actions
+              MemoryAction := TableAlias(i, MemActionNdx);
+              DataAction   := TableAlias(i, DatActionNdx);
+              -- DEBUG: The lines below report table search
+              IF (MsgOn) THEN
+                PrintMemoryMessage(MsgVMT,TableAlias,i,PortName);
+              END IF;
+              -- DEBUG: The lines above report table search
+              RETURN;
+            END IF;
+          END IF;
+        END IF;
+      ELSE
+        -- Match memory table inputs
+        MemoryMatch (   TableAlias(i,j),
+                        Controls(j), PrevControls(j),
+                        Err, Match);
+      END IF;
+      EXIT RowLoop WHEN NOT(Match);
+      EXIT ColLoop WHEN Err;
+    END LOOP RowLoop;
+  END LOOP ColLoop;
+  -- no match found, return default action
+  MemoryAction := 's';   -- no change to memory
+  DataAction   := 'S';   -- no change to dataout
+  IF (MsgOn) THEN
+    PrintMemoryMessage(MsgVMT,ErrDefMemAct,HeaderMsg,PortName);
+  END IF;
+  RETURN;
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   ViolationTableLookUp
+-- Parameters:  MemoryAction  - Output memory action to be performed
+--              DataAction    - Output data action to be performed
+--              TimingDataArray   - This is currently not used (comment out) 
+--              ViolationArray    - Aggregation of violation variables
+--              ViolationTable    - Input memory violation table
+--              PortName      - Port name string for messages
+--              HeaderMsg     - Header string for messages
+--              MsgOn         - Control message output
+-- Description: This function is used to find the output of the
+--              ViolationTable corresponding to a given set of inputs.
+-- ----------------------------------------------------------------------------
+PROCEDURE ViolationTableLookUp (
+  VARIABLE MemoryAction           : OUT VitalMemorySymbolType;
+  VARIABLE DataAction             : OUT VitalMemorySymbolType;
+  VARIABLE MemoryCorruptMask      : OUT std_logic_vector;
+  VARIABLE DataCorruptMask        : OUT std_logic_vector;
+  CONSTANT ViolationFlags         : IN std_logic_vector;
+  CONSTANT ViolationFlagsArray    : IN std_logic_vector;
+  CONSTANT ViolationSizesArray    : IN VitalMemoryViolFlagSizeType;
+  CONSTANT ViolationTable         : IN VitalMemoryTableType;
+  CONSTANT BitsPerWord            : IN INTEGER;
+  CONSTANT BitsPerSubWord         : IN INTEGER;
+  CONSTANT BitsPerEnable          : IN INTEGER;
+  CONSTANT PortName               : IN STRING := "";
+  CONSTANT HeaderMsg              : IN STRING := "";
+  CONSTANT MsgOn                  : IN BOOLEAN := TRUE
+) IS
+  CONSTANT ViolFlagsSize  : INTEGER := ViolationFlags'LENGTH;
+  CONSTANT ViolFlArySize  : INTEGER := ViolationFlagsArray'LENGTH;
+  VARIABLE ViolFlAryPosn  : INTEGER;
+  VARIABLE ViolFlAryItem  : std_ulogic;
+  CONSTANT ViolSzArySize  : INTEGER := ViolationSizesArray'LENGTH;
+  CONSTANT TableEntries   : INTEGER := ViolationTable'LENGTH(1);
+  CONSTANT TableWidth     : INTEGER := ViolationTable'LENGTH(2);
+  CONSTANT DatActionNdx   : INTEGER := TableWidth - 1;
+  CONSTANT MemActionNdx   : INTEGER := TableWidth - 2;
+  VARIABLE HighBit        : NATURAL := 0;
+  VARIABLE LowBit         : NATURAL := 0;
+  VARIABLE Match  : BOOLEAN;
+  VARIABLE Err    : BOOLEAN := FALSE;
+  VARIABLE TableAlias     : VitalMemoryTableType(
+                              0 TO TableEntries - 1,
+                              0 TO TableWidth - 1)
+                                := ViolationTable;
+BEGIN
+  ColLoop: -- Compare each entry in the table
+  FOR i IN TableAlias'RANGE(1) LOOP
+    RowLoop: -- Check each element of the ViolationFlags
+    FOR j IN 0 TO ViolFlagsSize LOOP
+      IF (j = ViolFlagsSize) THEN
+        ViolFlAryPosn := 0;
+        RowLoop2: -- Check relevant elements of the ViolationFlagsArray
+        FOR k IN 0 TO MemActionNdx - ViolFlagsSize - 1 LOOP
+          ViolFlAryItem := '0';
+          SubwordLoop: -- Check for 'X' in ViolationFlagsArray chunk
+          FOR s IN ViolFlAryPosn TO ViolFlAryPosn+ViolationSizesArray(k)-1 LOOP
+            IF (ViolationFlagsArray(s) = 'X') THEN
+              ViolFlAryItem := 'X';
+              EXIT SubwordLoop;
+            END IF;
+          END LOOP;
+          MemoryMatch (   TableAlias(i,k + ViolFlagsSize),
+          ViolFlAryItem,ViolFlAryItem,
+          Err, Match);
+          ViolFlAryPosn := ViolFlAryPosn + ViolationSizesArray(k);
+          EXIT RowLoop2 WHEN NOT(Match);
+        END LOOP;
+        IF (Match) THEN
+          -- Compute memory and data corruption masks
+          ViolationTableCorruptMask(
+            CorruptMask             => MemoryCorruptMask    ,
+            Action                  => TableAlias(i, MemActionNdx),
+            ViolationFlags          => ViolationFlags       ,
+            ViolationFlagsArray     => ViolationFlagsArray  ,
+            ViolationSizesArray     => ViolationSizesArray  ,
+            ViolationTable          => ViolationTable       ,
+            TableIndex              => i                    ,
+            BitsPerWord             => BitsPerWord          ,
+            BitsPerSubWord          => BitsPerSubWord       ,
+            BitsPerEnable           => BitsPerEnable
+          );
+          ViolationTableCorruptMask(
+            CorruptMask             => DataCorruptMask      ,
+            Action                  => TableAlias(i, DatActionNdx),
+            ViolationFlags          => ViolationFlags       ,
+            ViolationFlagsArray     => ViolationFlagsArray  ,
+            ViolationSizesArray     => ViolationSizesArray  ,
+            ViolationTable          => ViolationTable       ,
+            TableIndex              => i                    ,
+            BitsPerWord             => BitsPerWord          ,
+            BitsPerSubWord          => BitsPerSubWord       ,
+            BitsPerEnable           => BitsPerEnable
+          );
+          -- get the return memory and data actions
+          MemoryAction := TableAlias(i, MemActionNdx);
+          DataAction   := TableAlias(i, DatActionNdx);
+          -- DEBUG: The lines below report table search
+          IF (MsgOn) THEN
+            PrintMemoryMessage(MsgVMV,TableAlias,i,PortName);
+          END IF;
+          -- DEBUG: The lines above report table search
+          RETURN;
+        END IF;
+      ELSE
+        -- Match violation table inputs
+        Err := FALSE;
+        Match := FALSE;
+        IF (TableAlias(i,j) /= 'X' AND 
+            TableAlias(i,j) /= '0' AND
+            TableAlias(i,j) /= '-') THEN
+          Err := TRUE;
+        ELSIF (TableAlias(i,j) = '-' OR
+            (TableAlias(i,j) = 'X' AND ViolationFlags(j) = 'X') OR
+            (TableAlias(i,j) = '0' AND ViolationFlags(j) = '0')) THEN
+          Match := TRUE;
+        END IF;
+      END IF;
+      EXIT RowLoop WHEN NOT(Match);
+      EXIT ColLoop WHEN Err;
+    END LOOP RowLoop;
+  END LOOP ColLoop;
+  -- no match found, return default action
+  MemoryAction := 's';   -- no change to memory
+  DataAction   := 'S';   -- no change to dataout
+  IF (MsgOn) THEN
+    PrintMemoryMessage(MsgVMV,ErrDefMemAct,HeaderMsg,PortName);
+  END IF;
+  RETURN;
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   HandleMemoryAction
+-- Parameters:  MemoryData   - Pointer to memory data structure
+--              PortFlag     - Indicates read/write mode of port
+--              CorruptMask  - XOR'ed with DataInBus when corrupting
+--              DataInBus    - Current data bus in
+--              Address      - Current address integer
+--              HighBit      - Current address high bit
+--              LowBit       - Current address low bit
+--              MemoryTable  - Input memory action table
+--              MemoryAction - Memory action to be performed
+--              PortName     - Port name string for messages
+--              HeaderMsg    - Header string for messages
+--              MsgOn        - Control message output
+-- Description: This procedure performs the specified memory action on
+--              the input memory data structure.
+-- ----------------------------------------------------------------------------
+PROCEDURE HandleMemoryAction (
+  VARIABLE MemoryData     : INOUT VitalMemoryDataType;
+  VARIABLE PortFlag       : INOUT VitalPortFlagType;
+  CONSTANT CorruptMask    : IN std_logic_vector;
+  CONSTANT DataInBus      : IN std_logic_vector;
+  CONSTANT Address        : IN INTEGER;
+  CONSTANT HighBit        : IN NATURAL;
+  CONSTANT LowBit         : IN NATURAL;
+  CONSTANT MemoryTable    : IN VitalMemoryTableType;
+  CONSTANT MemoryAction   : IN VitalMemorySymbolType;
+  CONSTANT CallerName     : IN STRING;
+  CONSTANT PortName       : IN STRING := "";
+  CONSTANT HeaderMsg      : IN STRING := "";
+  CONSTANT MsgOn          : IN BOOLEAN := TRUE
+) IS
+  VARIABLE DataInTmp : std_logic_vector(DataInBus'RANGE)
+                        := DataInBus;
+  BEGIN
+
+  -- Handle the memory action
+  CASE MemoryAction IS
+
+  WHEN 'w'    =>
+    -- Writing data to memory
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrWrDatMem,HeaderMsg,PortName);
+    END IF;
+    WriteMemory(MemoryData,DataInBus,Address,HighBit,LowBit);
+    PortFlag.MemoryCurrent := WRITE;
+
+  WHEN 's'    =>
+    -- Retaining previous memory contents
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrNoChgMem,HeaderMsg,PortName);
+    END IF;
+    -- Set memory current to quiet state
+    PortFlag.MemoryCurrent := READ;
+
+  WHEN 'c'    =>
+    -- Corrupting entire memory with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrAllMem,HeaderMsg,PortName);
+    END IF;
+    DataInTmp := (OTHERS => 'X');
+    -- No need to CorruptMask
+    FOR i IN 0 TO MemoryData.NoOfWords-1 LOOP
+      WriteMemory(MemoryData,DataInTmp,i);
+    END LOOP;
+    PortFlag.MemoryCurrent := CORRUPT;
+
+  WHEN 'l'    =>
+    -- Corrupting a word in memory with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrWrdMem,HeaderMsg,PortName);
+    END IF;
+    DataInTmp := (OTHERS => 'X');
+    -- No need to CorruptMask
+    WriteMemory(MemoryData,DataInTmp,Address);
+    PortFlag.MemoryCurrent := CORRUPT;
+
+  WHEN 'd'    =>
+    -- Corrupting a single bit in memory with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrBitMem,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataInTmp,Address);
+    DataInTmp := DataInTmp XOR CorruptMask;
+    WriteMemory(MemoryData,DataInTmp,Address,HighBit,LowBit);
+    PortFlag.MemoryCurrent := CORRUPT;
+
+  WHEN 'e'    =>
+    -- Corrupting a word with 'X' based on data in
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrDatMem,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataInTmp,Address);
+    IF (DataInTmp /= DataInBus) THEN
+      DataInTmp := (OTHERS => 'X');
+      -- No need to CorruptMask
+      WriteMemory(MemoryData,DataInTmp,Address);
+    END IF;
+    PortFlag.MemoryCurrent := CORRUPT;
+
+  WHEN 'C'    =>
+    -- Corrupting a sub-word entire memory with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrAllSubMem,HeaderMsg,PortName);
+    END IF;
+    FOR i IN 0 TO MemoryData.NoOfWords-1 LOOP
+      ReadMemory(MemoryData,DataInTmp,i);
+      DataInTmp := DataInTmp XOR CorruptMask;
+      WriteMemory(MemoryData,DataInTmp,i,HighBit,LowBit);
+    END LOOP;
+    PortFlag.MemoryCurrent := CORRUPT;
+
+  WHEN 'L'    =>
+    -- Corrupting a sub-word in memory with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrWrdSubMem,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataInTmp,Address);
+    DataInTmp := DataInTmp XOR CorruptMask;
+    WriteMemory(MemoryData,DataInTmp,Address,HighBit,LowBit);
+    PortFlag.MemoryCurrent := CORRUPT;
+
+  WHEN 'D'    =>
+    -- Corrupting a single bit of a memory sub-word with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrBitSubMem,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataInTmp,Address);
+    DataInTmp := DataInTmp XOR CorruptMask;
+    WriteMemory(MemoryData,DataInTmp,Address,HighBit,LowBit);
+    PortFlag.MemoryCurrent := CORRUPT;
+
+  WHEN 'E'    =>
+    -- Corrupting a sub-word with 'X' based on data in
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrDatSubMem,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataInTmp,Address);
+    IF (DataInBus(HighBit DOWNTO LowBit) /= 
+      DataInTmp(HighBit DOWNTO LowBit)) THEN
+      DataInTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X');
+      WriteMemory(MemoryData,DataInTmp,Address,HighBit,LowBit);
+    END IF;
+    --PortFlag := WRITE;
+    PortFlag.MemoryCurrent := CORRUPT;
+
+  WHEN '0'    =>
+    -- Assigning low level to memory location
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrAsg0Mem,HeaderMsg,PortName);
+    END IF;
+    DataInTmp := (OTHERS => '0');
+    WriteMemory(MemoryData,DataInTmp,Address, HighBit, LowBit);
+    PortFlag.MemoryCurrent := WRITE;
+
+  WHEN '1'    =>
+    -- Assigning high level to memory location
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrAsg1Mem,HeaderMsg,PortName);
+    END IF;
+    DataInTmp := (OTHERS => '1');
+    WriteMemory(MemoryData,DataInTmp,Address, HighBit, LowBit);
+    PortFlag.MemoryCurrent := WRITE;
+
+  WHEN 'Z'    =>
+    -- Assigning high impedence to memory location
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrAsgZMem,HeaderMsg,PortName);
+    END IF;
+    DataInTmp := (OTHERS => 'Z');
+    WriteMemory(MemoryData,DataInTmp,Address, HighBit, LowBit);
+    PortFlag.MemoryCurrent := WRITE;
+
+  WHEN OTHERS =>
+    -- Unknown memory action
+    PortFlag.MemoryCurrent := UNDEF;
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrUnknMemDo,HeaderMsg,PortName);
+    END IF;
+
+  END CASE;
+
+  -- Note: HandleMemoryAction does not change the PortFlag.OutputDisable
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   HandleDataAction
+-- Parameters:  DataOutBus  - Output result of the data action
+--              MemoryData  - Input pointer to memory data structure
+--              PortFlag    - Indicates read/write mode of port
+--              CorruptMask - XOR'ed with DataInBus when corrupting
+--              DataInBus   - Current data bus in
+--              Address     - Current address integer
+--              HighBit     - Current address high bit
+--              LowBit      - Current address low bit
+--              MemoryTable - Input memory action table
+--              DataAction  - Data action to be performed
+--              PortName    - Port name string for messages
+--              HeaderMsg   - Header string for messages
+--              MsgOn       - Control message output
+-- Description: This procedure performs the specified data action based
+--              on the input memory data structure.  Checks whether
+--              the previous state is HighZ. If yes then portFlag
+--              should be NOCHANGE for VMPD to ignore IORetain
+--              corruption. The idea is that the first Z should be
+--              propagated but later ones should be ignored.
+-- ----------------------------------------------------------------------------
+PROCEDURE HandleDataAction (
+  VARIABLE DataOutBus     : INOUT std_logic_vector;
+  VARIABLE MemoryData     : INOUT VitalMemoryDataType;
+  VARIABLE PortFlag       : INOUT VitalPortFlagType;
+  CONSTANT CorruptMask    : IN std_logic_vector;
+  CONSTANT DataInBus      : IN std_logic_vector;
+  CONSTANT Address        : IN INTEGER;
+  CONSTANT HighBit        : IN NATURAL;
+  CONSTANT LowBit         : IN NATURAL;
+  CONSTANT MemoryTable    : IN VitalMemoryTableType;
+  CONSTANT DataAction     : IN VitalMemorySymbolType;
+  CONSTANT CallerName     : IN STRING;
+  CONSTANT PortName       : IN STRING := "";
+  CONSTANT HeaderMsg      : IN STRING := "";
+  CONSTANT MsgOn          : IN BOOLEAN := TRUE
+) IS
+
+  VARIABLE DataOutTmp : std_logic_vector(DataOutBus'RANGE)
+                          := DataOutBus;
+
+BEGIN
+
+  -- Handle the data action
+  CASE DataAction IS
+
+  WHEN 'l'    =>
+    -- Corrupting data out with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrWrdOut,HeaderMsg,PortName);
+    END IF;
+    DataOutTmp := (OTHERS => 'X');
+    -- No need to CorruptMask
+    PortFlag.DataCurrent := CORRUPT;
+
+  WHEN 'd'    =>
+    -- Corrupting a single bit of data out with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrBitOut,HeaderMsg,PortName);
+    END IF;
+    DataOutTmp(HighBit DOWNTO LowBit) := 
+      DataOutTmp(HighBit DOWNTO LowBit) XOR 
+      CorruptMask(HighBit DOWNTO LowBit);
+    PortFlag.DataCurrent := CORRUPT;
+
+  WHEN 'e'    =>
+    -- Corrupting data out with 'X' based on data in
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrDatOut,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataOutTmp,Address);
+    IF (DataOutTmp /= DataInBus) THEN
+      DataOutTmp := (OTHERS => 'X');
+      -- No need to CorruptMask
+    END IF;
+    PortFlag.DataCurrent := CORRUPT;
+
+  WHEN 'L'    =>
+    -- Corrupting data out sub-word with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrWrdSubOut,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataOutTmp,Address);
+    DataOutTmp(HighBit DOWNTO LowBit) := 
+      DataOutTmp(HighBit DOWNTO LowBit) XOR 
+      CorruptMask(HighBit DOWNTO LowBit);
+    PortFlag.DataCurrent := CORRUPT;
+
+  WHEN 'D'    =>
+    -- Corrupting a single bit of data out sub-word with 'X'
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrCrBitSubOut,HeaderMsg,PortName);
+    END IF;
+    DataOutTmp(HighBit DOWNTO LowBit) := 
+      DataOutTmp(HighBit DOWNTO LowBit) XOR 
+      CorruptMask(HighBit DOWNTO LowBit);
+    PortFlag.DataCurrent := CORRUPT;
+
+  WHEN 'E'    =>
+    -- Corrupting data out sub-word with 'X' based on data in
+    IF (MsgOn) THEN
+    PrintMemoryMessage(CallerName,ErrCrDatSubOut,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataOutTmp,Address);
+    IF (DataInBus(HighBit DOWNTO LowBit) /= 
+        DataOutTmp(HighBit DOWNTO LowBit)) THEN
+      DataOutTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X');
+      -- No need to CorruptMask
+    END IF;
+    PortFlag.DataCurrent := CORRUPT;
+
+  WHEN 'M'    =>
+    -- Implicit read from memory to data out
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrImplOut,HeaderMsg,PortName);
+    END IF;
+    PortFlag.DataCurrent := READ;
+
+  WHEN 'm'    =>
+    -- Reading data from memory to data out
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrReadOut,HeaderMsg,PortName);
+    END IF;
+    ReadMemory(MemoryData,DataOutTmp,Address);
+    PortFlag.DataCurrent := READ;
+
+  WHEN 't'    =>
+    -- Transfering from data in to data out
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrAssgOut,HeaderMsg,PortName);
+    END IF;
+    DataOutTmp := DataInBus;
+    PortFlag.DataCurrent := READ;
+
+  WHEN '0'    =>
+    -- Assigning low level to data out
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrAsg0Out,HeaderMsg,PortName);
+    END IF;
+    DataOutTmp := (OTHERS => '0');
+    PortFlag.DataCurrent := READ;
+
+  WHEN '1'    =>
+    -- Assigning high level to data out
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrAsg1Out,HeaderMsg,PortName);
+    END IF;
+    DataOutTmp := (OTHERS => '1');
+    PortFlag.DataCurrent := READ;
+
+  WHEN 'Z'    =>
+    -- Assigning high impedence to data out
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrAsgZOut,HeaderMsg,PortName);
+    END IF;
+    DataOutTmp := (OTHERS => 'Z');
+    PortFlag.DataCurrent := HIGHZ;
+
+  WHEN 'S'    =>
+    -- Keeping data out at steady value
+    PortFlag.OutputDisable := TRUE;
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrAsgSOut,HeaderMsg,PortName);
+    END IF;
+
+  WHEN OTHERS =>
+    -- Unknown data action
+    PortFlag.DataCurrent := UNDEF;
+    IF (MsgOn) THEN
+      PrintMemoryMessage(CallerName,ErrUnknDatDo,HeaderMsg,PortName);
+    END IF;
+
+  END CASE;
+
+  DataOutBus(HighBit DOWNTO LowBit) := DataOutTmp(HighBit DOWNTO LowBit);
+
+END;
+
+
+-- ----------------------------------------------------------------------------
+-- Memory Table Modeling Primitives
+-- ----------------------------------------------------------------------------
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalDeclareMemory
+-- Parameters:  NoOfWords          - Number of words in the memory
+--              NoOfBitsPerWord    - Number of bits per word in memory
+--              NoOfBitsPerSubWord - Number of bits per sub word
+--              MemoryLoadFile     - Name of data file to load
+-- Description: This function is intended to be used to initialize
+--              memory data declarations, i.e. to be executed duing
+--              simulation elaboration time.  Handles the allocation
+--              and initialization of memory for the memory data.
+--              Default NoOfBitsPerSubWord is NoOfBitsPerWord.
+-- ----------------------------------------------------------------------------
+IMPURE FUNCTION VitalDeclareMemory (
+  CONSTANT NoOfWords          : IN POSITIVE;
+  CONSTANT NoOfBitsPerWord    : IN POSITIVE;
+  CONSTANT MemoryLoadFile     : IN string := "";
+  CONSTANT BinaryLoadFile     : IN BOOLEAN := FALSE
+) RETURN VitalMemoryDataType IS
+  VARIABLE MemoryPtr      : VitalMemoryDataType;
+BEGIN
+  MemoryPtr := VitalDeclareMemory(
+    NoOfWords           => NoOfWords,
+    NoOfBitsPerWord     => NoOfBitsPerWord,
+    NoOfBitsPerSubWord  => NoOfBitsPerWord,
+    MemoryLoadFile      => MemoryLoadFile,
+    BinaryLoadFile      => BinaryLoadFile
+  );
+  RETURN MemoryPtr;
+END;
+
+-- ----------------------------------------------------------------------------
+IMPURE FUNCTION VitalDeclareMemory (
+  CONSTANT NoOfWords          : IN POSITIVE;
+  CONSTANT NoOfBitsPerWord    : IN POSITIVE;
+  CONSTANT NoOfBitsPerSubWord : IN POSITIVE;
+  CONSTANT MemoryLoadFile     : IN string := "";
+  CONSTANT BinaryLoadFile     : IN BOOLEAN := FALSE
+) RETURN VitalMemoryDataType IS
+  VARIABLE MemoryPtr      : VitalMemoryDataType;
+  VARIABLE BitsPerEnable  : NATURAL 
+                            := ((NoOfBitsPerWord-1)
+                                /NoOfBitsPerSubWord)+1;
+BEGIN
+  PrintMemoryMessage(MsgVDM,ErrInitMem);
+  MemoryPtr := new VitalMemoryArrayRecType '( 
+      NoOfWords           => NoOfWords,
+      NoOfBitsPerWord     => NoOfBitsPerWord,
+      NoOfBitsPerSubWord  => NoOfBitsPerSubWord,
+      NoOfBitsPerEnable   => BitsPerEnable,
+      MemoryArrayPtr      => NULL 
+    );
+  MemoryPtr.MemoryArrayPtr 
+    := new MemoryArrayType (0 to MemoryPtr.NoOfWords - 1);
+  FOR i IN 0 TO MemoryPtr.NoOfWords - 1 LOOP
+    MemoryPtr.MemoryArrayPtr(i) 
+      := new MemoryWordType (MemoryPtr.NoOfBitsPerWord - 1 DOWNTO 0);
+  END LOOP;
+  IF (MemoryLoadFile /= "") THEN
+    LoadMemory (MemoryPtr, MemoryLoadFile, BinaryLoadFile);
+  END IF;
+  RETURN MemoryPtr;
+END;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryTable
+-- Parameters:  DataOutBus     - Output candidate zero delay data bus out
+--              MemoryData     - Pointer to memory data structure
+--              PrevControls   - Previous data in for edge detection
+--              PrevEnableBus  - Previous enables for edge detection
+--              PrevDataInBus  - Previous data bus for edge detection
+--              PrevAddressBus - Previous address bus for edge detection
+--              PortFlag       - Indicates port operating mode
+--              PortFlagArray  - Vector form of PortFlag for sub-word
+--              Controls       - Agregate of scalar control lines
+--              EnableBus      - Concatenation of vector control lines
+--              DataInBus      - Input value of data bus in
+--              AddressBus     - Input value of address bus in
+--              AddressValue   - Decoded value of the AddressBus
+--              MemoryTable    - Input memory action table
+--              PortType       - The type of port (currently not used)
+--              PortName       - Port name string for messages
+--              HeaderMsg      - Header string for messages
+--              MsgOn          - Control the generation of messages
+--              MsgSeverity    - Control level of message generation
+-- Description: This procedure implements the majority of the memory 
+--              modeling functionality via lookup of the memory action
+--              tables and performing the specified actions if matches
+--              are found, or the default actions otherwise.  The
+--              overloadings are provided for the word and sub-word
+--              (using the EnableBus and PortFlagArray arguments) addressing
+--              cases.
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryTable (
+  VARIABLE DataOutBus     : INOUT std_logic_vector;
+  VARIABLE MemoryData     : INOUT VitalMemoryDataType;
+  VARIABLE PrevControls   : INOUT std_logic_vector;
+  VARIABLE PrevDataInBus  : INOUT std_logic_vector;
+  VARIABLE PrevAddressBus : INOUT std_logic_vector;
+  VARIABLE PortFlag       : INOUT VitalPortFlagVectorType;
+  CONSTANT Controls       : IN std_logic_vector;
+  CONSTANT DataInBus      : IN std_logic_vector;
+  CONSTANT AddressBus     : IN std_logic_vector;
+  VARIABLE AddressValue   : INOUT VitalAddressValueType;
+  CONSTANT MemoryTable    : IN VitalMemoryTableType;
+  CONSTANT PortType       : IN VitalPortType := UNDEF;
+  CONSTANT PortName       : IN STRING := "";
+  CONSTANT HeaderMsg      : IN STRING := "";
+  CONSTANT MsgOn          : IN BOOLEAN := TRUE;
+  CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+) IS
+
+  VARIABLE DataOutTmp     : std_logic_vector(DataOutBus'RANGE)
+                            := DataOutBus;
+  VARIABLE MemoryAction   : VitalMemorySymbolType;
+  VARIABLE DataAction     : VitalMemorySymbolType;
+  VARIABLE HighBit        : NATURAL := MemoryData.NoOfBitsPerWord-1;
+  VARIABLE LowBit         : NATURAL := 0;
+  VARIABLE Address        : INTEGER := 0;
+  VARIABLE PortFlagTmp    : VitalPortFlagType;
+  VARIABLE AddrFlag       : VitalMemorySymbolType := 'g';  -- good addr
+  VARIABLE DataFlag       : VitalMemorySymbolType := 'g';  -- good data
+  VARIABLE MemCorruptMask : std_logic_vector (DataOutBus'RANGE);
+  VARIABLE DatCorruptMask : std_logic_vector (DataOutBus'RANGE);
+
+BEGIN
+
+  -- Optimize for case when all current inputs are same as previous
+  IF (PrevDataInBus = DataInBus 
+      AND PrevAddressBus = AddressBus 
+      AND PrevControls = Controls
+      AND PortFlag(0).MemoryCurrent = PortFlag(0).MemoryPrevious
+      AND PortFlag(0).DataCurrent = PortFlag(0).DataPrevious) THEN
+    PortFlag(0).OutputDisable := TRUE;
+    RETURN;
+  END IF;
+
+  PortFlag(0).DataPrevious := PortFlag(0).DataCurrent;
+  PortFlag(0).MemoryPrevious := PortFlag(0).MemoryCurrent;
+  PortFlag(0).OutputDisable := FALSE;
+  PortFlagTmp := PortFlag(0);
+
+  -- Convert address bus to integer value and table lookup flag
+  DecodeAddress(
+    Address         => Address             ,
+    AddrFlag        => AddrFlag            ,
+    MemoryData      => MemoryData          ,
+    PrevAddressBus  => PrevAddressBus      ,
+    AddressBus      => AddressBus          
+  );
+
+  -- Interpret data bus as a table lookup flag
+  DecodeData (
+    DataFlag        => DataFlag           ,
+    PrevDataInBus   => PrevDataInBus      ,
+    DataInBus       => DataInBus          ,
+    HighBit         => HighBit            ,
+    LowBit          => LowBit             
+  );
+
+  -- Lookup memory and data actions
+  MemoryTableLookUp(  
+    MemoryAction        => MemoryAction     ,
+    DataAction          => DataAction       ,
+    MemoryCorruptMask   => MemCorruptMask   ,
+    DataCorruptMask     => DatCorruptMask   ,
+    PrevControls        => PrevControls     ,
+    Controls            => Controls         ,
+    AddrFlag            => AddrFlag         ,
+    DataFlag            => DataFlag         ,
+    MemoryTable         => MemoryTable      ,
+    PortName            => PortName         ,
+    HeaderMsg           => HeaderMsg        ,
+    MsgOn               => MsgOn            
+  );
+
+  -- Handle data action before memory action
+  -- This allows reading previous memory contents
+  HandleDataAction(
+    DataOutBus      => DataOutTmp       ,
+    MemoryData      => MemoryData       ,
+    PortFlag        => PortFlagTmp      ,
+    CorruptMask     => DatCorruptMask   ,
+    DataInBus       => DataInBus        ,
+    Address         => Address          ,
+    HighBit         => HighBit          ,
+    LowBit          => LowBit           ,
+    MemoryTable     => MemoryTable      ,
+    DataAction      => DataAction       ,
+    CallerName      => MsgVMT           ,
+    PortName        => PortName         ,
+    HeaderMsg       => HeaderMsg        ,
+    MsgOn           => MsgOn            
+  );
+
+  HandleMemoryAction(
+    MemoryData      => MemoryData       ,
+    PortFlag        => PortFlagTmp      ,
+    CorruptMask     => MemCorruptMask   ,
+    DataInBus       => DataInBus        ,
+    Address         => Address          ,
+    HighBit         => HighBit          ,
+    LowBit          => LowBit           ,
+    MemoryTable     => MemoryTable      ,
+    MemoryAction    => MemoryAction     ,
+    CallerName      => MsgVMT           ,
+    PortName        => PortName         ,
+    HeaderMsg       => HeaderMsg        ,
+    MsgOn           => MsgOn            
+  );
+
+  -- Set the output PortFlag(0) value 
+  IF (DataAction = 'S') THEN
+    PortFlagTmp.OutputDisable := TRUE;
+  END IF;
+  IF (PortFlagTmp.DataCurrent = PortFlagTmp.DataPrevious
+      AND PortFlagTmp.DataCurrent = HIGHZ) THEN
+    PortFlagTmp.OutputDisable := TRUE;
+  END IF;
+  PortFlag(0) := PortFlagTmp;
+
+  -- Set previous values for subsequent edge detection
+  PrevControls := Controls;
+  PrevDataInBus := DataInBus;
+  PrevAddressBus := AddressBus;
+
+  -- Set the candidate zero delay return value
+  DataOutBus := DataOutTmp;
+
+  -- Set the output AddressValue for VitalMemoryCrossPorts
+  AddressValue := Address;
+
+END VitalMemoryTable;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryTable (
+  VARIABLE DataOutBus     : INOUT std_logic_vector;
+  VARIABLE MemoryData     : INOUT VitalMemoryDataType;
+  VARIABLE PrevControls   : INOUT std_logic_vector;
+  VARIABLE PrevEnableBus  : INOUT std_logic_vector;
+  VARIABLE PrevDataInBus  : INOUT std_logic_vector;
+  VARIABLE PrevAddressBus : INOUT std_logic_vector;
+  VARIABLE PortFlagArray  : INOUT VitalPortFlagVectorType;
+  CONSTANT Controls       : IN std_logic_vector;
+  CONSTANT EnableBus      : IN std_logic_vector;
+  CONSTANT DataInBus      : IN std_logic_vector;
+  CONSTANT AddressBus     : IN std_logic_vector;
+  VARIABLE AddressValue   : INOUT VitalAddressValueType;
+  CONSTANT MemoryTable    : IN VitalMemoryTableType;
+  CONSTANT PortType       : IN VitalPortType := UNDEF;
+  CONSTANT PortName       : IN STRING := "";
+  CONSTANT HeaderMsg      : IN STRING := "";
+  CONSTANT MsgOn          : IN BOOLEAN := TRUE;
+  CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+) IS
+
+  VARIABLE BitsPerWord    : NATURAL := MemoryData.NoOfBitsPerWord;
+  VARIABLE BitsPerSubWord : NATURAL := MemoryData.NoOfBitsPerSubWord;
+  VARIABLE BitsPerEnable  : NATURAL := MemoryData.NoOfBitsPerEnable;
+  VARIABLE DataOutTmp     : std_logic_vector(DataOutBus'RANGE)
+  := DataOutBus;
+  VARIABLE MemoryAction   : VitalMemorySymbolType;
+  VARIABLE DataAction     : VitalMemorySymbolType;
+  VARIABLE HighBit        : NATURAL := BitsPerSubWord-1;
+  VARIABLE LowBit         : NATURAL := 0;
+  VARIABLE Address        : INTEGER := 0;
+  VARIABLE PortFlagTmp    : VitalPortFlagType;
+  VARIABLE AddrFlag       : VitalMemorySymbolType := 'g';  -- good addr
+  VARIABLE DataFlag       : VitalMemorySymbolType := 'g';  -- good data
+  VARIABLE MemCorruptMask : std_logic_vector (DataOutBus'RANGE);
+  VARIABLE DatCorruptMask : std_logic_vector (DataOutBus'RANGE);
+
+BEGIN
+
+  -- Optimize for case when all current inputs are same as previous
+  IF (PrevDataInBus = DataInBus 
+      AND PrevAddressBus = AddressBus 
+      AND PrevControls = Controls) THEN
+    CheckFlags:
+    FOR i IN 0 TO BitsPerEnable-1 LOOP
+      IF (PortFlagArray(i).MemoryCurrent /= PortFlagArray(i).MemoryPrevious
+          OR  PortFlagArray(i).DataCurrent /= PortFlagArray(i).DataPrevious) THEN
+        EXIT CheckFlags;
+      END IF;
+      IF (i = BitsPerEnable-1) THEN
+        FOR j IN 0 TO BitsPerEnable-1 LOOP
+          PortFlagArray(j).OutputDisable := TRUE;
+        END LOOP;
+        RETURN;
+      END IF;
+    END LOOP;
+  END IF;
+
+  -- Convert address bus to integer value and table lookup flag
+  DecodeAddress(
+    Address         => Address,
+    AddrFlag        => AddrFlag,
+    MemoryData      => MemoryData,
+    PrevAddressBus  => PrevAddressBus,
+    AddressBus      => AddressBus     
+  );
+
+  -- Perform independent operations for each sub-word
+  FOR i IN 0 TO BitsPerEnable-1 LOOP
+
+    -- Set the output PortFlag(i) value
+    PortFlagArray(i).DataPrevious := PortFlagArray(i).DataCurrent;
+    PortFlagArray(i).MemoryPrevious := PortFlagArray(i).MemoryCurrent;
+    PortFlagArray(i).OutputDisable := FALSE;
+    PortFlagTmp := PortFlagArray(i);
+
+    -- Interpret data bus as a table lookup flag
+    DecodeData (
+      DataFlag        => DataFlag         ,
+      PrevDataInBus   => PrevDataInBus    ,
+      DataInBus       => DataInBus        ,
+      HighBit         => HighBit          ,
+      LowBit          => LowBit           
+    );
+
+    -- Lookup memory and data actions
+    MemoryTableLookUp(  
+      MemoryAction        => MemoryAction     ,
+      DataAction          => DataAction       ,
+      MemoryCorruptMask   => MemCorruptMask   ,
+      DataCorruptMask     => DatCorruptMask   ,
+      PrevControls        => PrevControls     ,
+      PrevEnableBus       => PrevEnableBus    ,
+      Controls            => Controls         ,
+      EnableBus           => EnableBus        ,
+      EnableIndex         => i                ,
+      BitsPerWord         => BitsPerWord      ,
+      BitsPerSubWord      => BitsPerSubWord   ,
+      BitsPerEnable       => BitsPerEnable    ,
+      AddrFlag            => AddrFlag         ,
+      DataFlag            => DataFlag         ,
+      MemoryTable         => MemoryTable      ,
+      PortName            => PortName         ,
+      HeaderMsg           => HeaderMsg        ,
+      MsgOn               => MsgOn            
+    );
+
+    -- Handle data action before memory action
+    -- This allows reading previous memory contents
+    HandleDataAction(
+      DataOutBus      => DataOutTmp       ,
+      MemoryData      => MemoryData       ,
+      PortFlag        => PortFlagTmp      ,
+      CorruptMask     => DatCorruptMask   ,
+      DataInBus       => DataInBus        ,
+      Address         => Address          ,
+      HighBit         => HighBit          ,
+      LowBit          => LowBit           ,
+      MemoryTable     => MemoryTable      ,
+      DataAction      => DataAction       ,
+      CallerName      => MsgVMT           ,
+      PortName        => PortName         ,
+      HeaderMsg       => HeaderMsg        ,
+      MsgOn           => MsgOn            
+    );
+
+    HandleMemoryAction(
+      MemoryData      => MemoryData       ,
+      PortFlag        => PortFlagTmp      ,
+      CorruptMask     => MemCorruptMask   ,
+      DataInBus       => DataInBus        ,
+      Address         => Address          ,
+      HighBit         => HighBit          ,
+      LowBit          => LowBit           ,
+      MemoryTable     => MemoryTable      ,
+      MemoryAction    => MemoryAction     ,
+      CallerName      => MsgVMT           ,
+      PortName        => PortName         ,
+      HeaderMsg       => HeaderMsg        ,
+      MsgOn           => MsgOn            
+    );
+
+    -- Set the output PortFlag(i) value 
+    IF (DataAction = 'S') THEN
+      PortFlagTmp.OutputDisable := TRUE;
+    END IF;
+    IF (PortFlagTmp.DataCurrent = PortFlagTmp.DataPrevious
+        AND PortFlagTmp.DataCurrent = HIGHZ) THEN
+      PortFlagTmp.OutputDisable := TRUE;
+    END IF;
+    PortFlagArray(i) := PortFlagTmp;
+
+    IF (i < BitsPerEnable-1) THEN
+      -- Calculate HighBit and LowBit
+      LowBit := LowBit + BitsPerSubWord;
+      IF (LowBit > BitsPerWord) THEN
+        LowBit := BitsPerWord;
+      END IF;
+      HighBit := LowBit + BitsPerSubWord;
+      IF (HighBit > BitsPerWord) THEN
+        HighBit := BitsPerWord;
+      ELSE
+        HighBit := HighBit - 1;
+      END IF;
+    END IF;
+
+  END LOOP;
+
+  -- Set previous values for subsequent edge detection
+  PrevControls := Controls;
+  PrevEnableBus := EnableBus;
+  PrevDataInBus := DataInBus;
+  PrevAddressBus := AddressBus;
+
+  -- Set the candidate zero delay return value
+  DataOutBus := DataOutTmp;
+
+  -- Set the output AddressValue for VitalMemoryCrossPorts
+  AddressValue := Address;
+
+END VitalMemoryTable;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryCrossPorts
+-- Parameters:  DataOutBus     - Output candidate zero delay data bus out
+--              MemoryData     - Pointer to memory data structure
+--              SamePortFlag   - Operating mode for same port
+--              SamePortAddressValue  - Operating modes for cross ports
+--              CrossPortAddressArray - Decoded AddressBus for cross ports
+--              CrossPortMode  - Write contention and crossport read control
+--              PortName       - Port name string for messages
+--              HeaderMsg      - Header string for messages
+--              MsgOn          - Control the generation of messages
+-- Description: These procedures control the effect of memory operations
+--              on a given port due to operations on other ports in a
+--              multi-port memory.
+--              This includes data write through when reading and writing 
+--              to the same address, as well as write contention when
+--              there are multiple write to the same address.
+--              If addresses do not match then data bus is unchanged. 
+--              The DataOutBus can be diabled with 'Z' value.
+--              If the WritePortFlag is 'CORRUPT', that would mean
+--              that the whole memory is corrupted. So, for corrupting
+--              the Read port, the Addresses need not be compared. 
+--
+--     CrossPortMode Enum            Description
+-- 1.  CpRead                        Allows Cross Port Read Only
+--                                   No contention checking.
+-- 2.  WriteContention               Allows for write contention checks 
+--                                   only between multiple write ports
+-- 3.  ReadWriteContention           Allows contention between read and 
+--                                   write ports. The action is to corrupt 
+--                                   the memory and the output bus.
+-- 4.  CpReadAndWriteContention      Is a combination of 1 & 2
+-- 5.  CpReadAndReadContention       Allows contention between read and
+--                                   write ports. The action is to corrupt 
+--                                   the dataout bus only. The cp read is 
+--                                   performed if not contending.
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryCrossPorts (
+  VARIABLE DataOutBus             : INOUT std_logic_vector;
+  VARIABLE MemoryData             : INOUT VitalMemoryDataType;
+  VARIABLE SamePortFlag           : INOUT VitalPortFlagVectorType;
+  CONSTANT SamePortAddressValue   : IN VitalAddressValueType;
+  CONSTANT CrossPortFlagArray     : IN VitalPortFlagVectorType;
+  CONSTANT CrossPortAddressArray  : IN VitalAddressValueVectorType;
+  CONSTANT CrossPortMode          : IN VitalCrossPortModeType 
+                                        := CpReadAndWriteContention;
+  CONSTANT PortName               : IN STRING := "";
+  CONSTANT HeaderMsg              : IN STRING := "";
+  CONSTANT MsgOn                  : IN BOOLEAN := TRUE
+) IS
+
+  VARIABLE BitsPerWord    : NATURAL := MemoryData.NoOfBitsPerWord;
+  VARIABLE BitsPerSubWord : NATURAL := MemoryData.NoOfBitsPerSubWord;
+  VARIABLE BitsPerEnable  : NATURAL := MemoryData.NoOfBitsPerEnable;
+  VARIABLE DataOutTmp : std_logic_vector(DataOutBus'RANGE) := (OTHERS => 'Z');
+  VARIABLE MemoryTmp  : std_logic_vector(DataOutBus'RANGE);
+  VARIABLE CrossPorts : NATURAL := CrossPortAddressArray'LENGTH;
+  VARIABLE LowBit     : NATURAL := 0;
+  VARIABLE HighBit    : NATURAL := BitsPerSubWord-1;
+  VARIABLE Address    : VitalAddressValueType := SamePortAddressValue;
+  VARIABLE AddressJ   : VitalAddressValueType;
+  VARIABLE AddressK   : VitalAddressValueType;
+  VARIABLE PortFlagI  : VitalPortFlagType;
+  VARIABLE PortFlagIJ : VitalPortFlagType;
+  VARIABLE PortFlagIK : VitalPortFlagType;
+  VARIABLE DoCpRead   : BOOLEAN := FALSE;
+  VARIABLE DoWrCont   : BOOLEAN := FALSE;
+  VARIABLE DoCpCont   : BOOLEAN := FALSE;
+  VARIABLE DoRdWrCont : BOOLEAN := FALSE;
+  VARIABLE CpWrCont   : BOOLEAN := FALSE;
+  VARIABLE ModeWrCont : BOOLEAN := 
+                          (CrossPortMode=WriteContention) OR  
+                          (CrossPortMode=CpReadAndWriteContention);
+  VARIABLE ModeCpRead : BOOLEAN := 
+                          (CrossPortMode=CpRead) OR   
+                          (CrossPortMode=CpReadAndWriteContention);
+  VARIABLE ModeCpCont : BOOLEAN := (CrossPortMode=ReadWriteContention);
+  VARIABLE ModeRdWrCont : BOOLEAN := (CrossPortMode=CpReadAndReadContention);
+
+BEGIN
+
+  -- Check for disabled port (i.e. OTHERS => 'Z')
+  IF (DataOutBus = DataOutTmp) THEN
+    RETURN;
+  ELSE
+    DataOutTmp := DataOutBus;
+  END IF;
+
+  -- Check for error in address
+  IF (Address < 0) THEN
+    RETURN;
+  END IF;
+
+  ReadMemory(MemoryData,MemoryTmp,Address);
+
+  SubWordLoop: -- For each slice of the sub-word I
+  FOR i IN 0 TO BitsPerEnable-1 LOOP
+    PortFlagI := SamePortFlag(i);
+
+    -- For each cross port J: check with same port address
+    FOR j IN 0 TO CrossPorts-1 LOOP
+      PortFlagIJ := CrossPortFlagArray(i+j*BitsPerEnable);
+      AddressJ := CrossPortAddressArray(j);
+      IF (AddressJ < 0) THEN
+        NEXT;
+      END IF;
+      DoWrCont :=  (Address    = AddressJ)  AND
+                   (ModeWrCont = TRUE)      AND
+                  ((PortFlagI.MemoryCurrent  = WRITE)     OR 
+                   (PortFlagI.MemoryCurrent  = CORRUPT))  AND
+                  ((PortFlagIJ.MemoryCurrent = WRITE)     OR
+                   (PortFlagIJ.MemoryCurrent = CORRUPT))  ;
+      DoCpRead :=  (Address    = AddressJ)  AND
+                   (ModeCpRead = TRUE)      AND
+                  ((PortFlagI.MemoryCurrent  = READ)      OR 
+                   (PortFlagI.OutputDisable  = TRUE))     AND 
+                  ((PortFlagIJ.MemoryCurrent = WRITE)     OR
+                   (PortFlagIJ.MemoryCurrent = CORRUPT))  ;
+      DoCpCont :=  (Address    = AddressJ)  AND
+                   (ModeCpCont = TRUE)      AND
+                  ((PortFlagI.MemoryCurrent  = READ)      OR 
+                   (PortFlagI.OutputDisable  = TRUE))     AND 
+                  ((PortFlagIJ.MemoryCurrent = WRITE)     OR
+                   (PortFlagIJ.MemoryCurrent = CORRUPT))  ;
+      DoRdWrCont:= (Address    = AddressJ)  AND
+                   (ModeRdWrCont = TRUE)    AND
+                  ((PortFlagI.MemoryCurrent  = READ)      OR 
+                   (PortFlagI.OutputDisable  = TRUE))     AND 
+                  ((PortFlagIJ.MemoryCurrent = WRITE)     OR
+                   (PortFlagIJ.MemoryCurrent = CORRUPT))  ;
+      IF (DoWrCont OR DoCpCont) THEN
+        -- Corrupt dataout and memory
+        MemoryTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X');
+        DataOutTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X');
+        SamePortFlag(i).MemoryCurrent := CORRUPT;
+        SamePortFlag(i).DataCurrent := CORRUPT;
+        SamePortFlag(i).OutputDisable := FALSE;
+        EXIT;
+      END IF;
+      IF (DoCpRead) THEN
+        -- Update dataout with memory
+        DataOutTmp(HighBit DOWNTO LowBit) :=
+        MemoryTmp(HighBit DOWNTO LowBit);
+        SamePortFlag(i).MemoryCurrent := READ;
+        SamePortFlag(i).DataCurrent := READ;
+        SamePortFlag(i).OutputDisable := FALSE;
+        EXIT;
+      END IF;
+      IF (DoRdWrCont) THEN
+        -- Corrupt dataout only
+        DataOutTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X');
+        SamePortFlag(i).DataCurrent := CORRUPT;
+        SamePortFlag(i).OutputDisable := FALSE;
+        EXIT;
+      END IF;
+    END LOOP;
+
+    IF (i < BitsPerEnable-1) THEN
+      -- Calculate HighBit and LowBit
+      LowBit := LowBit + BitsPerSubWord;
+      IF (LowBit > BitsPerWord) THEN
+        LowBit := BitsPerWord;
+      END IF;
+      HighBit := LowBit + BitsPerSubWord;
+      IF (HighBit > BitsPerWord) THEN
+        HighBit := BitsPerWord;
+      ELSE
+        HighBit := HighBit - 1;
+      END IF;
+    END IF;
+
+  END LOOP;   -- SubWordLoop
+
+  DataOutBus := DataOutTmp;
+
+  IF (DoWrCont) THEN
+    IF (MsgOn) THEN
+      PrintMemoryMessage(MsgVMCP,ErrMcpWrCont,HeaderMsg,PortName);
+    END IF;
+    WriteMemory(MemoryData,MemoryTmp,Address);
+  END IF;
+
+  IF (DoCpCont) THEN
+    IF (MsgOn) THEN
+      PrintMemoryMessage(MsgVMCP,ErrMcpCpCont,HeaderMsg,PortName);
+    END IF;
+    WriteMemory(MemoryData,MemoryTmp,Address);
+  END IF;
+
+  IF (DoCpRead) THEN
+    IF (MsgOn) THEN
+      PrintMemoryMessage(MsgVMCP,ErrMcpCpRead,HeaderMsg,PortName);
+    END IF;
+  END IF;
+
+  IF (DoRdWrCont) THEN
+    IF (MsgOn) THEN
+      PrintMemoryMessage(MsgVMCP,ErrMcpRdWrCo,HeaderMsg,PortName);
+    END IF;
+  END IF;
+
+END VitalMemoryCrossPorts;
+
+-- ----------------------------------------------------------------------------
+PROCEDURE VitalMemoryCrossPorts (
+  VARIABLE MemoryData             : INOUT VitalMemoryDataType;
+  CONSTANT CrossPortFlagArray     : IN VitalPortFlagVectorType;
+  CONSTANT CrossPortAddressArray  : IN VitalAddressValueVectorType;
+  CONSTANT HeaderMsg              : IN STRING := "";
+  CONSTANT MsgOn                  : IN BOOLEAN := TRUE
+) IS
+
+  VARIABLE BitsPerWord    : NATURAL := MemoryData.NoOfBitsPerWord;
+  VARIABLE BitsPerSubWord : NATURAL := MemoryData.NoOfBitsPerSubWord;
+  VARIABLE BitsPerEnable  : NATURAL := MemoryData.NoOfBitsPerEnable;
+  VARIABLE MemoryTmp  : std_logic_vector(BitsPerWord-1 DOWNTO 0);
+  VARIABLE CrossPorts : NATURAL := CrossPortAddressArray'LENGTH;
+  VARIABLE LowBit     : NATURAL := 0;
+  VARIABLE HighBit    : NATURAL := BitsPerSubWord-1;
+  VARIABLE AddressJ   : VitalAddressValueType;
+  VARIABLE AddressK   : VitalAddressValueType;
+  VARIABLE PortFlagIJ : VitalPortFlagType;
+  VARIABLE PortFlagIK : VitalPortFlagType;
+  VARIABLE CpWrCont   : BOOLEAN := FALSE;
+
+BEGIN
+
+  SubWordLoop: -- For each slice of the sub-word I
+  FOR i IN 0 TO BitsPerEnable-1 LOOP
+
+    -- For each cross port J: check with each cross port K
+    FOR j IN 0 TO CrossPorts-1 LOOP
+      PortFlagIJ := CrossPortFlagArray(i+j*BitsPerEnable);
+      AddressJ := CrossPortAddressArray(j);
+      -- Check for error in address
+      IF (AddressJ < 0) THEN
+        NEXT;
+      END IF;
+      ReadMemory(MemoryData,MemoryTmp,AddressJ);
+      -- For each cross port K
+      FOR k IN 0 TO CrossPorts-1 LOOP
+        IF (k <= j) THEN
+          NEXT;
+        END IF;
+        PortFlagIK := CrossPortFlagArray(i+k*BitsPerEnable);
+        AddressK := CrossPortAddressArray(k);
+        -- Check for error in address
+        IF (AddressK < 0) THEN
+          NEXT;
+        END IF;
+        CpWrCont := ( (AddressJ   = AddressK) AND
+                      (PortFlagIJ.MemoryCurrent = WRITE)    AND 
+                      (PortFlagIK.MemoryCurrent = WRITE) ) OR
+                    ( (PortFlagIJ.MemoryCurrent = WRITE)    AND
+                      (PortFlagIK.MemoryCurrent = CORRUPT) ) OR
+                    ( (PortFlagIJ.MemoryCurrent = CORRUPT) AND
+                      (PortFlagIK.MemoryCurrent = WRITE) ) OR
+                    ( (PortFlagIJ.MemoryCurrent = CORRUPT) AND
+                      (PortFlagIK.MemoryCurrent = CORRUPT) ) ;
+        IF (CpWrCont) THEN
+          -- Corrupt memory only
+          MemoryTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X');
+          EXIT;
+        END IF;
+      END LOOP;   -- FOR k IN 0 TO CrossPorts-1 LOOP
+      IF (CpWrCont = TRUE) THEN
+        IF (MsgOn) THEN
+          PrintMemoryMessage(MsgVMCP,ErrMcpCpWrCont,HeaderMsg);
+        END IF;
+        WriteMemory(MemoryData,MemoryTmp,AddressJ);
+      END IF;
+    END LOOP;   -- FOR j IN 0 TO CrossPorts-1 LOOP
+
+    IF (i < BitsPerEnable-1) THEN
+      -- Calculate HighBit and LowBit
+      LowBit := LowBit + BitsPerSubWord;
+      IF (LowBit > BitsPerWord) THEN
+        LowBit := BitsPerWord;
+      END IF;
+      HighBit := LowBit + BitsPerSubWord;
+      IF (HighBit > BitsPerWord) THEN
+        HighBit := BitsPerWord;
+      ELSE
+        HighBit := HighBit - 1;
+      END IF;
+    END IF;
+  END LOOP;   -- SubWordLoop
+
+END VitalMemoryCrossPorts;
+
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryViolation
+-- Parameters:  DataOutBus        - Output zero delay data bus out
+--              MemoryData        - Pointer to memory data structure
+--              PortFlag          - Indicates port operating mode
+--              TimingDataArray   - This is currently not used (comment out) 
+--              ViolationArray    - Aggregation of violation variables
+--              DataInBus         - Input value of data bus in
+--              AddressBus        - Input value of address bus in
+--              AddressValue      - Decoded value of the AddressBus
+--              ViolationTable    - Input memory violation table
+--              PortName          - Port name string for messages
+--              HeaderMsg         - Header string for messages
+--              MsgOn             - Control the generation of messages
+--              MsgSeverity       - Control level of message generation
+-- Description: This procedure is intended to implement all actions on the
+--              memory contents and data out bus as a result of timing viols.
+--              It uses the memory action table to perform various corruption
+--              policies specified by the user. 
+-- ----------------------------------------------------------------------------
+
+PROCEDURE VitalMemoryViolation (
+  VARIABLE DataOutBus           : INOUT std_logic_vector;
+  VARIABLE MemoryData           : INOUT VitalMemoryDataType;
+  VARIABLE PortFlag             : INOUT VitalPortFlagVectorType;
+  CONSTANT DataInBus            : IN std_logic_vector;
+  CONSTANT AddressValue         : IN VitalAddressValueType;
+  CONSTANT ViolationFlags       : IN std_logic_vector;
+  CONSTANT ViolationFlagsArray  : IN X01ArrayT;
+  CONSTANT ViolationSizesArray  : IN VitalMemoryViolFlagSizeType;
+  CONSTANT ViolationTable       : IN VitalMemoryTableType;
+  CONSTANT PortType             : IN VitalPortType; 
+  CONSTANT PortName             : IN STRING := "";
+  CONSTANT HeaderMsg            : IN STRING := "";
+  CONSTANT MsgOn                : IN BOOLEAN := TRUE;
+  CONSTANT MsgSeverity          : IN SEVERITY_LEVEL := WARNING
+) IS
+
+  VARIABLE BitsPerWord    : NATURAL := MemoryData.NoOfBitsPerWord;
+  VARIABLE BitsPerSubWord : NATURAL := MemoryData.NoOfBitsPerSubWord;
+  VARIABLE BitsPerEnable  : NATURAL := MemoryData.NoOfBitsPerEnable;
+  VARIABLE DataOutTmp     : std_logic_vector(DataOutBus'RANGE)
+                            := DataOutBus;
+  VARIABLE MemoryAction   : VitalMemorySymbolType;
+  VARIABLE DataAction     : VitalMemorySymbolType;
+  -- VMT relies on the corrupt masks so HighBit/LowBit are full word
+  VARIABLE HighBit        : NATURAL := BitsPerWord-1;
+  VARIABLE LowBit         : NATURAL := 0;
+  VARIABLE PortFlagTmp    : VitalPortFlagType;
+  VARIABLE VFlagArrayTmp  : std_logic_vector 
+                            (0 TO ViolationFlagsArray'LENGTH-1);
+  VARIABLE MemCorruptMask : std_logic_vector (DataOutBus'RANGE);
+  VARIABLE DatCorruptMask : std_logic_vector (DataOutBus'RANGE);
+
+BEGIN
+
+  -- Don't do anything if given an error address
+  IF (AddressValue < 0) THEN
+    RETURN;
+  END IF;
+
+  FOR i IN ViolationFlagsArray'RANGE LOOP
+    VFlagArrayTmp(i) := ViolationFlagsArray(i);
+  END LOOP;
+
+  -- Lookup memory and data actions
+  ViolationTableLookUp(  
+    MemoryAction        => MemoryAction         ,
+    DataAction          => DataAction           ,
+    MemoryCorruptMask   => MemCorruptMask       ,
+    DataCorruptMask     => DatCorruptMask       ,
+    ViolationFlags      => ViolationFlags       ,
+    ViolationFlagsArray => VFlagArrayTmp        ,
+    ViolationSizesArray => ViolationSizesArray  ,
+    ViolationTable      => ViolationTable       ,
+    BitsPerWord         => BitsPerWord          ,
+    BitsPerSubWord      => BitsPerSubWord       ,
+    BitsPerEnable       => BitsPerEnable        ,
+    PortName            => PortName             ,
+    HeaderMsg           => HeaderMsg            ,
+    MsgOn               => MsgOn            
+  );
+
+  -- Need to read incoming PF value (was not before)
+  PortFlagTmp := PortFlag(0);
+
+  IF (PortType = READ OR PortType = RDNWR) THEN
+    -- Handle data action before memory action
+    -- This allows reading previous memory contents
+    HandleDataAction(
+      DataOutBus      => DataOutTmp       ,
+      MemoryData      => MemoryData       ,
+      PortFlag        => PortFlagTmp      ,
+      CorruptMask     => DatCorruptMask   ,
+      DataInBus       => DataInBus        ,
+      Address         => AddressValue     ,
+      HighBit         => HighBit          ,
+      LowBit          => LowBit           ,
+      MemoryTable     => ViolationTable   ,
+      DataAction      => DataAction       ,
+      CallerName      => MsgVMV           ,
+      PortName        => PortName         ,
+      HeaderMsg       => HeaderMsg        ,
+      MsgOn           => MsgOn            
+    );
+  END IF;
+
+  IF (PortType = WRITE OR PortType = RDNWR) THEN
+    HandleMemoryAction(
+      MemoryData      => MemoryData       ,
+      PortFlag        => PortFlagTmp      ,
+      CorruptMask     => MemCorruptMask   ,
+      DataInBus       => DataInBus        ,
+      Address         => AddressValue     ,
+      HighBit         => HighBit          ,
+      LowBit          => LowBit           ,
+      MemoryTable     => ViolationTable   ,
+      MemoryAction    => MemoryAction     ,
+      CallerName      => MsgVMV           ,
+      PortName        => PortName         ,
+      HeaderMsg       => HeaderMsg        ,
+      MsgOn           => MsgOn            
+    );
+  END IF;
+
+  -- Check if we need to turn off PF.OutputDisable
+  IF (DataAction /= 'S') THEN
+    PortFlagTmp.OutputDisable := FALSE;
+    -- Set the output PortFlag(0) value 
+    -- Note that all bits of PortFlag get PortFlagTmp
+    FOR i IN PortFlag'RANGE LOOP
+      PortFlag(i) := PortFlagTmp;
+    END LOOP;
+  END IF;
+
+  -- Set the candidate zero delay return value
+  DataOutBus := DataOutTmp;
+
+END;
+
+PROCEDURE VitalMemoryViolation (
+  VARIABLE DataOutBus           : INOUT std_logic_vector;
+  VARIABLE MemoryData           : INOUT VitalMemoryDataType;
+  VARIABLE PortFlag             : INOUT VitalPortFlagVectorType;
+  CONSTANT DataInBus            : IN std_logic_vector;
+  CONSTANT AddressValue         : IN VitalAddressValueType;
+  CONSTANT ViolationFlags       : IN std_logic_vector;
+  CONSTANT ViolationTable       : IN VitalMemoryTableType;
+  CONSTANT PortType             : IN VitalPortType; 
+  CONSTANT PortName             : IN STRING := "";
+  CONSTANT HeaderMsg            : IN STRING := "";
+  CONSTANT MsgOn                : IN BOOLEAN := TRUE;
+  CONSTANT MsgSeverity          : IN SEVERITY_LEVEL := WARNING
+) IS
+
+  VARIABLE VFlagArrayTmp  : X01ArrayT (0 TO 0);
+
+BEGIN
+
+  VitalMemoryViolation (
+    DataOutBus              => DataOutBus       ,
+    MemoryData              => MemoryData       ,
+    PortFlag                => PortFlag         ,
+    DataInBus               => DataInBus        ,
+    AddressValue            => AddressValue     ,
+    ViolationFlags          => ViolationFlags   ,
+    ViolationFlagsArray     => VFlagArrayTmp    ,
+    ViolationSizesArray     => ( 0 => 0 )       ,
+    ViolationTable          => ViolationTable   ,
+    PortType                => PortType         ,
+    PortName                => PortName         ,
+    HeaderMsg               => HeaderMsg        ,
+    MsgOn                   => MsgOn            ,
+    MsgSeverity             => MsgSeverity
+  );
+
+END;
+
+END Vital_Memory ;
diff --git a/libraries/vital2000/memory_p.vhdl b/libraries/vital2000/memory_p.vhdl
new file mode 100644
index 000000000..83874f45e
--- /dev/null
+++ b/libraries/vital2000/memory_p.vhdl
@@ -0,0 +1,1729 @@
+-- ----------------------------------------------------------------------------
+-- Title        : Standard VITAL Memory Package
+--              :
+-- Library      : Vital_Memory
+--              :
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              : Ekambaram Balaji, LSI Logic Corporation
+--              : Jose De Castro, Consultant
+--              : Prakash Bare, GDA Technologies
+--              : William Yam, LSI Logic Corporation
+--              : Dennis Brophy, Model Technology
+--              :
+-- Purpose      : This packages defines standard types, constants, functions
+--              : and procedures for use in developing ASIC memory models.
+--              :  
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History : 
+-- ----------------------------------------------------------------------------
+-- Ver:|Auth:| Date:| Changes Made:
+-- 0.1 | eb  |071796| First prototye as part of VITAL memory proposal
+-- 0.2 | jdc |012897| Initial prototyping with proposed MTM scheme 
+-- 0.3 | jdc |090297| Extensive updates for TAG review (functional)
+-- 0.4 | eb  |091597| Changed naming conventions for VitalMemoryTable 
+--     |     |      | Added interface of VitalMemoryCrossPorts() & 
+--     |     |      | VitalMemoryViolation().
+-- 0.5 | jdc |092997| Completed naming changes thoughout package body.
+--     |     |      | Testing with simgle port test model looks ok.
+-- 0.6 | jdc |121797| Major updates to the packages:
+--     |     |      | - Implement VitalMemoryCrossPorts()
+--     |     |      |   - Use new VitalAddressValueType
+--     |     |      |   - Use new VitalCrossPortModeType enum
+--     |     |      |   - Overloading without SamePort args
+--     |     |      |   - Honor erroneous address values
+--     |     |      |   - Honor ports disabled with 'Z'
+--     |     |      | - Implement implicit read 'M' table symbol
+--     |     |      | - Cleanup buses to use (H DOWNTO L)
+--     |     |      | - Message control via MsgOn,HeaderMsg,PortName
+--     |     |      | - Tested with 1P1RW,2P2RW,4P2R2W,4P4RW cases
+-- 0.7 | jdc |052698| Bug fixes to the packages:
+--     |     |      | - Fix failure with negative Address values
+--     |     |      | - Added debug messages for VMT table search
+--     |     |      | - Remove 'S' for action column (only 's')
+--     |     |      | - Remove 's' for response column (only 'S')
+--     |     |      | - Remove 'X' for action and response columns
+-- 0.8 | jdc |061298| Implemented VitalMemoryViolation()
+--     |     |      | - Minimal functionality violation tables
+--     |     |      | - Missing:
+--     |     |      |   - Cannot handle wide violation variables
+--     |     |      |   - Cannot handle sub-word cases
+--     |     |      | Fixed IIC version of MemoryMatch
+--     |     |      | Fixed 'M' vs 'm' switched on debug output
+--     |     |      | TO BE DONE:
+--     |     |      | - Implement 'd' corrupting a single bit
+--     |     |      | - Implement 'D' corrupting a single bit
+-- 0.9 |eb/sc|080498| Added UNDEF value for VitalPortFlagType
+-- 0.10|eb/sc|080798| Added CORRUPT value for VitalPortFlagType
+-- 0.11|eb/sc|081798| Added overloaded function interface for
+--     |     |      |       VitalDeclareMemory
+-- 0.14| jdc |113198| Merging of memory functionality and version
+--     |     |      | 1.4 9/17/98 of timing package from Prakash
+-- 0.15| jdc |120198| Major development of VMV functionality
+-- 0.16| jdc |120298| Complete VMV functionlality for initial testing
+--     |     |      | - New ViolationTableCorruptMask() procedure
+--     |     |      | - New MemoryTableCorruptMask() procedure
+--     |     |      | - HandleMemoryAction():
+--     |     |      |   - Removed DataOutBus bogus output
+--     |     |      |   - Replaced DataOutTmp with DataInTmp
+--     |     |      |   - Added CorruptMask input handling
+--     |     |      |   - Implemented 'd','D' using CorruptMask
+--     |     |      |   - CorruptMask on 'd','C','L','D','E'
+--     |     |      |   - CorruptMask ignored on 'c','l','e'
+--     |     |      |   - Changed 'l','d','e' to set PortFlag to CORRUPT
+--     |     |      |   - Changed 'L','D','E' to set PortFlag to CORRUPT
+--     |     |      |   - Changed 'c','l','d','e' to ignore HighBit, LowBit
+--     |     |      |   - Changed 'C','L','D','E' to use HighBit, LowBit
+--     |     |      | - HandleDataAction():
+--     |     |      |   - Added CorruptMask input handling
+--     |     |      |   - Implemented 'd','D' using CorruptMask
+--     |     |      |   - CorruptMask on 'd','C','L','D','E'
+--     |     |      |   - CorruptMask ignored on 'l','e'
+--     |     |      |   - Changed 'l','d','e' to set PortFlag to CORRUPT
+--     |     |      |   - Changed 'L','D','E' to set PortFlag to CORRUPT
+--     |     |      |   - Changed 'l','d','e' to ignore HighBit, LowBit
+--     |     |      |   - Changed 'L','D','E' to use HighBit, LowBit
+--     |     |      | - MemoryTableLookUp():
+--     |     |      |   - Added MsgOn table debug output
+--     |     |      |   - Uses new MemoryTableCorruptMask()
+--     |     |      | - ViolationTableLookUp():
+--     |     |      |   - Uses new ViolationTableCorruptMask()
+-- 0.17| jdc |120898| - Added VitalMemoryViolationSymbolType,
+--     |     |      |   VitalMemoryViolationTableType data 
+--     |     |      |   types but not used yet (need to discuss)
+--     |     |      | - Added overload for VitalMemoryViolation()
+--     |     |      |   which does not have array flags
+--     |     |      | - Bug fixes for VMV functionality:
+--     |     |      |   - ViolationTableLookUp() not handling '-' in
+--     |     |      |     scalar violation matching
+--     |     |      |   - VitalMemoryViolation() now normalizes
+--     |     |      |     VFlagArrayTmp'LEFT as LSB before calling
+--     |     |      |     ViolationTableLookUp() for proper scanning
+--     |     |      |   - ViolationTableCorruptMask() had to remove 
+--     |     |      |     normalization of CorruptMaskTmp and
+--     |     |      |     ViolMaskTmp for proper MSB:LSB corruption
+--     |     |      |   - HandleMemoryAction(), HandleDataAction() 
+--     |     |      |     - Removed 'D','E' since not being used
+--     |     |      |     - Use XOR instead of OR for corrupt masks
+--     |     |      |     - Now 'd' is sensitive to HighBit, LowBit
+--     |     |      |   - Fixed LowBit overflow in bit writeable case
+--     |     |      |     - MemoryTableCorruptMask()
+--     |     |      |     - ViolationTableCorruptMask()
+--     |     |      |     - VitalMemoryTable()
+--     |     |      |     - VitalMemoryCrossPorts()
+--     |     |      |   - Fixed VitalMemoryViolation() failing on
+--     |     |      |     error AddressValue from earlier VMT()
+--     |     |      | - Minor cleanup of code formatting
+-- 0.18| jdc |032599| - In VitalDeclareMemory()
+--     |     |      |   - Added BinaryLoadFile formal arg and 
+--     |     |      |     modified LoadMemory() to handle bin
+--     |     |      | - Added NOCHANGE to VitalPortFlagType
+--     |     |      | - For VitalCrossPortModeType
+--     |     |      |   - Added CpContention enum
+--     |     |      | - In HandleDataAction()
+--     |     |      |   - Set PortFlag := NOCHANGE for 'S' 
+--     |     |      | - In HandleMemoryAction()
+--     |     |      |   - Set PortFlag := NOCHANGE for 's' 
+--     |     |      | - In VitalMemoryTable() and
+--     |     |      |   VitalMemoryViolation()
+--     |     |      |   - Honor PortFlag = NOCHANGE returned 
+--     |     |      |     from HandleMemoryAction()
+--     |     |      | - In VitalMemoryCrossPorts()
+--     |     |      |   - Fixed Address = AddressJ for all
+--     |     |      |     conditions of DoWrCont & DoCpRead 
+--     |     |      |   - Handle CpContention like WrContOnly
+--     |     |      |     under CpReadOnly conditions, with
+--     |     |      |     associated memory message changes
+--     |     |      |   - Handle PortFlag = NOCHANGE like
+--     |     |      |     PortFlag = READ for actions
+--     |     |      | - Modeling change:
+--     |     |      |   - Need to init PortFlag every delta
+--     |     |      |     PortFlag_A := (OTHES => UNDEF);
+--     |     |      | - Updated InternalTimingCheck code
+-- 0.19| jdc |042599| - Fixes for bit-writeable cases
+--     |     |      | - Check PortFlag after HandleDataAction
+--     |     |      |   in VitalMemoryViolation()
+-- 0.20| jdc |042599| - Merge PortFlag changes from Prakash
+--     |     |      |   and Willian:
+--     |     |      |     VitalMemorySchedulePathDelay()
+--     |     |      |     VitalMemoryExpandPortFlag()
+-- 0.21| jdc |072199| - Changed VitalCrossPortModeType enums,
+--     |     |      |   added new CpReadAndReadContention.
+--     |     |      | - Fixed VitalMemoryCrossPorts() parameter
+--     |     |      |   SamePortFlag to INOUT so that it can
+--     |     |      |   set CORRUPT or READ value.
+--     |     |      | - Fixed VitalMemoryTable() where PortFlag
+--     |     |      |   setting by HandleDataAction() is being
+--     |     |      |   ignored when HandleMemoryAction() sets
+--     |     |      |   PortFlagTmp to NOCHANGE.
+--     |     |      | - Fixed VitalMemoryViolation() to set
+--     |     |      |   all bits of PortFlag when violating.
+-- 0.22| jdc |072399| - Added HIGHZ to PortFlagType. HandleData
+--     |     |      |   checks whether the previous state is HIGHZ.
+--     |     |      |   If yes then portFlag should be NOCHANGE
+--     |     |      |   for VMPD to ignore IORetain corruption.
+--     |     |      |   The idea is that the first Z should be
+--     |     |      |   propagated but later ones should be ignored.
+--     |     |      |
+-- 0.23| jdc |100499| - Took code checked in by Dennis 09/28/99
+--     |     |      | - Changed VitalPortFlagType to record of
+--     |     |      |   new VitalPortStateType to hold current,
+--     |     |      |   previous values and separate disable.
+--     |     |      |   Also created VitalDefaultPortFlag const.
+--     |     |      |   Removed usage of PortFlag NOCHANGE
+--     |     |      | - VitalMemoryTable() changes:
+--     |     |      |   Optimized return when all curr = prev
+--     |     |      |   AddressValue is now INOUT to optimize
+--     |     |      |   Transfer PF.MemoryCurrent to MemoryPrevious
+--     |     |      |   Transfer PF.DataCurrent to DataPrevious
+--     |     |      |   Reset PF.OutputDisable to FALSE
+--     |     |      |   Expects PortFlag init in declaration
+--     |     |      |   No need to init PortFlag every delta
+--     |     |      | - VitalMemorySchedulePathDelay() changes:
+--     |     |      |   Initialize with VitalDefaultPortFlag
+--     |     |      |   Check PortFlag.OutputDisable
+--     |     |      | - HandleMemoryAction() changes:
+--     |     |      |   Set value of PortFlag.MemoryCurrent
+--     |     |      |   Never set PortFlag.OutputDisable
+--     |     |      | - HandleDataAction() changes:
+--     |     |      |   Set value of PortFlag.DataCurrent
+--     |     |      |   Set PortFlag.DataCurrent for HIGHZ
+--     |     |      | - VitalMemoryCrossPorts() changes:
+--     |     |      |   Check/set value of PF.MemoryCurrent
+--     |     |      |   Check value of PF.OutputDisable
+--     |     |      | - VitalMemoryViolation() changes:
+--     |     |      |   Fixed bug - not reading inout PF value
+--     |     |      |   Clean up setting of PortFlag
+-- 0.24| jdc |100899| - Modified update of PF.OutputDisable
+--     |     |      |   to correctly accomodate 2P1W1R case:
+--     |     |      |   the read port should not exhibit
+--     |     |      |   IO retain corrupt when reading
+--     |     |      |   addr unrelated to addr being written.
+-- 0.25| jdc |100999| - VitalMemoryViolation() change:
+--     |     |      |   Fixed bug with RDNWR mode incorrectly
+--     |     |      |   updating the PF.OutputDisable
+-- 0.26| jdc |100999| - VitalMemoryCrossPorts() change:
+--     |     |      |   Fixed bugs with update of PF
+-- 0.27| jdc |101499| - VitalMemoryCrossPorts() change:
+--     |     |      |   Added DoRdWrCont message (ErrMcpRdWrCo,
+--     |     |      |   Memory cross port read/write data only
+--     |     |      |   contention)
+--     |     |      | - VitalMemoryTable() change:
+--     |     |      |   Set PF.OutputDisable := TRUE for the
+--     |     |      |   optimized cases.
+-- 0.28| pb  |112399| - Added 8 VMPD procedures for vector 
+--     |     |      |   PathCondition support. Now the total
+--     |     |      |   number of overloadings for VMPD is 24.
+--     |     |      | - Number of overloadings for SetupHold
+--     |     |      |   procedures increased to 5. Scalar violations
+--     |     |      |   are not supported anymore. Vector checkEnabled
+--     |     |      |   support is provided through the new overloading
+-- 0.29| jdc |120999| - HandleMemoryAction() HandleDataAction()
+--     |     |      |   Reinstated 'D' and 'E' actions but
+--     |     |      |   with new PortFlagType
+--     |     |      | - Updated file handling syntax, must compile
+--     |     |      |   with -93 syntax now.
+-- 0.30| jdc |022300| - Formated for 80 column max width
+-- ----------------------------------------------------------------------------
+
+LIBRARY IEEE;
+USE     IEEE.STD_LOGIC_1164.ALL;
+USE     IEEE.Vital_Timing.ALL;
+USE     IEEE.Vital_Primitives.ALL;
+
+LIBRARY STD;
+USE     STD.TEXTIO.ALL;
+
+PACKAGE Vital_Memory IS
+
+-- ----------------------------------------------------------------------------
+-- Timing Section
+-- ----------------------------------------------------------------------------
+
+-- ----------------------------------------------------------------------------
+-- Types and constants for Memory timing procedures
+-- ----------------------------------------------------------------------------
+TYPE VitalMemoryArcType       IS (ParallelArc, CrossArc, SubwordArc);
+TYPE OutputRetainBehaviorType IS (BitCorrupt, WordCorrupt);
+TYPE VitalMemoryMsgFormatType IS (Vector, Scalar, VectorEnum);
+TYPE X01ArrayT IS ARRAY (NATURAL RANGE <> ) OF X01;
+TYPE X01ArrayPT IS ACCESS X01ArrayT;
+TYPE VitalMemoryViolationType IS ACCESS X01ArrayT;
+CONSTANT DefaultNumBitsPerSubword : INTEGER := -1;
+
+
+-- Data type storing path delay and schedule information for output bits
+TYPE VitalMemoryScheduleDataType IS RECORD
+  OutputData        : std_ulogic;
+  NumBitsPerSubWord : INTEGER;
+  ScheduleTime      : TIME;
+  ScheduleValue     : std_ulogic;
+  LastOutputValue   : std_ulogic;
+  PropDelay         : TIME;
+  OutputRetainDelay : TIME; 
+  InputAge          : TIME;
+END RECORD;
+
+TYPE VitalMemoryTimingDataType IS RECORD
+  NotFirstFlag : BOOLEAN;
+  RefLast      : X01;
+  RefTime      : TIME;
+  HoldEn       : BOOLEAN;
+  TestLast     : std_ulogic;
+  TestTime     : TIME;
+  SetupEn      : BOOLEAN;
+  TestLastA    : VitalLogicArrayPT;
+  TestTimeA    : VitalTimeArrayPT;
+  RefLastA     : X01ArrayPT; 
+  RefTimeA     : VitalTimeArrayPT;
+  HoldEnA      : VitalBoolArrayPT;
+  SetupEnA     : VitalBoolArrayPT;
+END RECORD;
+
+TYPE VitalPeriodDataArrayType IS ARRAY (NATURAL RANGE <>) OF 
+  VitalPeriodDataType;
+
+-- Data type storing path delay and schedule information for output 
+-- vectors
+TYPE VitalMemoryScheduleDataVectorType IS ARRAY (NATURAL RANGE <> ) OF 
+  VitalMemoryScheduleDataType;
+
+-- VitalPortFlagType records runtime mode of port sub-word slices
+--    TYPE VitalPortFlagType IS (
+--        UNDEF,
+--        READ,
+--        WRITE,
+--        CORRUPT,
+--        HIGHZ,
+--        NOCHANGE
+--    );
+
+-- VitalPortFlagType records runtime mode of port sub-word slices
+TYPE VitalPortStateType IS (
+  UNDEF,
+  READ,
+  WRITE,
+  CORRUPT,
+  HIGHZ
+);
+
+TYPE VitalPortFlagType IS RECORD
+  MemoryCurrent   : VitalPortStateType;
+  MemoryPrevious  : VitalPortStateType;
+  DataCurrent     : VitalPortStateType;
+  DataPrevious    : VitalPortStateType;
+  OutputDisable   : BOOLEAN;
+END RECORD;
+
+CONSTANT VitalDefaultPortFlag : VitalPortFlagType := (
+  MemoryCurrent   => READ,
+  MemoryPrevious  => UNDEF,
+  DataCurrent     => READ,
+  DataPrevious    => UNDEF,
+  OutputDisable   => FALSE
+);
+
+-- VitalPortFlagVectorType to be same width i as enables of a port
+-- or j multiples thereof, where j is the number of cross ports
+TYPE VitalPortFlagVectorType IS 
+  ARRAY (NATURAL RANGE <>) OF VitalPortFlagType;
+
+-- ----------------------------------------------------------------------------
+-- Functions  : VitalMemory path delay procedures 
+--                - VitalMemoryInitPathDelay
+--                - VitalMemoryAddPathDelay
+--                - VitalMemorySchedulePathDelay
+--
+-- Description: VitalMemoryInitPathDelay, VitalMemoryAddPathDelay and
+--              VitalMemorySchedulePathDelay are Level 1 routines used 
+--              for selecting the propagation delay paths based on
+--              path condition, transition type and delay values and
+--              schedule a new output value.
+--
+--              Following features are implemented in these procedures:
+--              o condition dependent path selection
+--              o Transition dependent delay selection
+--              o shortest delay path selection from multiple 
+--                candidate paths
+--              o Scheduling of the computed values on the specified 
+--                signal.
+--              o output retain behavior if outputRetain flag is set
+--              o output mapping to alternate strengths to model 
+--                pull-up, pull-down etc. 
+--                
+--              <More details to be added here>
+--
+-- Following is information on overloading of the procedures.
+--
+-- VitalMemoryInitPathDelay is overloaded for ScheduleDataArray and 
+-- OutputDataArray
+--
+-- ----------------------------------------------------------------------------
+--           ScheduleDataArray        OutputDataArray
+-- ----------------------------------------------------------------------------
+--              Scalar                    Scalar
+--              Vector                    Vector
+-- ----------------------------------------------------------------------------
+-- 
+--
+-- VitalMemoryAddPathDelay is overloaded for ScheduleDataArray,
+-- PathDelayArray, InputSignal and delaytype.
+--
+-- ----------------------------------------------------------------------------
+--   DelayType        InputSignal    ScheduleData     PathDelay
+--                                      Array          Array
+-- ----------------------------------------------------------------------------
+--  VitalDelayType      Scalar         Scalar          Scalar
+--  VitalDelayType      Scalar         Vector          Vector
+--  VitalDelayType      Vector         Scalar          Vector      
+--  VitalDelayType      Vector         Vector          Vector
+--  VitalDelayType01    Scalar         Scalar          Scalar
+--  VitalDelayType01    Scalar         Vector          Vector
+--  VitalDelayType01    Vector         Scalar          Vector
+--  VitalDelayType01    Vector         Vector          Vector
+--  VitalDelayType01Z   Scalar         Scalar          Scalar
+--  VitalDelayType01Z   Scalar         Vector          Vector
+--  VitalDelayType01Z   Vector         Scalar          Vector
+--  VitalDelayType01Z   Vector         Vector          Vector
+--  VitalDelayType01XZ  Scalar         Scalar          Scalar
+--  VitalDelayType01XZ  Scalar         Vector          Vector
+--  VitalDelayType01XZ  Vector         Scalar          Vector
+--  VitalDelayType01XZ  Vector         Vector          Vector
+-- ----------------------------------------------------------------------------
+--  
+--
+--  VitalMemorySchedulePathDelay is overloaded for ScheduleDataArray,
+--  and OutSignal
+--
+-- ----------------------------------------------------------------------------
+--           OutSignal                 ScheduleDataArray     
+-- ----------------------------------------------------------------------------
+--             Scalar                      Scalar
+--             Vector                      Vector
+-- ----------------------------------------------------------------------------
+--
+-- Procedure Declarations:
+--
+--
+-- Function     :   VitalMemoryInitPathDelay
+--
+-- Arguments:
+--
+--  INOUT               Type             Description
+--
+--  ScheduleDataArray/  VitalMemoryScheduleDataVectorType/        
+--  ScheduleData        VitalMemoryScheduleDataType   
+--                                       Internal data variable for 
+--                                       storing delay and schedule
+--                                       information for each output bit
+--                                            
+--
+--  IN
+--
+--  OutputDataArray/    STD_LOGIC_VECTOR/Array containing current output
+--  OutputData          STD_ULOGIC       value
+--
+--
+--  NumBitsPerSubWord   INTEGER          Number of bits per subword.
+--                                       Default value of this argument
+--                                       is DefaultNumBitsPerSubword 
+--                                       which is interpreted as no 
+--                                       subwords
+--
+-- ----------------------------------------------------------------------------
+--
+-- 
+-- ScheduleDataArray - Vector
+-- OutputDataArray - Vector
+--
+PROCEDURE VitalMemoryInitPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  VARIABLE OutputDataArray   : IN STD_LOGIC_VECTOR;
+  CONSTANT NumBitsPerSubWord : IN INTEGER := DefaultNumBitsPerSubword
+);
+-- 
+-- ScheduleDataArray - Scalar
+-- OutputDataArray - Scalar
+--
+PROCEDURE VitalMemoryInitPathDelay (
+  VARIABLE ScheduleData      : INOUT VitalMemoryScheduleDataType;
+  VARIABLE OutputData        : IN STD_ULOGIC
+);
+
+-- ----------------------------------------------------------------------------
+--
+-- Function     :   VitalMemoryAddPathDelay
+--
+-- Arguments
+--
+--  INOUT                 Type            Description
+--
+--  ScheduleDataArray/    VitalMemoryScheduleDataVectorType/          
+--  ScheduleData          VitalMemoryScheduleDataType         
+--                                        Internal data variable for 
+--                                        storing delay and schedule
+--                                        information for each output bit
+--
+--  InputChangeTimeArray/ VitaltimeArrayT/Time     
+--  InputChangeTime                       Holds the time since the last 
+--                                        input change
+--
+--  IN
+--
+--  InputSignal           STD_LOGIC_VECTOR
+--                        STD_ULOGIC/     Array holding the input value
+--
+--  OutputSignalName      STRING          The output signal name
+--
+--  PathDelayArray/       VitalDelayArrayType01ZX, 
+--  PathDelay             VitalDelayArrayType01Z,
+--                        VitalDelayArrayType01,     
+--                        VitalDelayArrayType/
+--                        VitalDelayType01ZX,
+--                        VitalDelayType01Z,
+--                        VitalDelayType01,
+--                        VitalDelayType  Array of delay values
+--  
+--  ArcType               VitalMemoryArcType        
+--                                        Indicates the Path type. This
+--                                        can be SubwordArc, CrossArc or
+--                                        ParallelArc
+--
+--  PathCondition         BOOLEAN         If True, the transition in
+--                                        the corresponding input signal
+--                                        is considered while 
+--                                        caluculating the prop. delay
+--                                        else the transition is ignored.
+--
+--  OutputRetainFlag      BOOLEAN         If specified TRUE,output retain
+--                                        (hold) behavior is implemented.
+--
+-- ----------------------------------------------------------------------------
+--
+-- #1
+-- DelayType - VitalDelayType
+-- Input     - Scalar 
+-- Output    - Scalar 
+-- Delay     - Scalar
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_ULOGIC;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTime      : INOUT Time;
+  CONSTANT PathDelay            : IN VitalDelayType;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE
+);
+
+-- #2
+-- DelayType - VitalDelayType
+-- Input     - Scalar 
+-- Output    - Vector 
+-- Delay     - Vector 
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTime   : INOUT Time;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE
+);
+
+-- #3
+-- DelayType - VitalDelayType
+-- Input     - Scalar 
+-- Output    - Vector 
+-- Delay     - Vector 
+-- Condition - Vector
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTime   : INOUT Time;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray: IN VitalBoolArrayT
+);
+
+-- #4
+-- DelayType - VitalDelayType
+-- Input     - Vector
+-- Output    - Scalar 
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE
+);
+
+-- #5
+-- DelayType - VitalDelayType
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray    : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE
+);
+
+-- #6
+-- DelayType - VitalDelayType
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray    : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT
+);
+
+-- #7
+-- DelayType - VitalDelayType01
+-- Input     - Scalar
+-- Output    - Scalar
+-- Delay     - Scalar 
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_ULOGIC;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTime      : INOUT Time;
+  CONSTANT PathDelay            : IN VitalDelayType01;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE
+);
+
+-- #8
+-- DelayType - VitalDelayType01
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTime   : INOUT Time;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE
+);
+
+-- #9
+-- DelayType - VitalDelayType01
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTime   : INOUT Time;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray: IN VitalBoolArrayT
+);
+
+-- #10
+-- DelayType - VitalDelayType01
+-- Input     - Vector
+-- Output    - Scalar
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE
+);
+
+-- #11
+-- DelayType - VitalDelayType01
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE
+);
+
+-- #12
+-- DelayType - VitalDelayType01
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray  : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT
+);
+
+-- #13
+-- DelayType - VitalDelayType01Z
+-- Input     - Scalar
+-- Output    - Scalar
+-- Delay     - Scalar
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_ULOGIC;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTime      : INOUT Time;
+  CONSTANT PathDelay            : IN VitalDelayType01Z;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE
+);
+
+-- #14
+-- DelayType - VitalDelayType01Z
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTime   : INOUT Time;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+);
+
+-- #15
+-- DelayType - VitalDelayType01Z
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTime   : INOUT Time;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray: IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+);
+
+-- #16
+-- DelayType - VitalDelayType01Z
+-- Input     - Vector
+-- Output    - Scalar
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+);
+
+-- #17
+-- DelayType - VitalDelayType01Z
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector 
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+);
+
+-- #18
+-- DelayType - VitalDelayType01Z
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector 
+-- Condition - Vector
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01Z;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+);
+
+-- #19
+-- DelayType - VitalDelayType01ZX
+-- Input     - Scalar
+-- Output    - Scalar
+-- Delay     - Scalar
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_ULOGIC;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTime      : INOUT Time;
+  CONSTANT PathDelay            : IN VitalDelayType01ZX;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE
+);
+
+-- #20
+-- DelayType - VitalDelayType01ZX
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTime   : INOUT Time;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition     : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+);
+
+-- #21
+-- DelayType - VitalDelayType01ZX
+-- Input     - Scalar
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_ULOGIC;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTime   : INOUT Time;
+  CONSTANT PathDelayArray    : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType           : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray: IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag  : IN BOOLEAN := FALSE
+);
+
+-- #22
+-- DelayType - VitalDelayType01ZX
+-- Input     - Vector
+-- Output    - Scalar
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleData         : INOUT VitalMemoryScheduleDataType;
+  SIGNAL   InputSignal          : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName     : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+);
+
+-- #23
+-- DelayType - VitalDelayType01ZX
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Scalar
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathCondition        : IN BOOLEAN := TRUE;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+);
+
+-- #24
+-- DelayType - VitalDelayType01ZX
+-- Input     - Vector
+-- Output    - Vector
+-- Delay     - Vector
+-- Condition - Vector
+
+PROCEDURE VitalMemoryAddPathDelay (
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType;
+  SIGNAL   InputSignal       : IN STD_LOGIC_VECTOR;
+  CONSTANT OutputSignalName  : IN STRING := "";
+  VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT;
+  CONSTANT PathDelayArray       : IN VitalDelayArrayType01ZX;
+  CONSTANT ArcType              : IN VitalMemoryArcType := CrossArc;
+  CONSTANT PathConditionArray   : IN VitalBoolArrayT;
+  CONSTANT OutputRetainFlag     : IN BOOLEAN := FALSE;
+  CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt
+);
+
+-- ----------------------------------------------------------------------------
+--
+-- Function     :   VitalMemorySchedulePathDelay
+--
+-- Arguments:
+--
+--  OUT                Type                 Description
+--  OutSignal          STD_LOGIC_VECTOR/    The output signal for 
+--                     STD_ULOGIC           scheduling
+--
+--  IN
+--  OutputSignalName   STRING               The name of the output signal
+--
+--  IN
+--  PortFlag           VitalPortFlagType    Port flag variable from 
+--                                          functional procedures
+--
+--  IN
+--  OutputMap          VitalOutputMapType   For VitalPathDelay01Z, the 
+--                                          output can be mapped to 
+--                                          alternate strengths to model
+--                                          tri-state devices, pull-ups
+--                                          and pull-downs.
+--
+--  INOUT
+--  ScheduleDataArray/ VitalMemoryScheduleDataVectorType/        
+--  ScheduleData       VitalMemoryScheduleDataType           
+--                                          Internal data variable for 
+--                                          storing delay and schedule
+--                                          information for each 
+--                                          output bit
+--                                       
+-- ----------------------------------------------------------------------------
+--
+-- ScheduleDataArray - Vector
+-- OutputSignal - Vector
+--
+PROCEDURE VitalMemorySchedulePathDelay (
+  SIGNAL   OutSignal         : OUT std_logic_vector;
+  CONSTANT OutputSignalName  : IN STRING := "";       
+  CONSTANT PortFlag          : IN VitalPortFlagType := VitalDefaultPortFlag;
+  CONSTANT OutputMap : IN VitalOutputMapType := VitalDefaultOutputMap;
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType
+);
+--
+-- ScheduleDataArray - Vector
+-- OutputSignal - Vector
+--
+PROCEDURE VitalMemorySchedulePathDelay (
+  SIGNAL   OutSignal         : OUT std_logic_vector;
+  CONSTANT OutputSignalName  : IN STRING := ""; 
+  CONSTANT PortFlag          : IN VitalPortFlagVectorType;
+  CONSTANT OutputMap : IN VitalOutputMapType := VitalDefaultOutputMap;
+  VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType
+);
+--
+-- ScheduleDataArray - Scalar
+-- OutputSignal - Scalar
+--
+PROCEDURE VitalMemorySchedulePathDelay (
+  SIGNAL   OutSignal         : OUT std_ulogic;
+  CONSTANT OutputSignalName  : IN STRING := "";       
+  CONSTANT PortFlag          : IN VitalPortFlagType := VitalDefaultPortFlag;
+  CONSTANT OutputMap  : IN VitalOutputMapType := VitalDefaultOutputMap;
+  VARIABLE ScheduleData      : INOUT VitalMemoryScheduleDataType
+);
+
+-- ----------------------------------------------------------------------------
+FUNCTION VitalMemoryTimingDataInit RETURN VitalMemoryTimingDataType;
+
+-- ----------------------------------------------------------------------------
+--
+-- Function Name:  VitalMemorySetupHoldCheck
+--
+-- Description:    The VitalMemorySetupHoldCheck procedure detects a setup or a 
+--                 hold violation on the input test signal with respect
+--                 to the corresponding input reference signal.  The timing 
+--                 constraints are specified through parameters 
+--                 representing the high and low values for the setup and
+--                 hold values for the setup and hold times.  This 
+--                 procedure assumes non-negative values for setup and hold 
+--                 timing constraints. 
+--
+--                 It is assumed that negative timing constraints
+--                 are handled by internally delaying the test or
+--                 reference signals.  Negative setup times result in
+--                 a delayed reference signal.  Negative hold times
+--                 result in a delayed test signal.  Furthermore, the
+--                 delays and constraints associated with these and
+--                 other signals may need to be appropriately
+--                 adjusted so that all constraint intervals overlap
+--                 the delayed reference signals and all constraint
+--                 values (with respect to the delayed signals) are
+--                 non-negative.
+--
+--                 This function is overloaded based on the input
+--                 TestSignal and reference signals. Parallel, Subword and
+--                 Cross Arc relationships between test and reference
+--                 signals are supported.
+--                  
+-- TestSignal XXXXXXXXXXXX____________________________XXXXXXXXXXXXXXXXXXXXXX
+--            :
+--            :        -->|       error region       |<--
+--            :
+--            _______________________________
+-- RefSignal                                 \______________________________
+--            :           |                  |       |
+--            :           |               -->|       |<-- thold
+--            :        -->|     tsetup       |<--
+--
+-- Arguments:         
+--
+--  IN                Type                Description    
+--   TestSignal       std_logic_vector    Value of test signal
+--   TestSignalName   STRING              Name of test signal
+--   TestDelay        VitalDelayArrayType Model's internal delay associated
+--                                        with TestSignal
+--   RefSignal        std_ulogic          Value of reference signal
+--                    std_logic_vector
+--   RefSignalName    STRING              Name of reference signal
+--   RefDelay         TIME                Model's internal delay associated
+--                    VitalDelayArrayType with RefSignal
+--   SetupHigh        VitalDelayArrayType Absolute minimum time duration 
+--                                        before the transition of RefSignal
+--                                        for which transitions of 
+--                                        TestSignal are allowed to proceed
+--                                        to the "1" state without causing
+--                                        a setup violation.      
+--   SetupLow         VitalDelayArrayType Absolute minimum time duration 
+--                                        before the transition of RefSignal
+--                                        for which transitions of 
+--                                        TestSignal are allowed to proceed 
+--                                        to the "0" state without causing
+--                                        a setup violation.      
+--   HoldHigh         VitalDelayArrayType Absolute minimum time duration 
+--                                        after the transition of RefSignal
+--                                        for which transitions of 
+--                                        TestSignal are allowed to
+--                                        proceed to the "1" state without
+--                                        causing a hold violation.      
+--   HoldLow          VitalDelayArrayType Absolute minimum time duration
+--                                        after the transition of RefSignal
+--                                        for which transitions of 
+--                                        TestSignal are allowed to
+--                                        proceed to the "0" state without
+--                                        causing a hold violation.      
+--   CheckEnabled     BOOLEAN             Check performed if TRUE.
+--   RefTransition    VitalEdgeSymbolType
+--                                        Reference edge specified. Events 
+--                                        on the RefSignal which match the
+--                                        edge spec. are used as reference 
+--                                        edges.      
+--   ArcType          VitalMemoryArcType
+--   NumBitsPerSubWord INTEGER
+--   HeaderMsg        STRING              String that will accompany any
+--                                        assertion messages produced.      
+--   XOn              BOOLEAN             If TRUE, Violation output 
+--                                        parameter is set to "X". 
+--                                        Otherwise, Violation is always
+--                                        set to "0."      
+--   MsgOn            BOOLEAN             If TRUE, set and hold violation 
+--                                        message will be generated.
+--                                        Otherwise, no messages are
+--                                        generated, even upon violations.  
+--   MsgSeverity      SEVERITY_LEVEL      Severity level for the assertion. 
+--   MsgFormat        VitalMemoryMsgFormatType
+--                                        Format of the Test/Reference 
+--                                        signals in violation messages.
+--              
+--  INOUT
+--   TimingData       VitalMemoryTimingDataType  
+--                                        VitalMemorySetupHoldCheck information
+--                                        storage area.  This is used
+--                                        internally to detect reference 
+--                                        edges and record the time of the 
+--                                        last edge.
+--
+--  OUT
+--   Violation        X01              This is the violation flag returned. 
+--                    X01ArrayT        Overloaded for array type.
+--
+--
+-- ----------------------------------------------------------------------------
+
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation         : OUT    X01ArrayT;
+  VARIABLE TimingData        : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal        : IN     std_ulogic;
+  CONSTANT TestSignalName    : IN     STRING := "";
+  CONSTANT TestDelay         : IN     TIME := 0 ns;
+  SIGNAL   RefSignal         : IN     std_ulogic;
+  CONSTANT RefSignalName     : IN     STRING := "";
+  CONSTANT RefDelay          : IN     TIME := 0 ns;
+  CONSTANT SetupHigh         : IN     VitalDelayType;
+  CONSTANT SetupLow          : IN     VitalDelayType;
+  CONSTANT HoldHigh          : IN     VitalDelayType;
+  CONSTANT HoldLow           : IN     VitalDelayType;
+  CONSTANT CheckEnabled      : IN     VitalBoolArrayT;
+  CONSTANT RefTransition     : IN     VitalEdgeSymbolType;
+  CONSTANT HeaderMsg         : IN     STRING := " ";
+  CONSTANT XOn               : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT EnableSetupOnTest : IN     BOOLEAN := TRUE;
+  CONSTANT EnableSetupOnRef  : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN     BOOLEAN := TRUE  
+); 
+
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation         : OUT    X01ArrayT;
+  VARIABLE TimingData        : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal        : IN     std_logic_vector;
+  CONSTANT TestSignalName    : IN     STRING := "";
+  CONSTANT TestDelay         : IN     VitalDelayArrayType;
+  SIGNAL   RefSignal         : IN     std_ulogic;
+  CONSTANT RefSignalName     : IN     STRING := "";
+  CONSTANT RefDelay          : IN     TIME := 0 ns;
+  CONSTANT SetupHigh         : IN     VitalDelayArrayType;
+  CONSTANT SetupLow          : IN     VitalDelayArrayType;
+  CONSTANT HoldHigh          : IN     VitalDelayArrayType;
+  CONSTANT HoldLow           : IN     VitalDelayArrayType;
+  CONSTANT CheckEnabled      : IN     BOOLEAN := TRUE;
+  CONSTANT RefTransition     : IN     VitalEdgeSymbolType;
+  CONSTANT HeaderMsg         : IN     STRING := " ";
+  CONSTANT XOn               : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat         : IN     VitalMemoryMsgFormatType;
+  CONSTANT EnableSetupOnTest : IN     BOOLEAN := TRUE;
+  CONSTANT EnableSetupOnRef  : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN     BOOLEAN := TRUE  
+); 
+
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation         : OUT    X01ArrayT;
+  VARIABLE TimingData        : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal        : IN     std_logic_vector;
+  CONSTANT TestSignalName    : IN     STRING := "";
+  CONSTANT TestDelay         : IN     VitalDelayArrayType;
+  SIGNAL   RefSignal         : IN     std_ulogic;
+  CONSTANT RefSignalName     : IN     STRING := "";
+  CONSTANT RefDelay          : IN     TIME := 0 ns;
+  CONSTANT SetupHigh         : IN     VitalDelayArrayType;
+  CONSTANT SetupLow          : IN     VitalDelayArrayType;
+  CONSTANT HoldHigh          : IN     VitalDelayArrayType;
+  CONSTANT HoldLow           : IN     VitalDelayArrayType;
+  CONSTANT CheckEnabled      : IN     VitalBoolArrayT;
+  CONSTANT RefTransition     : IN     VitalEdgeSymbolType;
+  CONSTANT ArcType           : IN     VitalMemoryArcType := CrossArc;
+  CONSTANT NumBitsPerSubWord : IN     INTEGER := 1;
+  CONSTANT HeaderMsg         : IN     STRING := " ";
+  CONSTANT XOn               : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat         : IN     VitalMemoryMsgFormatType;
+  CONSTANT EnableSetupOnTest : IN     BOOLEAN := TRUE;
+  CONSTANT EnableSetupOnRef  : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN     BOOLEAN := TRUE  
+); 
+
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation         : OUT    X01ArrayT;
+  VARIABLE TimingData        : INOUT  VitalMemoryTimingDataType;            
+  SIGNAL   TestSignal        : IN     std_logic_vector;
+  CONSTANT TestSignalName    : IN     STRING := "";
+  CONSTANT TestDelay         : IN     VitalDelayArrayType;
+  SIGNAL   RefSignal         : IN     std_logic_vector;
+  CONSTANT RefSignalName     : IN     STRING := "";
+  CONSTANT RefDelay          : IN     VitalDelayArrayType;
+  CONSTANT SetupHigh         : IN     VitalDelayArrayType;
+  CONSTANT SetupLow          : IN     VitalDelayArrayType;
+  CONSTANT HoldHigh          : IN     VitalDelayArrayType;
+  CONSTANT HoldLow           : IN     VitalDelayArrayType;
+  CONSTANT CheckEnabled      : IN     BOOLEAN := TRUE;
+  CONSTANT RefTransition     : IN     VitalEdgeSymbolType;
+  CONSTANT ArcType           : IN     VitalMemoryArcType := CrossArc;
+  CONSTANT NumBitsPerSubWord : IN     INTEGER := 1;
+  CONSTANT HeaderMsg         : IN     STRING := " ";
+  CONSTANT XOn               : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat         : IN     VitalMemoryMsgFormatType;
+  CONSTANT EnableSetupOnTest : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN     BOOLEAN := TRUE  
+);     
+
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation         : OUT    X01ArrayT;
+  VARIABLE TimingData        : INOUT  VitalMemoryTimingDataType;            
+  SIGNAL   TestSignal        : IN     std_logic_vector;
+  CONSTANT TestSignalName    : IN     STRING := "";
+  CONSTANT TestDelay         : IN     VitalDelayArrayType;
+  SIGNAL   RefSignal         : IN     std_logic_vector;
+  CONSTANT RefSignalName     : IN     STRING := "";
+  CONSTANT RefDelay          : IN     VitalDelayArrayType;
+  CONSTANT SetupHigh         : IN     VitalDelayArrayType;
+  CONSTANT SetupLow          : IN     VitalDelayArrayType;
+  CONSTANT HoldHigh          : IN     VitalDelayArrayType;
+  CONSTANT HoldLow           : IN     VitalDelayArrayType;
+  CONSTANT CheckEnabled      : IN     VitalBoolArrayT;
+  CONSTANT RefTransition     : IN     VitalEdgeSymbolType;
+  CONSTANT ArcType           : IN     VitalMemoryArcType := CrossArc;
+  CONSTANT NumBitsPerSubWord : IN     INTEGER := 1;
+  CONSTANT HeaderMsg         : IN     STRING := " ";
+  CONSTANT XOn               : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat         : IN     VitalMemoryMsgFormatType;
+  CONSTANT EnableSetupOnTest : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN     BOOLEAN := TRUE  
+);     
+
+--------------- following are not needed --------------------------
+
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation         : OUT    X01;
+  VARIABLE TimingData        : INOUT  VitalMemoryTimingDataType;
+  SIGNAL   TestSignal        : IN     std_logic_vector;
+  CONSTANT TestSignalName    : IN     STRING := "";
+  CONSTANT TestDelay         : IN     VitalDelayArrayType;
+  SIGNAL   RefSignal         : IN     std_ulogic;
+  CONSTANT RefSignalName     : IN     STRING := "";
+  CONSTANT RefDelay          : IN     TIME := 0 ns;
+  CONSTANT SetupHigh         : IN     VitalDelayArrayType;
+  CONSTANT SetupLow          : IN     VitalDelayArrayType;
+  CONSTANT HoldHigh          : IN     VitalDelayArrayType;
+  CONSTANT HoldLow           : IN     VitalDelayArrayType;
+  CONSTANT CheckEnabled      : IN     BOOLEAN := TRUE;
+  CONSTANT RefTransition     : IN     VitalEdgeSymbolType;
+  CONSTANT HeaderMsg         : IN     STRING := " ";
+  CONSTANT XOn               : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat         : IN     VitalMemoryMsgFormatType;
+  CONSTANT EnableSetupOnTest : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN     BOOLEAN := TRUE  
+);     
+
+PROCEDURE VitalMemorySetupHoldCheck (
+  VARIABLE Violation         : OUT    X01;
+  VARIABLE TimingData        : INOUT  VitalMemoryTimingDataType;            
+  SIGNAL   TestSignal        : IN     std_logic_vector;
+  CONSTANT TestSignalName    : IN     STRING := "";
+  CONSTANT TestDelay         : IN     VitalDelayArrayType;
+  SIGNAL   RefSignal         : IN     std_logic_vector;
+  CONSTANT RefSignalName     : IN     STRING := "";
+  CONSTANT RefDelay          : IN     VitalDelayArrayType;
+  CONSTANT SetupHigh         : IN     VitalDelayArrayType;
+  CONSTANT SetupLow          : IN     VitalDelayArrayType;
+  CONSTANT HoldHigh          : IN     VitalDelayArrayType;
+  CONSTANT HoldLow           : IN     VitalDelayArrayType;
+  CONSTANT CheckEnabled      : IN     BOOLEAN := TRUE;
+  CONSTANT RefTransition     : IN     VitalEdgeSymbolType;
+  CONSTANT HeaderMsg         : IN     STRING := " ";
+  CONSTANT XOn               : IN     BOOLEAN := TRUE;
+  CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+  CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+  CONSTANT ArcType           : IN     VitalMemoryArcType := CrossArc;
+  CONSTANT NumBitsPerSubWord : IN     INTEGER := 1;
+  CONSTANT MsgFormat         : IN     VitalMemoryMsgFormatType;
+  CONSTANT EnableSetupOnTest : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableSetupOnRef  : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnRef   : IN     BOOLEAN := TRUE; 
+  CONSTANT EnableHoldOnTest  : IN     BOOLEAN := TRUE  
+);         
+
+
+-- ----------------------------------------------------------------------------
+--
+-- Function Name:  VitalPeriodPulseCheck
+--
+-- Description:    VitalPeriodPulseCheck checks for minimum and maximum
+--                 periodicity and pulse width for "1" and "0" values of
+--                 the input test signal.  The timing constraint is 
+--                 specified through parameters representing the minimal
+--                 period between successive rising and falling edges of
+--                 the input test signal and the minimum pulse widths 
+--                 associated with high and low values.  
+--                 
+--                 VitalPeriodCheck's accepts rising and falling edges
+--                 from 1 and 0 as well as transitions to and from 'X.'
+--                 
+--                    _______________         __________
+--       ____________|               |_______|
+--
+--                   |<--- pw_hi --->|
+--                   |<-------- period ----->|
+--                                -->| pw_lo |<--
+--                 
+-- Arguments:
+--    IN             Type              Description
+--    TestSignal     std_logic_vector  Value of test signal  
+--    TestSignalName STRING            Name of the test signal
+--    TestDelay      VitalDelayArrayType 
+--                                     Model's internal delay associated
+--                                     with TestSignal
+--    Period         VitalDelayArrayType 
+--                                     Minimum period allowed between
+--                                     consecutive rising ('P') or 
+--                                     falling ('F') transitions.
+--    PulseWidthHigh VitalDelayArrayType 
+--                                     Minimum time allowed for a high
+--                                     pulse ('1' or 'H')
+--    PulseWidthLow  VitalDelayArrayType 
+--                                     Minimum time allowed for a low
+--                                     pulse ('0' or 'L')
+--    CheckEnabled   BOOLEAN           Check performed if TRUE.
+--    HeaderMsg      STRING            String that will accompany any
+--                                     assertion messages produced.   
+--    XOn            BOOLEAN           If TRUE, Violation output parameter
+--                                     is set to "X". Otherwise, Violation
+--                                     is always set to "0." 
+--    MsgOn          BOOLEAN           If TRUE, period/pulse violation
+--                                     message will be generated.
+--                                     Otherwise, no messages are generated,
+--                                     even though a violation is detected. 
+--    MsgSeverity    SEVERITY_LEVEL    Severity level for the assertion.
+--    MsgFormat      VitalMemoryMsgFormatType
+--                                     Format of the Test/Reference signals
+--                                     in violation messages.
+--         
+--    INOUT
+--    PeriodData     VitalPeriodDataArrayType 
+--                                     VitalPeriodPulseCheck information
+--                                     storage area.  This is used
+--                                     internally to detect reference edges
+--                                     and record the pulse and period
+--                                     times.
+--    OUT
+--    Violation      X01               This is the violation flag returned. 
+--                   X01ArrayT         Overloaded for array type.
+--
+-- ----------------------------------------------------------------------------
+PROCEDURE  VitalMemoryPeriodPulseCheck  (
+  VARIABLE Violation      : OUT   X01ArrayT; 
+  VARIABLE PeriodData     : INOUT VitalPeriodDataArrayType; 
+  SIGNAL   TestSignal     : IN    std_logic_vector;
+  CONSTANT TestSignalName : IN    STRING := "";
+  CONSTANT TestDelay      : IN    VitalDelayArrayType;
+  CONSTANT Period         : IN    VitalDelayArrayType;
+  CONSTANT PulseWidthHigh : IN    VitalDelayArrayType;
+  CONSTANT PulseWidthLow  : IN    VitalDelayArrayType;
+  CONSTANT CheckEnabled   : IN    BOOLEAN := TRUE;
+  CONSTANT HeaderMsg      : IN    STRING := " ";
+  CONSTANT XOn            : IN    BOOLEAN := TRUE;
+  CONSTANT MsgOn          : IN    BOOLEAN := TRUE;
+  CONSTANT MsgSeverity    : IN    SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat      : IN    VitalMemoryMsgFormatType
+);
+
+PROCEDURE  VitalMemoryPeriodPulseCheck  (
+  VARIABLE Violation      : OUT   X01; 
+  VARIABLE PeriodData     : INOUT VitalPeriodDataArrayType;
+  SIGNAL   TestSignal     : IN    std_logic_vector;
+  CONSTANT TestSignalName : IN    STRING := "";
+  CONSTANT TestDelay      : IN    VitalDelayArrayType;
+  CONSTANT Period         : IN    VitalDelayArrayType;
+  CONSTANT PulseWidthHigh : IN    VitalDelayArrayType;
+  CONSTANT PulseWidthLow  : IN    VitalDelayArrayType;
+  CONSTANT CheckEnabled   : IN    BOOLEAN := TRUE;
+  CONSTANT HeaderMsg      : IN    STRING := " ";
+  CONSTANT XOn            : IN    BOOLEAN := TRUE;
+  CONSTANT MsgOn          : IN    BOOLEAN := TRUE;
+  CONSTANT MsgSeverity    : IN    SEVERITY_LEVEL := WARNING;
+  CONSTANT MsgFormat      : IN    VitalMemoryMsgFormatType
+);
+
+-- ----------------------------------------------------------------------------
+-- Functionality Section
+-- ----------------------------------------------------------------------------
+
+-- ----------------------------------------------------------------------------
+-- All Memory Types and Record definitions.
+-- ----------------------------------------------------------------------------
+TYPE MemoryWordType        IS ARRAY (NATURAL RANGE <>) OF UX01;
+TYPE MemoryWordPtr         IS ACCESS MemoryWordType;
+
+TYPE MemoryArrayType       IS ARRAY (NATURAL RANGE <>) OF MemoryWordPtr;
+TYPE MemoryArrayPtrType    IS ACCESS MemoryArrayType;
+
+TYPE VitalMemoryArrayRecType IS 
+RECORD
+NoOfWords           : POSITIVE;
+NoOfBitsPerWord     : POSITIVE;
+NoOfBitsPerSubWord  : POSITIVE;
+NoOfBitsPerEnable   : POSITIVE;
+MemoryArrayPtr      : MemoryArrayPtrType;
+END RECORD;
+
+TYPE VitalMemoryDataType    IS ACCESS VitalMemoryArrayRecType;
+
+TYPE VitalTimingDataVectorType IS 
+ARRAY (NATURAL RANGE <>) OF VitalTimingDataType;
+
+TYPE VitalMemoryViolFlagSizeType IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+
+-- ----------------------------------------------------------------------------
+-- Symbol Literals used for Memory Table Modeling
+-- ----------------------------------------------------------------------------
+
+-- Symbol literals from '/' to 'S' are closely related to MemoryTableMatch
+-- lookup matching and the order cannot be arbitrarily changed.
+-- The remaining symbol literals are interpreted directly and matchting is
+-- handled in the MemoryMatch procedure itself.
+
+TYPE VitalMemorySymbolType IS (
+  '/',      -- 0 -> 1
+  '\',      -- 1 -> 0
+  'P',      -- Union of '/' and '^' (any edge to 1)
+  'N',      -- Union of '\' and 'v' (any edge to 0)
+  'r',      -- 0 -> X
+  'f',      -- 1 -> X
+  'p',      -- Union of '/' and 'r' (any edge from 0)
+  'n',      -- Union of '\' and 'f' (any edge from 1)
+  'R',      -- Union of '^' and 'p' (any possible rising edge)
+  'F',      -- Union of 'v' and 'n' (any possible falling edge)
+  '^',      -- X -> 1
+  'v',      -- X -> 0
+  'E',      -- Union of 'v' and '^' (any edge from X)
+  'A',      -- Union of 'r' and '^' (rising edge to or from 'X')
+
+  'D',      -- Union of 'f' and 'v' (falling edge to or from 'X')
+
+  '*',      -- Union of 'R' and 'F' (any edge)
+  'X',      -- Unknown level
+  '0',      -- low level
+  '1',      -- high level
+  '-',      -- don't care
+  'B',      -- 0 or 1
+  'Z',      -- High Impedance
+  'S',      -- steady value
+
+  'g',      -- Good address (no transition)
+  'u',      -- Unknown address (no transition)
+  'i',      -- Invalid address (no transition)
+  'G',      -- Good address (with transition)
+  'U',      -- Unknown address (with transition)
+  'I',      -- Invalid address (with transition)
+
+  'w',      -- Write data to memory
+  's',      -- Retain previous memory contents
+
+  'c',      -- Corrupt entire memory with 'X'
+  'l',      -- Corrupt a word in memory with 'X'
+  'd',      -- Corrupt a single bit in memory with 'X'
+  'e',      -- Corrupt a word with 'X' based on data in 
+  'C',      -- Corrupt a sub-word entire memory with 'X' 
+  'L',      -- Corrupt a sub-word in memory with 'X' 
+
+  -- The following entries are commented since their 
+  -- interpretation overlap with existing definitions.
+
+  --      'D',      -- Corrupt a single bit of a sub-word with 'X'
+  --      'E',      -- Corrupt a sub-word with 'X' based on datain
+
+  'M',      -- Implicit read data from memory
+  'm',      -- Read data from memory
+  't'       -- Immediate assign/transfer data in
+
+);
+
+TYPE VitalMemoryTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> )
+  OF VitalMemorySymbolType;
+
+TYPE VitalMemoryViolationSymbolType IS (
+  'X',      -- Unknown level
+  '0',      -- low level
+  '-'       -- don't care
+);
+
+TYPE VitalMemoryViolationTableType IS 
+  ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> )
+  OF VitalMemoryViolationSymbolType;
+
+TYPE VitalPortType IS (
+  UNDEF,
+  READ,
+  WRITE,
+  RDNWR
+);
+
+TYPE VitalCrossPortModeType IS (
+  CpRead,                         --  CpReadOnly,
+  WriteContention,                --  WrContOnly,
+  ReadWriteContention,            --  CpContention
+  CpReadAndWriteContention,       --  WrContAndCpRead,
+  CpReadAndReadContention
+);
+
+SUBTYPE VitalAddressValueType IS INTEGER;
+TYPE VitalAddressValueVectorType IS 
+  ARRAY (NATURAL RANGE <>) OF VitalAddressValueType;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalDeclareMemory
+-- Parameters:  NoOfWords          - Number of words in the memory
+--              NoOfBitsPerWord    - Number of bits per word in memory
+--              NoOfBitsPerSubWord - Number of bits per sub word
+--              MemoryLoadFile     - Name of data file to load
+-- Description: This function is intended to be used to initialize
+--              memory data declarations, i.e. to be executed duing
+--              simulation elaboration time.  Handles the allocation
+--              and initialization of memory for the memory data.
+--              Default NoOfBitsPerSubWord is NoOfBits.
+-- ----------------------------------------------------------------------------
+
+IMPURE FUNCTION VitalDeclareMemory (
+  CONSTANT NoOfWords          : IN POSITIVE;
+  CONSTANT NoOfBitsPerWord    : IN POSITIVE;
+  CONSTANT NoOfBitsPerSubWord : IN POSITIVE;
+  CONSTANT MemoryLoadFile     : IN string := "";
+  CONSTANT BinaryLoadFile     : IN BOOLEAN := FALSE
+) RETURN VitalMemoryDataType;
+
+IMPURE FUNCTION VitalDeclareMemory (
+  CONSTANT NoOfWords          : IN POSITIVE;
+  CONSTANT NoOfBitsPerWord    : IN POSITIVE;
+  CONSTANT MemoryLoadFile     : IN string := "";
+  CONSTANT BinaryLoadFile     : IN BOOLEAN := FALSE
+) RETURN VitalMemoryDataType;
+
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryTable
+-- Parameters:  DataOutBus     - Output candidate zero delay data bus out
+--              MemoryData     - Pointer to memory data structure
+--              PrevControls   - Previous data in for edge detection
+--              PrevEnableBus  - Previous enables for edge detection
+--              PrevDataInBus  - Previous data bus for edge detection
+--              PrevAddressBus - Previous address bus for edge detection
+--              PortFlag       - Indicates port operating mode
+--              PortFlagArray  - Vector form of PortFlag for sub-word
+--              Controls       - Agregate of scalar control lines
+--              EnableBus      - Concatenation of vector control lines
+--              DataInBus      - Input value of data bus in
+--              AddressBus     - Input value of address bus in
+--              AddressValue   - Decoded value of the AddressBus
+--              MemoryTable    - Input memory action table
+--              PortType       - The type of port (currently not used)
+--              PortName       - Port name string for messages
+--              HeaderMsg      - Header string for messages
+--              MsgOn          - Control the generation of messages
+--              MsgSeverity    - Control level of message generation
+-- Description: This procedure implements the majority of the memory 
+--              modeling functionality via lookup of the memory action
+--              tables and performing the specified actions if matches
+--              are found, or the default actions otherwise.  The
+--              overloadings are provided for the word and sub-word
+--              (using the EnableBus and PortFlagArray arguments) addressing
+--              cases.
+-- ----------------------------------------------------------------------------
+
+PROCEDURE VitalMemoryTable (
+  VARIABLE DataOutBus     : INOUT std_logic_vector;
+  VARIABLE MemoryData     : INOUT VitalMemoryDataType;
+  VARIABLE PrevControls   : INOUT std_logic_vector;
+  VARIABLE PrevDataInBus  : INOUT std_logic_vector;
+  VARIABLE PrevAddressBus : INOUT std_logic_vector;
+  VARIABLE PortFlag       : INOUT VitalPortFlagVectorType;
+  CONSTANT Controls       : IN std_logic_vector;
+  CONSTANT DataInBus      : IN std_logic_vector;
+  CONSTANT AddressBus     : IN std_logic_vector;
+  VARIABLE AddressValue   : INOUT VitalAddressValueType;
+  CONSTANT MemoryTable    : IN VitalMemoryTableType;
+  CONSTANT PortType       : IN VitalPortType := UNDEF;
+  CONSTANT PortName       : IN STRING := "";
+  CONSTANT HeaderMsg      : IN STRING := "";
+  CONSTANT MsgOn          : IN BOOLEAN := TRUE;
+  CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+);
+
+PROCEDURE VitalMemoryTable (
+  VARIABLE DataOutBus     : INOUT std_logic_vector;
+  VARIABLE MemoryData     : INOUT VitalMemoryDataType;
+  VARIABLE PrevControls   : INOUT std_logic_vector;
+  VARIABLE PrevEnableBus  : INOUT std_logic_vector;
+  VARIABLE PrevDataInBus  : INOUT std_logic_vector;
+  VARIABLE PrevAddressBus : INOUT std_logic_vector;
+  VARIABLE PortFlagArray  : INOUT VitalPortFlagVectorType;
+  CONSTANT Controls       : IN std_logic_vector;
+  CONSTANT EnableBus      : IN std_logic_vector;
+  CONSTANT DataInBus      : IN std_logic_vector;
+  CONSTANT AddressBus     : IN std_logic_vector;
+  VARIABLE AddressValue   : INOUT VitalAddressValueType;
+  CONSTANT MemoryTable    : IN VitalMemoryTableType;
+  CONSTANT PortType       : IN VitalPortType := UNDEF;
+  CONSTANT PortName       : IN STRING := "";
+  CONSTANT HeaderMsg      : IN STRING := "";
+  CONSTANT MsgOn          : IN BOOLEAN := TRUE;
+  CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+);
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryCrossPorts
+-- Parameters:  DataOutBus     - Output candidate zero delay data bus out
+--              MemoryData     - Pointer to memory data structure
+--              SamePortFlag   - Operating mode for same port
+--              SamePortAddressValue  - Decoded AddressBus for same port
+--              CrossPortFlagArray    - Operating modes for cross ports
+--              CrossPortAddressArray - Decoded AddressBus for cross ports
+--              CrossPortMode  - Write contention and crossport read control
+--              PortName       - Port name string for messages
+--              HeaderMsg      - Header string for messages
+--              MsgOn          - Control the generation of messages
+--
+-- Description: These procedures control the effect of memory operations
+--              on a given port due to operations on other ports in a
+--              multi-port memory.
+--              This includes data write through when reading and writing 
+--              to the same address, as well as write contention when
+--              there are multiple write to the same address.
+--              If addresses do not match then data bus is unchanged. 
+--              The DataOutBus can be diabled with 'Z' value.
+-- ----------------------------------------------------------------------------
+
+PROCEDURE VitalMemoryCrossPorts (
+  VARIABLE DataOutBus             : INOUT std_logic_vector;
+  VARIABLE MemoryData             : INOUT VitalMemoryDataType;
+  VARIABLE SamePortFlag           : INOUT VitalPortFlagVectorType;
+  CONSTANT SamePortAddressValue   : IN VitalAddressValueType;
+  CONSTANT CrossPortFlagArray     : IN VitalPortFlagVectorType;
+  CONSTANT CrossPortAddressArray  : IN VitalAddressValueVectorType;
+  CONSTANT CrossPortMode          : IN VitalCrossPortModeType 
+                                      := CpReadAndWriteContention;
+  CONSTANT PortName               : IN STRING := "";
+  CONSTANT HeaderMsg              : IN STRING := "";
+  CONSTANT MsgOn                  : IN BOOLEAN := TRUE
+) ;
+
+PROCEDURE VitalMemoryCrossPorts (
+  VARIABLE MemoryData             : INOUT VitalMemoryDataType;
+  CONSTANT CrossPortFlagArray     : IN VitalPortFlagVectorType;
+  CONSTANT CrossPortAddressArray  : IN VitalAddressValueVectorType;
+  CONSTANT HeaderMsg              : IN STRING := "";
+  CONSTANT MsgOn                  : IN BOOLEAN := TRUE
+) ;
+
+-- ----------------------------------------------------------------------------
+-- Procedure:   VitalMemoryViolation
+-- Parameters:  DataOutBus          - Output zero delay data bus out
+--              MemoryData          - Pointer to memory data structure
+--              PortFlag            - Indicates port operating mode
+--              DataInBus           - Input value of data bus in
+--              AddressValue        - Decoded value of the AddressBus
+--              ViolationFlags      - Aggregate of scalar violation vars
+--              ViolationFlagsArray - Concatenation of vector violation vars
+--              ViolationTable      - Input memory violation table
+--              PortType            - The type of port (currently not used)
+--              PortName            - Port name string for messages
+--              HeaderMsg           - Header string for messages
+--              MsgOn               - Control the generation of messages
+--              MsgSeverity         - Control level of message generation
+-- Description: This procedure is intended to implement all actions on the
+--              memory contents and data out bus as a result of timing viols.
+--              It uses the memory action table to perform various corruption
+--              policies specified by the user. 
+-- ----------------------------------------------------------------------------
+
+PROCEDURE VitalMemoryViolation (
+  VARIABLE DataOutBus           : INOUT std_logic_vector;
+  VARIABLE MemoryData           : INOUT VitalMemoryDataType;
+  VARIABLE PortFlag             : INOUT VitalPortFlagVectorType;
+  CONSTANT DataInBus            : IN std_logic_vector;
+  CONSTANT AddressValue         : IN VitalAddressValueType;
+  CONSTANT ViolationFlags       : IN std_logic_vector;
+  CONSTANT ViolationFlagsArray  : IN X01ArrayT;
+  CONSTANT ViolationSizesArray  : IN VitalMemoryViolFlagSizeType;
+  CONSTANT ViolationTable       : IN VitalMemoryTableType;
+  CONSTANT PortType             : IN VitalPortType; 
+  CONSTANT PortName             : IN STRING := "";
+  CONSTANT HeaderMsg            : IN STRING := "";
+  CONSTANT MsgOn                : IN BOOLEAN := TRUE;
+  CONSTANT MsgSeverity          : IN SEVERITY_LEVEL := WARNING
+) ;
+
+PROCEDURE VitalMemoryViolation (
+  VARIABLE DataOutBus           : INOUT std_logic_vector;
+  VARIABLE MemoryData           : INOUT VitalMemoryDataType;
+  VARIABLE PortFlag             : INOUT VitalPortFlagVectorType;
+  CONSTANT DataInBus            : IN std_logic_vector;
+  CONSTANT AddressValue         : IN VitalAddressValueType;
+  CONSTANT ViolationFlags       : IN std_logic_vector;
+  CONSTANT ViolationTable       : IN VitalMemoryTableType;
+  CONSTANT PortType             : IN VitalPortType; 
+  CONSTANT PortName             : IN STRING := "";
+  CONSTANT HeaderMsg            : IN STRING := "";
+  CONSTANT MsgOn                : IN BOOLEAN := TRUE;
+  CONSTANT MsgSeverity          : IN SEVERITY_LEVEL := WARNING
+) ;
+
+END Vital_Memory;
diff --git a/libraries/vital2000/prmtvs_b.vhdl b/libraries/vital2000/prmtvs_b.vhdl
new file mode 100644
index 000000000..c015e62d5
--- /dev/null
+++ b/libraries/vital2000/prmtvs_b.vhdl
@@ -0,0 +1,5622 @@
+-------------------------------------------------------------------------------
+-- Title        : Standard VITAL_Primitives Package
+--              : $Revision: 600 $
+--              :
+-- Library      : VITAL
+--              :
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              :
+-- Purpose      : This packages defines standard types, constants, functions
+--              : and procedures for use in developing ASIC models.
+--              : Specifically a set of logic primitives are defined.
+--              :  
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History : 
+-- ----------------------------------------------------------------------------
+-- Version No:|Auth:| Mod.Date:| Changes Made:
+--   v95.0 A  |     | 06/02/95 | Initial ballot draft 1995
+--   v95.1    |     | 08/31/95 | #204 - glitch detection prior to OutputMap
+-- ----------------------------------------------------------------------------
+--   v95.2    | ddl | 09/14/96 | #223 - single input prmtvs use on-detect
+--            |     |          |        instead of glitch-on-event behavior
+--   v95.3    | ddl | 09/24/96 | #236 - VitalTruthTable DataIn should be of
+--            |     |          |        of class SIGNAL
+--   v95.4    | ddl | 01/16/97 | #243 - index constraint error in nbit xor/xnor
+--   v99.1    | dbb | 03/31/99 | Updated for VHDL 93
+-- ----------------------------------------------------------------------------
+
+LIBRARY STD;
+USE STD.TEXTIO.ALL;
+
+PACKAGE BODY VITAL_Primitives IS
+    -- ------------------------------------------------------------------------
+    --  Default values for Primitives
+    -- ------------------------------------------------------------------------
+    --  default values for delay parameters
+    CONSTANT VitalDefDelay01  : VitalDelayType01  := VitalZeroDelay01;
+    CONSTANT VitalDefDelay01Z : VitalDelayType01Z := VitalZeroDelay01Z;
+
+    TYPE VitalTimeArray IS ARRAY (NATURAL RANGE <>) OF TIME;    
+
+    --  default primitive model operation parameters
+    --  Glitch detection/reporting
+    TYPE VitalGlitchModeType IS ( MessagePlusX, MessageOnly, XOnly, NoGlitch);
+    CONSTANT PrimGlitchMode : VitalGlitchModeType   := XOnly;
+
+    -- ------------------------------------------------------------------------
+    -- Local Type and Subtype Declarations
+    -- ------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    -- enumeration value representing the transition or level of the signal.
+    --  See function 'GetEdge'
+    ---------------------------------------------------------------------------
+    TYPE EdgeType IS ( 'U',   -- Uninitialized level
+                       'X',   -- Unknown level
+                       '0',   -- low level
+                       '1',   -- high level
+                       '\',   -- 1 to 0 falling edge
+                       '/',   -- 0 to 1 rising  edge
+                       'F',   -- * to 0 falling edge
+                       'R',   -- * to 1 rising  edge
+                       'f',   -- rising  to X edge
+                       'r',   -- falling to X edge
+                       'x',   -- Unknown edge (ie U->X)
+                       'V'    -- Timing violation edge
+                     );
+    TYPE EdgeArray  IS ARRAY ( NATURAL RANGE <> ) OF EdgeType;
+
+    TYPE EdgeX1Table IS ARRAY ( EdgeType                          ) OF EdgeType;
+    TYPE EdgeX2Table IS ARRAY ( EdgeType, EdgeType                ) OF EdgeType;
+    TYPE EdgeX3Table IS ARRAY ( EdgeType, EdgeType, EdgeType      ) OF EdgeType;
+    TYPE EdgeX4Table IS ARRAY (EdgeType,EdgeType,EdgeType,EdgeType) OF EdgeType;
+
+    TYPE LogicToEdgeT  IS ARRAY(std_ulogic, std_ulogic) OF EdgeType;
+    TYPE LogicToLevelT IS ARRAY(std_ulogic ) OF EdgeType;
+
+    TYPE GlitchDataType IS 
+      RECORD 
+        SchedTime    : TIME; 
+        GlitchTime   : TIME; 
+        SchedValue   : std_ulogic;
+        CurrentValue    : std_ulogic; 
+      END RECORD; 
+    TYPE GlitchDataArrayType IS ARRAY (NATURAL RANGE <>) 
+         OF GlitchDataType;
+ 
+    -- Enumerated type used in selection of output path delays
+    TYPE SchedType  IS
+      RECORD
+        inp0  : TIME;   -- time (abs) of output change due to input change to 0
+        inp1  : TIME;   -- time (abs) of output change due to input change to 1
+        InpX  : TIME;   -- time (abs) of output change due to input change to X
+        Glch0 : TIME;   -- time (abs) of output glitch due to input change to 0
+        Glch1 : TIME;   -- time (abs) of output glitch due to input change to 0
+      END RECORD;
+
+    TYPE SchedArray  IS ARRAY ( NATURAL RANGE <> ) OF SchedType;
+    CONSTANT DefSchedType : SchedType := (TIME'HIGH, TIME'HIGH, 0 ns,0 ns,0 ns);
+    CONSTANT DefSchedAnd  : SchedType := (TIME'HIGH, 0 ns,0 ns, TIME'HIGH,0 ns);
+
+    -- Constrained array declarations (common sizes used by primitives)
+    SUBTYPE SchedArray2 IS SchedArray(1 DOWNTO 0);
+    SUBTYPE SchedArray3 IS SchedArray(2 DOWNTO 0);
+    SUBTYPE SchedArray4 IS SchedArray(3 DOWNTO 0);
+    SUBTYPE SchedArray8 IS SchedArray(7 DOWNTO 0);
+
+    SUBTYPE TimeArray2 IS VitalTimeArray(1 DOWNTO 0);
+    SUBTYPE TimeArray3 IS VitalTimeArray(2 DOWNTO 0);
+    SUBTYPE TimeArray4 IS VitalTimeArray(3 DOWNTO 0);
+    SUBTYPE TimeArray8 IS VitalTimeArray(7 DOWNTO 0);
+
+    SUBTYPE GlitchArray2 IS GlitchDataArrayType(1 DOWNTO 0);
+    SUBTYPE GlitchArray3 IS GlitchDataArrayType(2 DOWNTO 0);
+    SUBTYPE GlitchArray4 IS GlitchDataArrayType(3 DOWNTO 0);
+    SUBTYPE GlitchArray8 IS GlitchDataArrayType(7 DOWNTO 0);
+
+    SUBTYPE EdgeArray2 IS EdgeArray(1 DOWNTO 0);
+    SUBTYPE EdgeArray3 IS EdgeArray(2 DOWNTO 0);
+    SUBTYPE EdgeArray4 IS EdgeArray(3 DOWNTO 0);
+    SUBTYPE EdgeArray8 IS EdgeArray(7 DOWNTO 0);
+
+    CONSTANT DefSchedArray2 : SchedArray2 :=
+                             (OTHERS=> (0 ns, 0 ns, 0 ns, 0 ns, 0 ns));
+
+    TYPE stdlogic_table IS ARRAY(std_ulogic, std_ulogic) OF std_ulogic;
+
+    CONSTANT InitialEdge : LogicToLevelT := (
+            '1'|'H' => 'R',
+            '0'|'L' => 'F',
+            OTHERS  => 'x'
+     );
+
+    CONSTANT LogicToEdge  : LogicToEdgeT  := (  -- previous, current
+    --  old \ new: U    X    0    1    Z    W    L    H    -
+        'U' =>  ( 'U', 'x', 'F', 'R', 'x', 'x', 'F', 'R', 'x' ),
+        'X' =>  ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ),
+        '0' =>  ( 'r', 'r', '0', '/', 'r', 'r', '0', '/', 'r' ),
+        '1' =>  ( 'f', 'f', '\', '1', 'f', 'f', '\', '1', 'f' ),
+        'Z' =>  ( 'x', 'X', 'F', 'R', 'X', 'x', 'F', 'R', 'x' ),
+        'W' =>  ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ),
+        'L' =>  ( 'r', 'r', '0', '/', 'r', 'r', '0', '/', 'r' ),
+        'H' =>  ( 'f', 'f', '\', '1', 'f', 'f', '\', '1', 'f' ),
+        '-' =>  ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' )
+    );
+    CONSTANT LogicToLevel : LogicToLevelT := (
+            '1'|'H' => '1',
+            '0'|'L' => '0',
+            'U'     => 'U',
+            OTHERS  => 'X'
+     );
+
+    -- -----------------------------------
+    -- 3-state logic tables
+    -- -----------------------------------
+    CONSTANT BufIf0_Table : stdlogic_table :=
+        -- enable        data       value
+        ( '1'|'H'   => ( OTHERS  => 'Z' ),
+          '0'|'L'   => ( '1'|'H' => '1',
+                         '0'|'L' => '0',
+                         'U'     => 'U',
+                         OTHERS  => 'X' ),
+          'U'       => ( OTHERS  => 'U' ),
+          OTHERS    => ( OTHERS  => 'X' ) );
+    CONSTANT BufIf1_Table : stdlogic_table :=
+        -- enable        data       value
+        ( '0'|'L'   => ( OTHERS  => 'Z' ),
+          '1'|'H'   => ( '1'|'H' => '1',
+                         '0'|'L' => '0',
+                         'U'     => 'U',
+                         OTHERS  => 'X' ),
+          'U'       => ( OTHERS  => 'U' ),
+          OTHERS    => ( OTHERS  => 'X' ) );
+    CONSTANT InvIf0_Table : stdlogic_table :=
+        -- enable        data       value
+        ( '1'|'H'   => ( OTHERS  => 'Z' ),
+          '0'|'L'   => ( '1'|'H' => '0',
+                         '0'|'L' => '1',
+                         'U'     => 'U',
+                         OTHERS  => 'X' ),
+          'U'       => ( OTHERS  => 'U' ),
+          OTHERS    => ( OTHERS  => 'X' ) );
+    CONSTANT InvIf1_Table : stdlogic_table :=
+        -- enable        data       value
+        ( '0'|'L'   => ( OTHERS  => 'Z' ),
+          '1'|'H'   => ( '1'|'H' => '0',
+                         '0'|'L' => '1',
+                         'U'     => 'U',
+                         OTHERS  => 'X' ),
+          'U'       => ( OTHERS  => 'U' ),
+          OTHERS    => ( OTHERS  => 'X' ) );
+
+
+    TYPE To_StateCharType IS ARRAY (VitalStateSymbolType) OF CHARACTER;
+    CONSTANT To_StateChar : To_StateCharType :=
+     ( '/', '\', 'P', 'N', 'r', 'f', 'p', 'n', 'R', 'F', '^', 'v',
+       'E', 'A', 'D', '*', 'X', '0', '1', '-', 'B', 'Z', 'S' );
+    TYPE To_TruthCharType IS ARRAY (VitalTruthSymbolType) OF CHARACTER;
+    CONSTANT To_TruthChar : To_TruthCharType :=
+     ( 'X', '0', '1', '-', 'B', 'Z' );
+
+    TYPE TruthTableOutMapType IS ARRAY (VitalTruthSymbolType) OF std_ulogic;
+    CONSTANT TruthTableOutMap : TruthTableOutMapType :=
+       --  'X', '0', '1', '-', 'B', 'Z'
+         ( 'X', '0', '1', 'X', '-', 'Z' );
+
+    TYPE StateTableOutMapType IS ARRAY (VitalStateSymbolType) OF std_ulogic;
+    -- does conversion to X01Z or '-' if invalid
+    CONSTANT StateTableOutMap : StateTableOutMapType :=
+     -- '/' '\' 'P' 'N' 'r' 'f' 'p' 'n' 'R' 'F' '^' 'v'
+     -- 'E' 'A' 'D' '*' 'X' '0' '1' '-' 'B' 'Z' 'S'
+      ( '-','-','-','-','-','-','-','-','-','-','-','-',
+        '-','-','-','-','X','0','1','X','-','Z','W');
+
+    -- ------------------------------------------------------------------------
+    TYPE ValidTruthTableInputType IS ARRAY (VitalTruthSymbolType) OF BOOLEAN;
+    -- checks if a symbol IS valid for the stimulus portion of a truth table
+    CONSTANT ValidTruthTableInput : ValidTruthTableInputType :=
+       -- 'X'    '0'    '1'    '-'    'B'    'Z'
+       (  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  FALSE );
+
+    TYPE TruthTableMatchType IS ARRAY (X01, VitalTruthSymbolType) OF BOOLEAN;
+    -- checks if an input matches th corresponding truth table symbol
+    -- use: TruthTableMatch(input_converted_to_X01, truth_table_stimulus_symbol)
+    CONSTANT TruthTableMatch : TruthTableMatchType  :=  (
+       -- X,     0,     1,     -      B      Z
+       (  TRUE,  FALSE, FALSE, TRUE,  FALSE, FALSE  ),  -- X
+       (  FALSE, TRUE,  FALSE, TRUE,  TRUE,  FALSE  ),  -- 0
+       (  FALSE, FALSE, TRUE,  TRUE,  TRUE,  FALSE  )   -- 1
+    );
+
+    -- ------------------------------------------------------------------------
+    TYPE ValidStateTableInputType IS ARRAY (VitalStateSymbolType) OF BOOLEAN;
+    CONSTANT ValidStateTableInput : ValidStateTableInputType :=
+       -- '/',   '\',   'P',   'N',   'r',   'f',
+      (   TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,
+       -- 'p',   'n',   'R',   'F',   '^',   'v',
+          TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,
+       -- 'E',   'A',    'D',  '*',
+          TRUE,  TRUE,  TRUE,  TRUE,
+       -- 'X',   '0',   '1',   '-',   'B',   'Z',
+          TRUE,  TRUE,  TRUE,  TRUE,  TRUE, FALSE,
+       -- 'S'
+          TRUE );
+
+    CONSTANT ValidStateTableState : ValidStateTableInputType :=
+       -- '/',   '\',   'P',   'N',   'r',   'f',
+      (   FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+       -- 'p',   'n',   'R',   'F',   '^',   'v',
+          FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+       -- 'E',   'A',    'D',  '*',
+          FALSE, FALSE, FALSE, FALSE,
+       -- 'X',   '0',   '1',   '-',   'B',   'Z',
+          TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  FALSE,
+       -- 'S'
+          FALSE );
+
+    TYPE StateTableMatchType IS ARRAY (X01,X01,VitalStateSymbolType) OF BOOLEAN;
+    -- last value, present value, table symbol
+    CONSTANT StateTableMatch : StateTableMatchType :=  (
+      ( -- X (lastvalue)
+     -- /     \     P     N     r     f
+     -- p     n     R     F     ^     v
+     -- E     A     D     *
+     -- X     0     1     -     B     Z     S
+      (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,
+       TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE),
+      (FALSE,FALSE,FALSE,TRUE, FALSE,FALSE,
+       FALSE,FALSE,FALSE,TRUE, FALSE,TRUE,
+       TRUE, FALSE,TRUE, TRUE,
+       FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE),
+      (FALSE,FALSE,TRUE, FALSE,FALSE,FALSE,
+       FALSE,FALSE,TRUE, FALSE,TRUE, FALSE,
+       TRUE, TRUE, FALSE,TRUE,
+       FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE)
+      ),
+
+      (-- 0 (lastvalue)
+     -- /     \     P     N     r     f
+     -- p     n     R     F     ^     v
+     -- E     A     D     *
+     -- X     0     1     -     B     Z     S
+      (FALSE,FALSE,FALSE,FALSE,TRUE, FALSE,
+       TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+       FALSE,TRUE, FALSE,TRUE,
+       TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE),
+      (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,
+       FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,TRUE ),
+      (TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+       TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,TRUE,
+       FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE)
+      ),
+
+      (-- 1 (lastvalue)
+     -- /     \     P     N     r     f
+     -- p     n     R     F     ^     v
+     -- E     A     D     *
+     -- X     0     1     -     B     Z     S
+      (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE ,
+       FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+       FALSE,FALSE,TRUE, TRUE,
+       TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE),
+      (FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+       FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+       FALSE,FALSE,FALSE,TRUE,
+       FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE),
+      (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,TRUE )
+      )
+      );
+
+    TYPE Logic_UX01Z_Table IS ARRAY (std_ulogic) OF UX01Z;
+    ----------------------------------------------------------
+    -- table name : cvt_to_x01z
+    -- parameters :  std_ulogic  -- some logic value
+    -- returns    :  UX01Z       -- state value of logic value
+    -- purpose    :  to convert state-strength to state only
+    ----------------------------------------------------------
+    CONSTANT cvt_to_ux01z : Logic_UX01Z_Table :=
+                                ('U','X','0','1','Z','X','0','1','X' );
+
+    TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; 
+    CONSTANT LogicCvtTable : LogicCvtTableType 
+                     := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); 
+
+    --------------------------------------------------------------------
+    -- LOCAL Utilities
+    --------------------------------------------------------------------
+    -- ------------------------------------------------------------------------
+    --  FUNCTION  NAME  :  MINIMUM
+    --
+    --  PARAMETERS      :  in1, in2  - integer, time
+    --
+    --  DESCRIPTION     :  return smaller of in1 and in2
+    -- ------------------------------------------------------------------------
+    FUNCTION Minimum (
+            CONSTANT in1, in2 : INTEGER
+          ) RETURN INTEGER IS
+    BEGIN
+       IF (in1 < in2) THEN
+          RETURN in1;
+       END IF;
+       RETURN in2;
+    END;
+    -- ------------------------------------------------------------------------
+    FUNCTION Minimum (
+            CONSTANT t1,t2 : IN TIME
+          ) RETURN TIME IS
+    BEGIN
+        IF ( t1 < t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+    END Minimum;
+
+    -- ------------------------------------------------------------------------
+    --  FUNCTION  NAME  :  MAXIMUM
+    --
+    --  PARAMETERS      :  in1, in2  - integer, time
+    --
+    --  DESCRIPTION     :  return larger of in1 and in2
+    -- ------------------------------------------------------------------------
+    FUNCTION Maximum (
+            CONSTANT in1, in2 : INTEGER
+          ) RETURN INTEGER IS
+    BEGIN
+       IF (in1 > in2) THEN
+          RETURN in1;
+       END IF;
+       RETURN in2;
+    END;
+    -----------------------------------------------------------------------
+    FUNCTION Maximum (
+            CONSTANT t1,t2 : IN TIME
+          ) RETURN TIME IS
+    BEGIN
+        IF ( t1 > t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+    END Maximum;
+
+    -----------------------------------------------------------------------
+    FUNCTION GlitchMinTime (
+            CONSTANT Time1, Time2 : IN TIME
+          ) RETURN TIME IS
+    BEGIN
+        IF ( Time1 >= NOW ) THEN
+                IF ( Time2 >= NOW ) THEN
+                  RETURN Minimum ( Time1, Time2);
+                ELSE
+                  RETURN Time1;
+                END IF;
+        ELSE
+                IF ( Time2 >= NOW ) THEN
+                   RETURN Time2;
+                ELSE
+                   RETURN 0 ns;
+                END IF;
+        END IF;
+    END;
+
+    --------------------------------------------------------------------
+    -- Error Message Types and Tables
+    --------------------------------------------------------------------
+    TYPE VitalErrorType IS (
+        ErrNegDel,
+        ErrInpSym,
+        ErrOutSym,
+        ErrStaSym,
+        ErrVctLng,
+        ErrTabWidSml,
+        ErrTabWidLrg,
+        ErrTabResSml,
+        ErrTabResLrg
+    );
+
+    TYPE VitalErrorSeverityType IS ARRAY (VitalErrorType) OF SEVERITY_LEVEL;
+    CONSTANT VitalErrorSeverity : VitalErrorSeverityType := (
+        ErrNegDel    => WARNING,
+        ErrInpSym    => ERROR,
+        ErrOutSym    => ERROR,
+        ErrStaSym    => ERROR,
+        ErrVctLng    => ERROR,
+        ErrTabWidSml => ERROR,
+        ErrTabWidLrg => WARNING,
+        ErrTabResSml => WARNING,
+        ErrTabResLrg => WARNING
+    );
+
+    CONSTANT MsgNegDel : STRING :=
+      "Negative delay. New output value not scheduled. Output signal is: ";
+    CONSTANT MsgInpSym : STRING :=
+      "Illegal symbol in the input portion of a Truth/State table.";
+    CONSTANT MsgOutSym : STRING :=
+      "Illegal symbol in the output portion of a Truth/State table.";
+    CONSTANT MsgStaSym : STRING :=
+      "Illegal symbol in the state portion of a State table.";
+    CONSTANT MsgVctLng : STRING :=
+      "Vector (array) lengths not equal. ";
+    CONSTANT MsgTabWidSml : STRING :=
+      "Width of the Truth/State table is too small.";
+    CONSTANT MsgTabWidLrg : STRING :=
+      "Width of Truth/State table is too large. Extra elements are ignored.";
+    CONSTANT MsgTabResSml : STRING :=
+      "Result of Truth/State table has too many elements.";
+    CONSTANT MsgTabResLrg : STRING :=
+      "Result of Truth/State table has too few elements.";
+
+    CONSTANT MsgUnknown : STRING :=
+      "Unknown error message.";
+
+    --------------------------------------------------------------------
+    -- LOCAL Utilities
+    --------------------------------------------------------------------
+    FUNCTION VitalMessage (
+            CONSTANT ErrorId : IN VitalErrorType
+          ) RETURN STRING IS
+    BEGIN
+        CASE ErrorId IS
+            WHEN ErrNegDel    => RETURN MsgNegDel;
+            WHEN ErrInpSym    => RETURN MsgInpSym;
+            WHEN ErrOutSym    => RETURN MsgOutSym;
+            WHEN ErrStaSym    => RETURN MsgStaSym;
+            WHEN ErrVctLng    => RETURN MsgVctLng;
+            WHEN ErrTabWidSml => RETURN MsgTabWidSml;
+            WHEN ErrTabWidLrg => RETURN MsgTabWidLrg;
+            WHEN ErrTabResSml => RETURN MsgTabResSml;
+            WHEN ErrTabResLrg => RETURN MsgTabResLrg;
+            WHEN OTHERS       => RETURN MsgUnknown;
+        END CASE;
+    END;
+
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId)
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType;
+            CONSTANT Info    : IN STRING
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId) & Info
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType;
+            CONSTANT Info    : IN CHARACTER
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId) & Info
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE ReportGlitch ( 
+            CONSTANT GlitchRoutine  : IN  STRING;
+            CONSTANT OutSignalName  : IN  STRING;
+            CONSTANT PreemptedTime  : IN  TIME;
+            CONSTANT PreemptedValue : IN  std_ulogic;
+            CONSTANT NewTime        : IN  TIME;
+            CONSTANT NewValue       : IN  std_ulogic;
+            CONSTANT Index          : IN  INTEGER := 0;
+            CONSTANT IsArraySignal  : IN  BOOLEAN := FALSE;
+            CONSTANT MsgSeverity    : IN  SEVERITY_LEVEL := WARNING
+    ) IS
+
+        VARIABLE StrPtr1, StrPtr2, StrPtr3, StrPtr4, StrPtr5 : LINE;
+    BEGIN
+
+        Write (StrPtr1, PreemptedTime );
+        Write (StrPtr2, NewTime);
+        Write (StrPtr3, LogicCvtTable(PreemptedValue));
+        Write (StrPtr4, LogicCvtTable(NewValue));
+        IF IsArraySignal THEN
+            Write (StrPtr5, STRING'( "(" ) );
+            Write (StrPtr5, Index);
+            Write (StrPtr5, STRING'( ")" ) );
+        ELSE
+            Write (StrPtr5, STRING'( " " ) );
+        END IF;
+
+        -- Issue Report only if Preemted value has not been
+        --  removed from event queue
+        ASSERT PreemptedTime >  NewTime
+          REPORT GlitchRoutine & ": GLITCH Detected on port " & 
+                 OutSignalName & StrPtr5.ALL &
+                 "; Preempted Future Value := " & StrPtr3.ALL &
+                 " @ " & StrPtr1.ALL &
+                 "; Newly Scheduled Value := " & StrPtr4.ALL &
+                 " @ " & StrPtr2.ALL &
+                 ";"
+          SEVERITY MsgSeverity;
+
+        DEALLOCATE(StrPtr1);
+        DEALLOCATE(StrPtr2);
+        DEALLOCATE(StrPtr3);
+        DEALLOCATE(StrPtr4); 
+        DEALLOCATE(StrPtr5); 
+        RETURN;
+    END ReportGlitch;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : VitalGlitchOnEvent
+    --            :
+    -- Parameters : OutSignal ........ signal being driven
+    --            : OutSignalName..... name of the driven signal
+    --            : GlitchData........ internal data required by the procedure
+    --            : NewValue.......... new value being assigned
+    --            : NewDelay.......... Delay accompanying the assignment
+    --            :                    (Note: for vectors, this is an array)
+    --            : GlitchMode........ Glitch generation mode
+    --            :                     MessagePlusX, MessageOnly, 
+    --            :                     XOnly, NoGlitch )
+    --            : GlitchDelay....... if <= 0 ns , then there will be no Glitch
+    --            :                    if >  NewDelay, then there is no Glitch,
+    --            :                    otherwise, this is the time when a FORCED
+    --            :                    generation of a glitch will occur. 
+    ----------------------------------------------------------------------------
+    PROCEDURE VitalGlitchOnEvent (
+            SIGNAL   OutSignal        : OUT   std_logic;
+            CONSTANT OutSignalName    : IN    STRING;
+            VARIABLE GlitchData       : INOUT GlitchDataType;
+            CONSTANT NewValue         : IN    std_logic;
+            CONSTANT NewDelay         : IN    TIME := 0 ns;
+            CONSTANT GlitchMode       : IN    VitalGlitchModeType := MessagePlusX;
+            CONSTANT GlitchDelay      : IN    TIME := -1 ns;  -- IR#223
+            CONSTANT MsgSeverity      : IN    SEVERITY_LEVEL := WARNING
+    ) IS
+    -- ------------------------------------------------------------------------
+        VARIABLE NoGlitchDet  : BOOLEAN := FALSE;
+        VARIABLE OldGlitch    : BOOLEAN := FALSE;
+        VARIABLE Dly          : TIME    := NewDelay;
+
+    BEGIN
+        -- If nothing to schedule, just return
+        IF NewDelay < 0 ns THEN
+            IF (NewValue /= GlitchData.SchedValue) THEN
+                VitalError ( "VitalGlitchOnEvent", ErrNegDel, OutSignalName );
+            END IF;
+
+        ELSE 
+            -- If nothing currently scheduled
+            IF GlitchData.SchedTime <= NOW THEN
+                GlitchData.CurrentValue := GlitchData.SchedValue;
+                IF (GlitchDelay <= 0 ns) THEN
+                    IF (NewValue = GlitchData.SchedValue) THEN RETURN; END IF;
+                    NoGlitchDet := TRUE;
+                END IF;
+     
+            -- Transaction currently scheduled - if glitch already happened
+            ELSIF GlitchData.GlitchTime <= NOW THEN
+                GlitchData.CurrentValue := 'X';
+                OldGlitch := TRUE;
+                IF (GlitchData.SchedValue = NewValue) THEN
+                    dly := Minimum( GlitchData.SchedTime-NOW, NewDelay );
+                END IF;
+     
+            -- Transaction currently scheduled (no glitch if same value)
+            ELSIF (GlitchData.SchedValue = NewValue) AND
+                  (GlitchData.SchedTime = GlitchData.GlitchTime) AND
+                  (GlitchDelay <= 0 ns) THEN
+                NoGlitchDet := TRUE;
+                Dly := Minimum( GlitchData.SchedTime-NOW, NewDelay );
+
+            END IF;
+     
+            GlitchData.SchedTime := NOW+Dly;
+            IF OldGlitch THEN
+                OutSignal <= NewValue AFTER Dly;
+
+            ELSIF NoGlitchDet THEN
+                GlitchData.GlitchTime := NOW+Dly;
+                OutSignal <= NewValue AFTER Dly;
+
+            ELSE -- new glitch
+                GlitchData.GlitchTime := GlitchMinTime ( GlitchData.GlitchTime, 
+                                                         NOW+GlitchDelay );
+
+                IF (GlitchMode = MessagePlusX) OR
+                   (GlitchMode = MessageOnly) THEN
+                    ReportGlitch ( "VitalGlitchOnEvent", OutSignalName,
+                                   GlitchData.GlitchTime, GlitchData.SchedValue,
+                                   (Dly + NOW), NewValue,
+                                   MsgSeverity=>MsgSeverity );
+                END IF;
+
+                IF (GlitchMode = MessagePlusX) OR (GlitchMode = XOnly) THEN
+                    OutSignal <= 'X' AFTER GlitchData.GlitchTime-NOW;
+                    OutSignal <=  TRANSPORT NewValue AFTER Dly;
+                ELSE
+                    OutSignal <= NewValue AFTER Dly;
+                END IF;
+            END IF;
+
+            GlitchData.SchedValue := NewValue;
+        END IF;
+
+        RETURN;
+    END;
+ 
+    ----------------------------------------------------------------------------
+    PROCEDURE VitalGlitchOnEvent (
+            SIGNAL   OutSignal        : OUT   std_logic_vector;
+            CONSTANT OutSignalName    : IN    STRING;
+            VARIABLE GlitchData       : INOUT GlitchDataArrayType;
+            CONSTANT NewValue         : IN    std_logic_vector;
+            CONSTANT NewDelay         : IN    VitalTimeArray;
+            CONSTANT GlitchMode       : IN    VitalGlitchModeType := MessagePlusX;
+            CONSTANT GlitchDelay      : IN    VitalTimeArray;
+            CONSTANT MsgSeverity      : IN    SEVERITY_LEVEL := WARNING
+    ) IS
+
+        ALIAS GlDataAlias  : GlitchDataArrayType(1 TO GlitchData'LENGTH) 
+                                 IS GlitchData;
+        ALIAS NewValAlias  : std_logic_vector(1 TO NewValue'LENGTH) IS NewValue;
+        ALIAS GlDelayAlias : VitalTimeArray(1 TO GlitchDelay'LENGTH)
+              IS GlitchDelay;
+        ALIAS NewDelAlias  : VitalTimeArray(1 TO NewDelay'LENGTH) IS NewDelay;
+ 
+        VARIABLE Index       : INTEGER := OutSignal'LEFT;
+        VARIABLE Direction   : INTEGER;
+        VARIABLE NoGlitchDet : BOOLEAN;
+        VARIABLE OldGlitch   : BOOLEAN;
+        VARIABLE Dly, GlDly  : TIME;
+
+    BEGIN
+        IF (OutSignal'LEFT > OutSignal'RIGHT) THEN
+            Direction := -1;
+        ELSE
+            Direction := 1;
+        END IF;
+
+        IF ( (OutSignal'LENGTH /=  GlitchData'LENGTH) OR
+             (OutSignal'LENGTH /=    NewValue'LENGTH) OR
+             (OutSignal'LENGTH /=    NewDelay'LENGTH) OR
+             (OutSignal'LENGTH /= GlitchDelay'LENGTH) ) THEN
+          VitalError ( "VitalGlitchOnEvent", ErrVctLng, OutSignalName );
+          RETURN;
+        END IF;
+
+        -- a call to the scalar function cannot be made since the actual 
+        -- name associated with a signal parameter must be locally static
+      FOR n IN 1 TO OutSignal'LENGTH LOOP
+
+        NoGlitchDet := FALSE;
+        OldGlitch   := FALSE;
+        Dly := NewDelAlias(n);
+
+        -- If nothing to schedule, just skip to next loop iteration
+        IF NewDelAlias(n) < 0 ns THEN
+            IF (NewValAlias(n) /=  GlDataAlias(n).SchedValue) THEN
+                VitalError ( "VitalGlitchOnEvent", ErrNegDel, OutSignalName );
+            END IF;
+        ELSE
+            -- If nothing currently scheduled (i.e. last scheduled 
+            -- transaction already occurred)
+            IF GlDataAlias(n).SchedTime <= NOW THEN
+                GlDataAlias(n).CurrentValue := GlDataAlias(n).SchedValue;
+                IF (GlDelayAlias(n) <= 0 ns) THEN
+                    -- Next iteration if no change in value
+                    IF (NewValAlias(n) = GlDataAlias(n).SchedValue) THEN 
+                        Index := Index + Direction;
+                        NEXT; 
+                    END IF; 
+                    -- since last transaction already occurred there is no glitch
+                    NoGlitchDet := TRUE;
+                END IF;
+
+            -- Transaction currently scheduled - if glitch already happened
+            ELSIF GlDataAlias(n).GlitchTime <= NOW THEN
+                GlDataAlias(n).CurrentValue := 'X';
+                OldGlitch := TRUE;
+                IF (GlDataAlias(n).SchedValue = NewValAlias(n)) THEN
+                    dly := Minimum( GlDataAlias(n).SchedTime-NOW,
+                                    NewDelAlias(n) );
+                END IF;
+
+            -- Transaction currently scheduled
+            ELSIF (GlDataAlias(n).SchedValue = NewValAlias(n)) AND
+                  (GlDataAlias(n).SchedTime = GlDataAlias(n).GlitchTime) AND
+                  (GlDelayAlias(n) <= 0 ns) THEN
+                  NoGlitchDet := TRUE;
+                  Dly := Minimum( GlDataAlias(n).SchedTime-NOW, 
+                                  NewDelAlias(n) );
+            END IF;
+
+            -- update last scheduled transaction
+            GlDataAlias(n).SchedTime := NOW+Dly;
+
+            IF OldGlitch THEN
+                OutSignal(Index) <= NewValAlias(n) AFTER Dly;
+            ELSIF NoGlitchDet THEN
+                -- if no glitch then update last glitch time 
+                -- and OutSignal(actual_index)
+                GlDataAlias(n).GlitchTime := NOW+Dly;
+                OutSignal(Index) <= NewValAlias(n) AFTER Dly;
+            ELSE   -- new glitch
+                GlDataAlias(n).GlitchTime := GlitchMinTime ( 
+                                                  GlDataAlias(n).GlitchTime,
+                                                  NOW+GlDelayAlias(n) );
+
+                IF (GlitchMode = MessagePlusX) OR
+                   (GlitchMode = MessageOnly) THEN
+                    ReportGlitch ( "VitalGlitchOnEvent", OutSignalName,
+                                   GlDataAlias(n).GlitchTime, 
+                                   GlDataAlias(n).SchedValue,
+                                   (Dly + NOW), NewValAlias(n), 
+                                   Index, TRUE, MsgSeverity );
+                END IF;
+
+                IF (GlitchMode = MessagePlusX) OR (GlitchMode = XOnly) THEN
+                    GlDly := GlDataAlias(n).GlitchTime - NOW;
+                    OutSignal(Index) <= 'X' AFTER GlDly;
+                    OutSignal(Index) <= TRANSPORT NewValAlias(n) AFTER Dly;
+                ELSE
+                    OutSignal(Index) <= NewValAlias(n) AFTER Dly;
+                END IF;
+
+            END IF; -- glitch / no-glitch
+            GlDataAlias(n).SchedValue := NewValAlias(n);
+
+        END IF; -- NewDelAlias(n) < 0 ns
+        Index := Index + Direction;
+      END LOOP;
+
+        RETURN;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- ------------------------------------------------------------------------
+    --  PROCEDURE NAME  :  TruthOutputX01Z
+    --
+    --  PARAMETERS      :  table_out - output of table
+    --                     X01Zout   - output converted to X01Z
+    --                     err       - true if illegal character is encountered
+    --
+    --
+    --  DESCRIPTION     :  converts the output of a truth table to a valid
+    --                     std_ulogic
+    -- ------------------------------------------------------------------------
+    PROCEDURE TruthOutputX01Z (
+            CONSTANT TableOut : IN VitalTruthSymbolType;
+            VARIABLE X01Zout   : OUT std_ulogic;
+            VARIABLE Err       : OUT BOOLEAN
+    ) IS
+        VARIABLE TempOut : std_ulogic;
+    BEGIN
+        Err := FALSE;
+        TempOut := TruthTableOutMap(TableOut);
+        IF (TempOut = '-') THEN
+            Err := TRUE;
+            TempOut := 'X';
+            VitalError ( "VitalTruthTable", ErrOutSym, To_TruthChar(TableOut));
+        END IF;
+        X01Zout := TempOut;
+    END;
+
+    -- ------------------------------------------------------------------------
+    --  PROCEDURE NAME  :  StateOutputX01Z
+    --
+    --  PARAMETERS      :  table_out - output of table
+    --                     prev_out  - previous output value
+    --                     X01Zout   - output cojnverted to X01Z
+    --                     err       - true if illegal character is encountered
+    --
+    --  DESCRIPTION     :  converts the output of a state table to a
+    --                     valid std_ulogic
+    -- ------------------------------------------------------------------------
+    PROCEDURE StateOutputX01Z (
+            CONSTANT TableOut : IN VitalStateSymbolType;
+            CONSTANT PrevOut  : IN std_ulogic;
+            VARIABLE X01Zout   : OUT std_ulogic;
+            VARIABLE Err       : OUT BOOLEAN
+    ) IS
+        VARIABLE TempOut : std_ulogic;
+    BEGIN
+        Err := FALSE;
+        TempOut := StateTableOutMap(TableOut);
+        IF (TempOut = '-') THEN
+            Err := TRUE;
+            TempOut := 'X';
+            VitalError ( "VitalStateTable", ErrOutSym, To_StateChar(TableOut));
+        ELSIF (TempOut = 'W') THEN
+            TempOut := To_X01Z(PrevOut);
+        END IF;
+        X01Zout := TempOut;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- PROCEDURE NAME:  StateMatch
+    --
+    -- PARAMETERS    :  symbol       - symbol from state table
+    --                  in2          - input from VitalStateTble procedure
+    --                                 to state table
+    --                  in2LastValue - previous value of input
+    --                  state        - false if the symbol is from the input
+    --                                  portion of the table,
+    --                                 true if the symbol is from the state
+    --                                  portion of the table
+    --                  Err          - true if symbol is not a valid input symbol
+    --                  ReturnValue  - true if match occurred
+    --
+    -- DESCRIPTION   :  This procedure sets ReturnValue to true if in2 matches
+    --                  symbol (from the state table).  If symbol is an edge
+    --                  value edge is set to true and in2 and in2LastValue are
+    --                  checked against symbol.  Err is set to true if symbol
+    --                  is an invalid value for the input portion of the state
+    --                  table.
+    --
+    -- ------------------------------------------------------------------------
+    PROCEDURE StateMatch (
+            CONSTANT Symbol       : IN VitalStateSymbolType;
+            CONSTANT in2          : IN std_ulogic;
+            CONSTANT in2LastValue : IN std_ulogic;
+            CONSTANT State        : IN BOOLEAN;
+            VARIABLE Err          : OUT BOOLEAN;
+            VARIABLE ReturnValue  : OUT BOOLEAN
+    ) IS
+    BEGIN
+        IF (State) THEN
+            IF (NOT ValidStateTableState(Symbol)) THEN
+                VitalError ( "VitalStateTable", ErrStaSym, To_StateChar(Symbol));
+                Err := TRUE;
+                ReturnValue := FALSE;
+            ELSE
+                Err := FALSE;
+                ReturnValue := StateTableMatch(in2LastValue, in2, Symbol);
+            END IF;
+        ELSE
+            IF (NOT ValidStateTableInput(Symbol) ) THEN
+                VitalError ( "VitalStateTable", ErrInpSym, To_StateChar(Symbol));
+                Err := TRUE;
+                ReturnValue := FALSE;
+            ELSE
+                ReturnValue := StateTableMatch(in2LastValue, in2, Symbol);
+                Err := FALSE;
+            END IF;
+        END IF;
+    END;
+
+    -- -----------------------------------------------------------------------
+    -- FUNCTION NAME:  StateTableLookUp
+    --
+    -- PARAMETERS   :  StateTable     - state table
+    --                 PresentDataIn  - current inputs
+    --                 PreviousDataIn - previous inputs and states
+    --                 NumStates      - number of state variables
+    --                 PresentOutputs - current state and current outputs
+    --
+    -- DESCRIPTION  :  This function is used to find the output of the
+    --                 StateTable corresponding to a given set of inputs.
+    --
+    -- ------------------------------------------------------------------------
+    FUNCTION StateTableLookUp (
+            CONSTANT StateTable     : VitalStateTableType;
+            CONSTANT PresentDataIn  : std_logic_vector;
+            CONSTANT PreviousDataIn : std_logic_vector;
+            CONSTANT NumStates      : NATURAL;
+            CONSTANT PresentOutputs : std_logic_vector
+          ) RETURN std_logic_vector IS
+
+        CONSTANT InputSize    : INTEGER := PresentDataIn'LENGTH;
+        CONSTANT NumInputs    : INTEGER := InputSize + NumStates - 1;
+        CONSTANT TableEntries : INTEGER := StateTable'LENGTH(1);
+        CONSTANT TableWidth   : INTEGER := StateTable'LENGTH(2);
+        CONSTANT OutSize      : INTEGER := TableWidth - InputSize - NumStates;
+        VARIABLE Inputs       : std_logic_vector(0 TO NumInputs);
+        VARIABLE PrevInputs   : std_logic_vector(0 TO NumInputs)
+                                := (OTHERS => 'X');
+        VARIABLE ReturnValue  : std_logic_vector(0 TO (OutSize-1))
+                                := (OTHERS => 'X');
+        VARIABLE Temp   : std_ulogic;
+        VARIABLE Match  : BOOLEAN;
+        VARIABLE Err    : BOOLEAN := FALSE;
+
+        -- This needs to be done since the TableLookup arrays must be
+        -- ascending starting with 0
+        VARIABLE TableAlias   : VitalStateTableType(0 TO TableEntries - 1,
+                                                    0 TO TableWidth - 1)
+                                := StateTable;
+
+    BEGIN
+        Inputs(0 TO InputSize-1) := PresentDataIn;
+        Inputs(InputSize TO NumInputs) := PresentOutputs(0 TO NumStates - 1);
+        PrevInputs(0 TO InputSize - 1) := PreviousDataIn(0 TO InputSize - 1);
+
+      ColLoop: -- Compare each entry in the table
+        FOR i IN TableAlias'RANGE(1) LOOP
+
+        RowLoop: -- Check each element of the entry
+          FOR j IN 0 TO InputSize + NumStates  LOOP
+
+            IF (j = InputSize + NumStates) THEN        -- a match occurred
+                FOR k IN 0 TO Minimum(OutSize, PresentOutputs'LENGTH)-1  LOOP
+                    StateOutputX01Z (
+                            TableAlias(i, TableWidth - k - 1),
+                            PresentOutputs(PresentOutputs'LENGTH - k - 1),
+                            Temp, Err);
+                    ReturnValue(OutSize - k - 1) := Temp;
+                    IF (Err) THEN
+                        ReturnValue := (OTHERS => 'X');
+                        RETURN ReturnValue;
+                    END IF;
+                END LOOP;
+                RETURN ReturnValue;
+            END IF;
+
+            StateMatch ( TableAlias(i,j),
+                         Inputs(j), PrevInputs(j),
+                         j >= InputSize, Err, Match);
+            EXIT RowLoop WHEN NOT(Match);
+            EXIT ColLoop WHEN Err;
+          END LOOP RowLoop;
+        END LOOP ColLoop;
+
+        ReturnValue := (OTHERS => 'X');
+        RETURN ReturnValue;
+    END;
+
+    --------------------------------------------------------------------
+    -- to_ux01z
+    -------------------------------------------------------------------
+    FUNCTION To_UX01Z  ( s : std_ulogic
+          ) RETURN  UX01Z IS
+    BEGIN
+        RETURN cvt_to_ux01z (s);
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Function  : GetEdge
+    -- Purpose   : Converts transitions on a given input signal into a
+    --             enumeration value representing the transition or level
+    --             of the signal.
+    --
+    --    previous "value"   current "value"     :=   "edge"
+    --   ---------------------------------------------------------
+    --     '1' | 'H'          '1' | 'H'                 '1'    level, no edge
+    --     '0' | 'L'          '1' | 'H'                 '/'    rising edge
+    --      others            '1' | 'H'                 'R'    rising from X
+    --
+    --     '1' | 'H'          '0' | 'L'                 '\'    falling egde
+    --     '0' | 'L'          '0' | 'L'                 '0'    level, no edge
+    --      others            '0' | 'L'                 'F'    falling from X
+    --
+    --     'X' | 'W' | '-'    'X' | 'W' | '-'           'X'    unknown (X) level
+    --     'Z'                'Z'                       'X'    unknown (X) level
+    --     'U'                'U'                       'U'    'U' level
+    --
+    --     '1' | 'H'           others                   'f'    falling to X
+    --     '0' | 'L'           others                   'r'    rising to X
+    --     'X' | 'W' | '-'    'U' | 'Z'                 'x'    unknown (X) edge
+    --     'Z'                'X' | 'W' | '-' | 'U'     'x'    unknown (X) edge
+    --     'U'                'X' | 'W' | '-' | 'Z'     'x'    unknown (X) edge
+    --
+    ---------------------------------------------------------------------------
+    FUNCTION GetEdge (
+            SIGNAL      s : IN    std_logic
+          ) RETURN EdgeType IS
+    BEGIN
+        IF (s'EVENT)
+            THEN RETURN LogicToEdge  ( s'LAST_VALUE, s );
+            ELSE RETURN LogicToLevel ( s );
+        END IF;
+    END;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE GetEdge (
+            SIGNAL       s : IN    std_logic_vector;
+            VARIABLE LastS : INOUT std_logic_vector;
+            VARIABLE  Edge :   OUT EdgeArray ) IS
+
+        ALIAS     sAlias : std_logic_vector ( 1 TO     s'LENGTH ) IS s;
+        ALIAS LastSAlias : std_logic_vector ( 1 TO LastS'LENGTH ) IS LastS;
+        ALIAS  EdgeAlias : EdgeArray ( 1 TO  Edge'LENGTH ) IS Edge;
+    BEGIN
+        IF s'LENGTH /= LastS'LENGTH OR
+           s'LENGTH /=  Edge'LENGTH THEN
+            VitalError ( "GetEdge", ErrVctLng, "s, LastS, Edge" );
+        END IF;
+
+        FOR n IN 1 TO s'LENGTH LOOP
+            EdgeAlias(n)  := LogicToEdge( LastSAlias(n), sAlias(n) );
+            LastSAlias(n) := sAlias(n);
+        END LOOP;
+    END;
+
+    ---------------------------------------------------------------------------
+    FUNCTION  ToEdge     ( Value         : IN std_logic
+          ) RETURN EdgeType IS
+    BEGIN
+        RETURN LogicToLevel( Value );
+    END;
+
+    -- Note: This function will likely be replaced by S'DRIVING_VALUE in VHDL'92
+    ----------------------------------------------------------------------------
+    IMPURE FUNCTION CurValue (
+            CONSTANT GlitchData : IN  GlitchDataType
+          ) RETURN std_logic IS
+    BEGIN
+        IF NOW >= GlitchData.SchedTime THEN
+            RETURN GlitchData.SchedValue;
+        ELSIF NOW >= GlitchData.GlitchTime THEN
+            RETURN 'X';
+        ELSE
+            RETURN GlitchData.CurrentValue;
+        END IF;
+    END;
+    ---------------------------------------------------------------------------
+    IMPURE FUNCTION CurValue (
+            CONSTANT GlitchData : IN  GlitchDataArrayType
+          ) RETURN std_logic_vector IS
+        VARIABLE Result : std_logic_vector(GlitchData'RANGE);
+    BEGIN
+        FOR n IN GlitchData'RANGE LOOP
+            IF NOW >= GlitchData(n).SchedTime THEN
+                Result(n) := GlitchData(n).SchedValue;
+            ELSIF NOW >= GlitchData(n).GlitchTime THEN
+                Result(n) := 'X';
+            ELSE
+                Result(n) := GlitchData(n).CurrentValue;
+            END IF;
+        END LOOP;
+        RETURN Result;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- function calculation utilities
+    ---------------------------------------------------------------------------
+
+    ---------------------------------------------------------------------------
+    -- Function   : VitalSame
+    -- Returns    : VitalSame compares the state (UX01) of two logic value. A
+    --              value of 'X' is returned if the values are different.  The
+    --              common value is returned if the values are equal.
+    -- Purpose    : When the result of a logic model may be either of two
+    --              separate input values (eg. when the select on a MUX is 'X'),
+    --              VitalSame may be used to determine if the result needs to
+    --              be 'X'.
+    -- Arguments  : See the declarations below...
+    ---------------------------------------------------------------------------
+    FUNCTION VitalSame (
+            CONSTANT a, b : IN std_ulogic
+          ) RETURN std_ulogic IS
+    BEGIN
+        IF To_UX01(a) = To_UX01(b)
+            THEN RETURN To_UX01(a);
+            ELSE RETURN 'X';
+        END IF;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- delay selection utilities
+    ---------------------------------------------------------------------------
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : BufPath, InvPath
+    --
+    -- Purpose    : BufPath and InvPath compute output change times, based on
+    --              a change on an input port. The computed output change times
+    --              returned in the composite parameter 'schd'.
+    --
+    --              BufPath and InpPath are used together with the delay path
+    --              selection functions (GetSchedDelay, VitalAND, VitalOR... )
+    --              The 'schd' value from each of the input ports of a model are
+    --              combined by the delay selection functions (VitalAND,
+    --              VitalOR, ...). The GetSchedDelay procedure converts the
+    --              combined output changes times to the single delay (delta
+    --              time) value for scheduling the output change (passed to
+    --              VitalGlitchOnEvent).
+    --
+    --              The values in 'schd' are: (absolute times)
+    --                inp0  :  time of output change due to input change to 0
+    --                inp1  :  time of output change due to input change to 1
+    --                inpX  :  time of output change due to input change to X
+    --                glch0 :  time of output glitch due to input change to 0
+    --                glch1 :  time of output glitch due to input change to 1
+    --
+    --              The output times are computed from the model INPUT value
+    --              and not the final value.  For this reason, 'BufPath' should
+    --              be used to compute the output times for a non-inverting
+    --              delay paths and 'InvPath' should be used to compute the
+    --              ouput times for inverting delay paths. Delay paths which
+    --              include both non-inverting and paths require usage of both
+    --              'BufPath' and 'InvPath'. (IE this is needed for the
+    --              select->output path of a MUX -- See the VitalMUX model).
+    --
+    --
+    -- Parameters : schd....... Computed output result times. (INOUT parameter
+    --                          modified only on input edges)
+    --              Iedg....... Input port edge/level value.
+    --               tpd....... Propagation delays from this input
+    --
+    ---------------------------------------------------------------------------
+
+    PROCEDURE BufPath (
+            VARIABLE Schd : INOUT SchedType;
+            CONSTANT Iedg : IN    EdgeType;
+            CONSTANT  tpd : IN    VitalDelayType01
+    ) IS
+    BEGIN
+      CASE Iedg IS
+        WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+        WHEN '/'|'R' => Schd.inp0 := TIME'HIGH;
+                        Schd.inp1 := NOW + tpd(tr01);  Schd.Glch1 := Schd.inp1;
+                        Schd.InpX := Schd.inp1;
+        WHEN '\'|'F' => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := NOW + tpd(tr10);  Schd.Glch0 := Schd.inp0;
+                        Schd.InpX := Schd.inp0;
+        WHEN 'r'     => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := TIME'HIGH;
+                        Schd.InpX := NOW + tpd(tr01);
+        WHEN 'f'     => Schd.inp0 := TIME'HIGH;
+                        Schd.inp1 := TIME'HIGH;
+                        Schd.InpX := NOW + tpd(tr10);
+        WHEN 'x'     => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := TIME'HIGH;
+                        -- update for X->X change
+                        Schd.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+        WHEN OTHERS  => NULL;                   -- no timing change
+      END CASE;
+    END;
+
+    PROCEDURE BufPath (
+            VARIABLE Schd : INOUT SchedArray;
+            CONSTANT Iedg : IN    EdgeArray;
+            CONSTANT  tpd : IN    VitalDelayArrayType01
+    ) IS
+    BEGIN
+      FOR n IN Schd'RANGE LOOP
+        CASE Iedg(n) IS
+          WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+          WHEN '/'|'R' => Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).inp1 := NOW + tpd(n)(tr01);
+                          Schd(n).Glch1 := Schd(n).inp1;
+                          Schd(n).InpX := Schd(n).inp1;
+          WHEN '\'|'F' => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := NOW + tpd(n)(tr10);
+                          Schd(n).Glch0 := Schd(n).inp0;
+                          Schd(n).InpX := Schd(n).inp0;
+          WHEN 'r'     => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).InpX := NOW + tpd(n)(tr01);
+          WHEN 'f'     => Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).InpX := NOW + tpd(n)(tr10);
+          WHEN 'x'     => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := TIME'HIGH;
+                          -- update for X->X change
+                          Schd(n).InpX := NOW + Minimum ( tpd(n)(tr10),
+                                                          tpd(n)(tr01) );
+          WHEN OTHERS  => NULL;                   -- no timing change
+        END CASE;
+      END LOOP;
+    END;
+
+    PROCEDURE InvPath (
+            VARIABLE Schd : INOUT SchedType;
+            CONSTANT Iedg : IN    EdgeType;
+            CONSTANT  tpd : IN    VitalDelayType01
+    ) IS
+    BEGIN
+      CASE Iedg IS
+        WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+        WHEN '/'|'R' => Schd.inp0 := TIME'HIGH;
+                        Schd.inp1 := NOW + tpd(tr10);  Schd.Glch1 := Schd.inp1;
+                        Schd.InpX := Schd.inp1;
+        WHEN '\'|'F' => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := NOW + tpd(tr01);  Schd.Glch0 := Schd.inp0;
+                        Schd.InpX := Schd.inp0;
+        WHEN 'r'     => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := TIME'HIGH;
+                        Schd.InpX := NOW + tpd(tr10);
+        WHEN 'f'     => Schd.inp0 := TIME'HIGH;
+                        Schd.inp1 := TIME'HIGH;
+                        Schd.InpX := NOW + tpd(tr01);
+        WHEN 'x'     => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := TIME'HIGH;
+                        -- update for X->X change
+                        Schd.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+        WHEN OTHERS  => NULL;                   -- no timing change
+      END CASE;
+    END;
+
+    PROCEDURE InvPath (
+            VARIABLE Schd : INOUT SchedArray;
+            CONSTANT Iedg : IN    EdgeArray;
+            CONSTANT  tpd : IN    VitalDelayArrayType01
+    ) IS
+    BEGIN
+      FOR n IN Schd'RANGE LOOP
+        CASE Iedg(n) IS
+          WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+          WHEN '/'|'R' => Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).inp1 := NOW + tpd(n)(tr10);
+                          Schd(n).Glch1 := Schd(n).inp1;
+                          Schd(n).InpX := Schd(n).inp1;
+          WHEN '\'|'F' => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := NOW + tpd(n)(tr01);
+                          Schd(n).Glch0 := Schd(n).inp0;
+                          Schd(n).InpX := Schd(n).inp0;
+          WHEN 'r'     => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).InpX := NOW + tpd(n)(tr10);
+          WHEN 'f'     => Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).InpX := NOW + tpd(n)(tr01);
+          WHEN 'x'     => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := TIME'HIGH;
+                          -- update for X->X change
+                          Schd(n).InpX := NOW + Minimum ( tpd(n)(tr10),
+                                                          tpd(n)(tr01) );
+          WHEN OTHERS  => NULL;                   -- no timing change
+        END CASE;
+      END LOOP;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : BufEnab, InvEnab
+    --
+    -- Purpose    : BufEnab and InvEnab compute output change times, from a
+    --              change on an input enable port for a 3-state driver. The
+    --              computed output change times are returned in the composite
+    --              parameters 'schd1', 'schd0'.
+    --
+    --              BufEnab and InpEnab are used together with the delay path
+    --              selection functions (GetSchedDelay, VitalAND, VitalOR... )
+    --              The 'schd' value from each of the non-enable input ports of
+    --              a model (See BufPath, InvPath) are combined using the delay
+    --              selection functions (VitalAND,  VitalOR, ...). The
+    --              GetSchedDelay procedure combines the output times on the
+    --              enable path with the output times from the data path(s) and
+    --              computes the single delay (delta time) value for scheduling
+    --              the output change (passed to VitalGlitchOnEvent)
+    --
+    --              The values in 'schd*' are: (absolute times)
+    --                inp0  :  time of output change due to input change to 0
+    --                inp1  :  time of output change due to input change to 1
+    --                inpX  :  time of output change due to input change to X
+    --                glch0 :  time of output glitch due to input change to 0
+    --                glch1 :  time of output glitch due to input change to 1
+    --
+    --              'schd1' contains output times for 1->Z, Z->1 transitions.
+    --              'schd0' contains output times for 0->Z, Z->0 transitions.
+    --
+    --              'BufEnab' is used for computing the output times for an
+    --              high asserted enable (output 'Z' for enable='0').
+    --              'InvEnab' is used for computing the output times for an
+    --              low asserted enable (output 'Z' for enable='1').
+    --
+    --              Note: separate 'schd1', 'schd0' parameters are generated
+    --                    so that the combination of the delay paths from
+    --                    multiple enable signals may be combined using the
+    --                    same functions/operators used in combining separate
+    --                    data paths. (See exampe 2 below)
+    --
+    --
+    -- Parameters : schd1...... Computed output result times for 1->Z, Z->1
+    --                          transitions. This parameter is modified only on
+    --                          input edge values (events).
+    --              schd0...... Computed output result times for 0->Z, 0->1
+    --                          transitions. This parameter is modified only on
+    --                          input edge values (events).
+    --              Iedg....... Input port edge/level value.
+    --               tpd....... Propagation delays for the enable -> output path.
+    --
+    ---------------------------------------------------------------------------
+    PROCEDURE BufEnab (
+            VARIABLE Schd1 : INOUT SchedType;
+            VARIABLE Schd0 : INOUT SchedType;
+            CONSTANT  Iedg : IN    EdgeType;
+            CONSTANT   tpd : IN    VitalDelayType01Z
+    ) IS
+    BEGIN
+      CASE Iedg IS
+        WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+        WHEN '/'|'R' => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := NOW + tpd(trz1);
+                        Schd1.Glch1 := Schd1.inp1;
+                        Schd1.InpX := Schd1.inp1;
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := NOW + tpd(trz0);
+                        Schd0.Glch1 := Schd0.inp1;
+                        Schd0.InpX := Schd0.inp1;
+        WHEN '\'|'F' => Schd1.inp1 := TIME'HIGH;
+                        Schd1.inp0 := NOW + tpd(tr1z);
+                        Schd1.Glch0 := Schd1.inp0;
+                        Schd1.InpX := Schd1.inp0;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.inp0 := NOW + tpd(tr0z);
+                        Schd0.Glch0 := Schd0.inp0;
+                        Schd0.InpX := Schd0.inp0;
+        WHEN 'r'     => Schd1.inp1 := TIME'HIGH;
+                        Schd1.inp0 := TIME'HIGH;
+                        Schd1.InpX := NOW + tpd(trz1);
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.InpX := NOW + tpd(trz0);
+        WHEN 'f'     => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := TIME'HIGH;
+                        Schd1.InpX := NOW + tpd(tr1z);
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.InpX := NOW + tpd(tr0z);
+        WHEN 'x'     => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := TIME'HIGH;
+                        Schd1.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+        WHEN OTHERS  => NULL;                   -- no timing change
+      END CASE;
+    END;
+
+    PROCEDURE InvEnab (
+            VARIABLE Schd1 : INOUT SchedType;
+            VARIABLE Schd0 : INOUT SchedType;
+            CONSTANT  Iedg : IN    EdgeType;
+            CONSTANT   tpd : IN    VitalDelayType01Z
+    ) IS
+    BEGIN
+      CASE Iedg IS
+        WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+        WHEN '/'|'R' => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := NOW + tpd(tr1z);
+                        Schd1.Glch1 := Schd1.inp1;
+                        Schd1.InpX := Schd1.inp1;
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := NOW + tpd(tr0z);
+                        Schd0.Glch1 := Schd0.inp1;
+                        Schd0.InpX := Schd0.inp1;
+        WHEN '\'|'F' => Schd1.inp1 := TIME'HIGH;
+                        Schd1.inp0 := NOW + tpd(trz1);
+                        Schd1.Glch0 := Schd1.inp0;
+                        Schd1.InpX := Schd1.inp0;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.inp0 := NOW + tpd(trz0);
+                        Schd0.Glch0 := Schd0.inp0;
+                        Schd0.InpX := Schd0.inp0;
+        WHEN 'r'     => Schd1.inp1 := TIME'HIGH;
+                        Schd1.inp0 := TIME'HIGH;
+                        Schd1.InpX := NOW + tpd(tr1z);
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.InpX := NOW + tpd(tr0z);
+        WHEN 'f'     => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := TIME'HIGH;
+                        Schd1.InpX := NOW + tpd(trz1);
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.InpX := NOW + tpd(trz0);
+        WHEN 'x'     => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := TIME'HIGH;
+                        Schd1.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+        WHEN OTHERS  => NULL;                   -- no timing change
+      END CASE;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : GetSchedDelay
+    --
+    -- Purpose    : GetSchedDelay computes the final delay (incremental) for
+    --              for scheduling an output signal.  The delay is computed
+    --              from the absolute output times in the 'NewSched' parameter.
+    --              (See BufPath, InvPath).
+    --
+    --              Computation of the output delay for non-3_state outputs
+    --              consists of selection the appropriate output time based
+    --              on the new output value 'NewValue' and subtracting 'NOW'
+    --              to convert to an incremental delay value.
+    --
+    --              The Computation of the output delay for 3_state output
+    --              also includes combination of the enable path delay with
+    --              the date path delay.
+    --
+    -- Parameters : NewDelay... Returned output delay value.
+    --              GlchDelay.. Returned output delay for the start of a glitch.
+    --              NewValue... New output value.
+    --              CurValue... Current value of the output.
+    --              NewSched... Composite containing the combined absolute
+    --                          output times from the data inputs.
+    --              EnSched1... Composite containing the combined absolute
+    --                          output times from the enable input(s).
+    --                          (for a 3_state output transitions 1->Z, Z->1)
+    --              EnSched0... Composite containing the combined absolute
+    --                          output times from the enable input(s).
+    --                          (for a 3_state output transitions 0->Z, Z->0)
+    --
+    ---------------------------------------------------------------------------
+    PROCEDURE GetSchedDelay (
+            VARIABLE   NewDelay : OUT TIME;
+            VARIABLE  GlchDelay : OUT TIME;
+            CONSTANT   NewValue : IN  std_ulogic;
+            CONSTANT   CurValue : IN  std_ulogic;
+            CONSTANT   NewSched : IN  SchedType
+    ) IS
+        VARIABLE Tim, Glch : TIME;
+    BEGIN
+
+        CASE To_UX01(NewValue) IS
+          WHEN '0'    => Tim  := NewSched.inp0;
+                         Glch := NewSched.Glch1;
+          WHEN '1'    => Tim  := NewSched.inp1;
+                         Glch := NewSched.Glch0;
+          WHEN OTHERS => Tim  := NewSched.InpX;
+                         Glch := -1 ns;
+        END CASE;
+        IF (CurValue /= NewValue)
+          THEN Glch := -1 ns;
+        END IF;
+
+        NewDelay  := Tim  - NOW;
+        IF Glch < 0 ns
+            THEN GlchDelay := Glch;
+            ELSE GlchDelay := Glch - NOW;
+        END IF; -- glch < 0 ns
+    END;
+
+    PROCEDURE GetSchedDelay (
+            VARIABLE   NewDelay : OUT VitalTimeArray;
+            VARIABLE  GlchDelay : OUT VitalTimeArray;
+            CONSTANT   NewValue : IN  std_logic_vector;
+            CONSTANT   CurValue : IN  std_logic_vector;
+            CONSTANT   NewSched : IN  SchedArray
+    ) IS
+        VARIABLE Tim, Glch : TIME;
+        ALIAS  NewDelayAlias : VitalTimeArray( NewDelay'LENGTH DOWNTO 1)
+               IS NewDelay;
+        ALIAS GlchDelayAlias : VitalTimeArray(GlchDelay'LENGTH DOWNTO 1)
+               IS GlchDelay;
+        ALIAS  NewSchedAlias : SchedArray( NewSched'LENGTH DOWNTO 1)
+               IS NewSched;
+        ALIAS  NewValueAlias : std_logic_vector (  NewValue'LENGTH DOWNTO 1 )
+                                IS  NewValue;
+        ALIAS  CurValueAlias : std_logic_vector (  CurValue'LENGTH DOWNTO 1 )
+                                IS  CurValue;
+    BEGIN
+      FOR n IN NewDelay'LENGTH DOWNTO 1 LOOP
+        CASE To_UX01(NewValueAlias(n)) IS
+          WHEN '0'    => Tim  := NewSchedAlias(n).inp0;
+                         Glch := NewSchedAlias(n).Glch1;
+          WHEN '1'    => Tim  := NewSchedAlias(n).inp1;
+                         Glch := NewSchedAlias(n).Glch0;
+          WHEN OTHERS => Tim  := NewSchedAlias(n).InpX;
+                         Glch := -1 ns;
+        END CASE;
+        IF (CurValueAlias(n) /= NewValueAlias(n))
+          THEN Glch := -1 ns;
+        END IF;
+
+        NewDelayAlias(n) := Tim  - NOW;
+        IF Glch < 0 ns
+            THEN GlchDelayAlias(n) := Glch;
+            ELSE GlchDelayAlias(n) := Glch - NOW;
+        END IF; -- glch < 0 ns
+      END LOOP;
+      RETURN;
+    END;
+
+    PROCEDURE GetSchedDelay (
+            VARIABLE   NewDelay : OUT TIME;
+            VARIABLE  GlchDelay : OUT TIME;
+            CONSTANT   NewValue : IN  std_ulogic;
+            CONSTANT   CurValue : IN  std_ulogic;
+            CONSTANT   NewSched : IN  SchedType;
+            CONSTANT   EnSched1 : IN  SchedType;
+            CONSTANT   EnSched0 : IN  SchedType
+    ) IS
+        SUBTYPE v2 IS std_logic_vector(0 TO 1);
+        VARIABLE Tim, Glch : TIME;
+    BEGIN
+
+        CASE v2'(To_X01Z(CurValue) & To_X01Z(NewValue)) IS
+          WHEN "00"    => Tim  := Maximum (NewSched.inp0, EnSched0.inp1);
+                          Glch := GlitchMinTime(NewSched.Glch1,EnSched0.Glch0);
+          WHEN "01"    => Tim  := Maximum (NewSched.inp1, EnSched1.inp1);
+                          Glch := EnSched1.Glch0;
+          WHEN "0Z"    => Tim  := EnSched0.inp0;
+                          Glch := NewSched.Glch1;
+          WHEN "0X"    => Tim  := Maximum (NewSched.InpX, EnSched1.InpX);
+                          Glch := 0 ns;
+          WHEN "10"    => Tim  := Maximum (NewSched.inp0, EnSched0.inp1);
+                          Glch := EnSched0.Glch0;
+          WHEN "11"    => Tim  := Maximum (NewSched.inp1, EnSched1.inp1);
+                          Glch := GlitchMinTime(NewSched.Glch0,EnSched1.Glch0);
+          WHEN "1Z"    => Tim  := EnSched1.inp0;
+                          Glch := NewSched.Glch0;
+          WHEN "1X"    => Tim  := Maximum (NewSched.InpX, EnSched0.InpX);
+                          Glch := 0 ns;
+          WHEN "Z0"    => Tim  := Maximum (NewSched.inp0, EnSched0.inp1);
+                          IF NewSched.Glch0 > NOW
+                            THEN Glch := Maximum(NewSched.Glch1,EnSched1.inp1);
+                            ELSE Glch := 0 ns;
+                          END IF;
+          WHEN "Z1"    => Tim  := Maximum (NewSched.inp1, EnSched1.inp1);
+                          IF NewSched.Glch1 > NOW
+                            THEN Glch := Maximum(NewSched.Glch0,EnSched0.inp1);
+                            ELSE Glch := 0 ns;
+                          END IF;
+          WHEN "ZX"    => Tim  := Maximum (NewSched.InpX, EnSched1.InpX);
+                          Glch := 0 ns;
+          WHEN "ZZ"    => Tim  := Maximum (EnSched1.InpX, EnSched0.InpX);
+                          Glch := 0 ns;
+          WHEN "X0"    => Tim  := Maximum (NewSched.inp0, EnSched0.inp1);
+                          Glch := 0 ns;
+          WHEN "X1"    => Tim  := Maximum (NewSched.inp1, EnSched1.inp1);
+                          Glch := 0 ns;
+          WHEN "XZ"    => Tim  := Maximum (EnSched1.InpX, EnSched0.InpX);
+                          Glch := 0 ns;
+          WHEN OTHERS  => Tim  := Maximum (NewSched.InpX, EnSched1.InpX);
+                          Glch := 0 ns;
+
+        END CASE;
+        NewDelay  := Tim  - NOW;
+        IF Glch < 0 ns
+            THEN GlchDelay := Glch;
+            ELSE GlchDelay := Glch - NOW;
+        END IF; -- glch < 0 ns
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Operators and Functions for combination (selection) of path delays
+    -- > These functions support selection of the "appripriate" path delay
+    --   dependent on the logic function.
+    -- > These functions only "select" from the possable output times. No
+    --   calculation (addition) of delays is performed.
+    -- > See description of 'BufPath', 'InvPath' and 'GetSchedDelay'
+    -- > See primitive PROCEDURE models for examples.
+    ---------------------------------------------------------------------------
+
+    FUNCTION "not"  (
+            CONSTANT a : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp1  := a.inp0 ;
+        z.inp0  := a.inp1 ;
+        z.InpX  := a.InpX ;
+        z.Glch1 := a.Glch0;
+        z.Glch0 := a.Glch1;
+        RETURN (z);
+    END;
+
+    FUNCTION "and"  (
+            CONSTANT a, b : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp1  := Maximum   ( a.inp1 , b.inp1  );
+        z.inp0  := Minimum   ( a.inp0 , b.inp0  );
+        z.InpX  := GlitchMinTime ( a.InpX , b.InpX  );
+        z.Glch1 := Maximum   ( a.Glch1, b.Glch1 );
+        z.Glch0 := GlitchMinTime ( a.Glch0, b.Glch0 );
+        RETURN (z);
+    END;
+
+    FUNCTION "or"   (
+            CONSTANT a, b : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp0  := Maximum   ( a.inp0 , b.inp0  );
+        z.inp1  := Minimum   ( a.inp1 , b.inp1  );
+        z.InpX  := GlitchMinTime ( a.InpX , b.InpX  );
+        z.Glch0 := Maximum   ( a.Glch0, b.Glch0 );
+        z.Glch1 := GlitchMinTime ( a.Glch1, b.Glch1 );
+        RETURN (z);
+    END;
+
+    IMPURE FUNCTION "nand" (
+            CONSTANT a, b : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp0  := Maximum   ( a.inp1 , b.inp1  );
+        z.inp1  := Minimum   ( a.inp0 , b.inp0  );
+        z.InpX  := GlitchMinTime ( a.InpX , b.InpX  );
+        z.Glch0 := Maximum   ( a.Glch1, b.Glch1 );
+        z.Glch1 := GlitchMinTime ( a.Glch0, b.Glch0 );
+        RETURN (z);
+    END;
+
+    IMPURE FUNCTION "nor"  (
+            CONSTANT a, b : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp1  := Maximum   ( a.inp0 , b.inp0  );
+        z.inp0  := Minimum   ( a.inp1 , b.inp1  );
+        z.InpX  := GlitchMinTime ( a.InpX , b.InpX  );
+        z.Glch1 := Maximum   ( a.Glch0, b.Glch0 );
+        z.Glch0 := GlitchMinTime ( a.Glch1, b.Glch1 );
+        RETURN (z);
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Delay Calculation for 2-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    IMPURE FUNCTION VitalXOR2   (
+            CONSTANT ab,ai, bb,bi : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        -- z = (a AND b) NOR (a NOR b)
+        z.inp1  :=   Maximum (  Minimum (ai.inp0 , bi.inp0 ),
+                                Minimum (ab.inp1 , bb.inp1 ) );
+        z.inp0  :=   Minimum (  Maximum (ai.inp1 , bi.inp1 ),
+                                Maximum (ab.inp0 , bb.inp0 ) );
+        z.InpX  :=   Maximum (  Maximum (ai.InpX , bi.InpX ),
+                                Maximum (ab.InpX , bb.InpX ) );
+        z.Glch1 :=   Maximum (GlitchMinTime (ai.Glch0, bi.Glch0),
+                              GlitchMinTime (ab.Glch1, bb.Glch1) );
+        z.Glch0 := GlitchMinTime (  Maximum (ai.Glch1, bi.Glch1),
+                                Maximum (ab.Glch0, bb.Glch0) );
+        RETURN (z);
+    END;
+
+    IMPURE FUNCTION VitalXNOR2  (
+            CONSTANT ab,ai, bb,bi : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        -- z = (a AND b) OR (a NOR b)
+        z.inp0  :=   Maximum (  Minimum (ab.inp0 , bb.inp0 ),
+                                Minimum (ai.inp1 , bi.inp1 ) );
+        z.inp1  :=   Minimum (  Maximum (ab.inp1 , bb.inp1 ),
+                                Maximum (ai.inp0 , bi.inp0 ) );
+        z.InpX  :=   Maximum (  Maximum (ab.InpX , bb.InpX ),
+                                Maximum (ai.InpX , bi.InpX ) );
+        z.Glch0 :=   Maximum (GlitchMinTime (ab.Glch0, bb.Glch0),
+                              GlitchMinTime (ai.Glch1, bi.Glch1) );
+        z.Glch1 := GlitchMinTime (  Maximum (ab.Glch1, bb.Glch1),
+                                Maximum (ai.Glch0, bi.Glch0) );
+        RETURN (z);
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Delay Calculation for 3-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    IMPURE FUNCTION VitalXOR3   (
+            CONSTANT ab,ai, bb,bi, cb,ci : IN SchedType )
+      RETURN SchedType IS
+    BEGIN
+        RETURN VitalXOR2 ( VitalXOR2 (ab,ai, bb,bi),
+                           VitalXOR2 (ai,ab, bi,bb),
+                           cb, ci );
+    END;
+
+    IMPURE FUNCTION VitalXNOR3  (
+            CONSTANT ab,ai, bb,bi, cb,ci : IN SchedType )
+      RETURN SchedType IS
+    BEGIN
+        RETURN VitalXNOR2 ( VitalXOR2 ( ab,ai, bb,bi ),
+                            VitalXOR2 ( ai,ab, bi,bb ),
+                            cb, ci );
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Delay Calculation for 4-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    IMPURE FUNCTION VitalXOR4   (
+            CONSTANT ab,ai, bb,bi, cb,ci, db,di : IN SchedType )
+      RETURN SchedType IS
+    BEGIN
+        RETURN VitalXOR2 ( VitalXOR2 ( ab,ai, bb,bi ),
+                           VitalXOR2 ( ai,ab, bi,bb ),
+                           VitalXOR2 ( cb,ci, db,di ),
+                           VitalXOR2 ( ci,cb, di,db ) );
+    END;
+
+    IMPURE FUNCTION VitalXNOR4  (
+            CONSTANT ab,ai, bb,bi, cb,ci, db,di : IN SchedType )
+      RETURN SchedType IS
+    BEGIN
+        RETURN VitalXNOR2 ( VitalXOR2 ( ab,ai, bb,bi ),
+                            VitalXOR2 ( ai,ab, bi,bb ),
+                            VitalXOR2 ( cb,ci, db,di ),
+                            VitalXOR2 ( ci,cb, di,db ) );
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Delay Calculation for N-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    -- Note: index range on datab,datai assumed to be 1 TO length.
+    --       This is enforced by internal only usage of this Function
+    IMPURE FUNCTION VitalXOR   (
+            CONSTANT DataB, DataI : IN SchedArray
+          ) RETURN SchedType IS
+            CONSTANT Leng : INTEGER := DataB'LENGTH;
+    BEGIN
+        IF Leng = 2 THEN
+            RETURN VitalXOR2 ( DataB(1),DataI(1), DataB(2),DataI(2) );
+        ELSE
+            RETURN VitalXOR2 ( VitalXOR ( DataB(1 TO Leng-1),
+                                          DataI(1 TO Leng-1) ),
+                               VitalXOR ( DataI(1 TO Leng-1),
+                                          DataB(1 TO Leng-1) ),
+                               DataB(Leng),DataI(Leng) );
+        END IF;
+    END;
+
+    -- Note: index range on datab,datai assumed to be 1 TO length.
+    --       This is enforced by internal only usage of this Function
+    IMPURE FUNCTION VitalXNOR  (
+            CONSTANT DataB, DataI : IN SchedArray
+          ) RETURN SchedType IS
+            CONSTANT Leng : INTEGER := DataB'LENGTH;
+    BEGIN
+        IF Leng = 2 THEN
+            RETURN VitalXNOR2 ( DataB(1),DataI(1), DataB(2),DataI(2) );
+        ELSE
+            RETURN VitalXNOR2 ( VitalXOR ( DataB(1 TO Leng-1),
+                                           DataI(1 TO Leng-1) ),
+                                VitalXOR ( DataI(1 TO Leng-1),
+                                           DataB(1 TO Leng-1) ),
+                                DataB(Leng),DataI(Leng) );
+        END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Multiplexor
+    --   MUX   .......... result := data(dselect)
+    --   MUX2  .......... 2-input mux; result := data0 when (dselect = '0'),
+    --                                           data1 when (dselect = '1'),
+    --                        'X' when (dselect = 'X') and (data0 /= data1)
+    --   MUX4  .......... 4-input mux; result := data(dselect)
+    --   MUX8  .......... 8-input mux; result := data(dselect)
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalMUX2  (
+            CONSTANT d1, d0 : IN SchedType;
+            CONSTANT sb, SI : IN SchedType
+          ) RETURN SchedType IS
+    BEGIN
+        RETURN (d1 AND sb) OR (d0 AND (NOT SI) );
+    END;
+--
+    FUNCTION VitalMUX4  (
+            CONSTANT Data : IN SchedArray4;
+            CONSTANT sb   : IN SchedArray2;
+            CONSTANT SI   : IN SchedArray2
+          ) RETURN SchedType IS
+    BEGIN
+        RETURN    (      sb(1)  AND VitalMUX2(Data(3),Data(2), sb(0), SI(0)) )
+               OR ( (NOT SI(1)) AND VitalMUX2(Data(1),Data(0), sb(0), SI(0)) );
+    END;
+
+    FUNCTION VitalMUX8  (
+            CONSTANT Data : IN SchedArray8;
+            CONSTANT sb   : IN SchedArray3;
+            CONSTANT SI   : IN SchedArray3
+          ) RETURN SchedType IS
+    BEGIN
+        RETURN    ( (    sb(2)) AND VitalMUX4 (Data(7 DOWNTO 4),
+                                           sb(1 DOWNTO 0), SI(1 DOWNTO 0) ) )
+               OR ( (NOT SI(2)) AND VitalMUX4 (Data(3 DOWNTO 0),
+                                           sb(1 DOWNTO 0), SI(1 DOWNTO 0) ) );
+    END;
+--
+    FUNCTION VInterMux   (
+            CONSTANT Data : IN SchedArray;
+            CONSTANT sb   : IN SchedArray;
+            CONSTANT SI   : IN SchedArray
+          ) RETURN SchedType IS
+        CONSTANT sMsb : INTEGER := sb'LENGTH;
+        CONSTANT dMsbHigh : INTEGER := Data'LENGTH;
+        CONSTANT dMsbLow  : INTEGER := Data'LENGTH/2;
+    BEGIN
+        IF sb'LENGTH = 1 THEN
+          RETURN VitalMUX2( Data(2), Data(1), sb(1), SI(1) );
+        ELSIF sb'LENGTH = 2 THEN
+          RETURN VitalMUX4( Data, sb, SI );
+        ELSIF sb'LENGTH = 3 THEN
+          RETURN VitalMUX8( Data, sb, SI );
+        ELSIF sb'LENGTH > 3 THEN
+          RETURN ((    sb(sMsb)) AND VInterMux( Data(dMsbLow  DOWNTO  1),
+                                                  sb(sMsb-1 DOWNTO 1),
+                                                  SI(sMsb-1 DOWNTO 1) ))
+              OR ((NOT SI(sMsb)) AND VInterMux( Data(dMsbHigh DOWNTO dMsbLow+1),
+                                                  sb(sMsb-1 DOWNTO 1),
+                                                  SI(sMsb-1 DOWNTO 1) ));
+        ELSE
+          RETURN (0 ns, 0 ns, 0 ns, 0 ns, 0 ns); -- dselect'LENGTH < 1
+        END IF;
+    END;
+--
+    FUNCTION VitalMUX   (
+            CONSTANT Data : IN SchedArray;
+            CONSTANT sb   : IN SchedArray;
+            CONSTANT SI   : IN SchedArray
+          ) RETURN SchedType IS
+        CONSTANT msb : INTEGER := 2**sb'LENGTH;
+        VARIABLE    lDat : SchedArray(msb DOWNTO 1);
+        ALIAS DataAlias : SchedArray ( Data'LENGTH DOWNTO 1 ) IS Data;
+        ALIAS   sbAlias : SchedArray (   sb'LENGTH DOWNTO 1 ) IS sb;
+        ALIAS   siAlias : SchedArray (   SI'LENGTH DOWNTO 1 ) IS SI;
+    BEGIN
+        IF Data'LENGTH <= msb THEN
+            FOR i IN Data'LENGTH DOWNTO 1 LOOP
+                lDat(i) := DataAlias(i);
+            END LOOP;
+            FOR i IN msb DOWNTO Data'LENGTH+1 LOOP
+                lDat(i) := DefSchedAnd;
+            END LOOP;
+        ELSE
+            FOR i IN msb DOWNTO 1 LOOP
+                lDat(i) := DataAlias(i);
+            END LOOP;
+        END IF;
+        RETURN VInterMux( lDat, sbAlias, siAlias );
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Decoder
+    --          General Algorithm :
+    --              (a) Result(...) := '0' when (enable = '0')
+    --              (b) Result(data) := '1'; all other subelements = '0'
+    --              ... Result array is decending (n-1 downto 0)
+    --
+    --          DECODERn  .......... n:2**n decoder
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalDECODER2  (
+            CONSTANT DataB  : IN SchedType;
+            CONSTANT DataI  : IN SchedType;
+            CONSTANT Enable : IN SchedType
+          ) RETURN SchedArray IS
+        VARIABLE Result : SchedArray2;
+    BEGIN
+        Result(1) := Enable AND (    DataB);
+        Result(0) := Enable AND (NOT DataI);
+        RETURN Result;
+    END;
+
+    FUNCTION VitalDECODER4  (
+            CONSTANT DataB  : IN SchedArray2;
+            CONSTANT DataI  : IN SchedArray2;
+            CONSTANT Enable : IN SchedType
+          ) RETURN SchedArray IS
+        VARIABLE Result : SchedArray4;
+    BEGIN
+        Result(3) := Enable AND (    DataB(1)) AND (    DataB(0));
+        Result(2) := Enable AND (    DataB(1)) AND (NOT DataI(0));
+        Result(1) := Enable AND (NOT DataI(1)) AND (    DataB(0));
+        Result(0) := Enable AND (NOT DataI(1)) AND (NOT DataI(0));
+        RETURN Result;
+    END;
+
+    FUNCTION VitalDECODER8  (
+            CONSTANT DataB  : IN SchedArray3;
+            CONSTANT DataI  : IN SchedArray3;
+            CONSTANT Enable : IN SchedType
+          ) RETURN SchedArray IS
+        VARIABLE Result : SchedArray8;
+    BEGIN
+        Result(7):= Enable AND (    DataB(2))AND(    DataB(1))AND(    DataB(0));
+        Result(6):= Enable AND (    DataB(2))AND(    DataB(1))AND(NOT DataI(0));
+        Result(5):= Enable AND (    DataB(2))AND(NOT DataI(1))AND(    DataB(0));
+        Result(4):= Enable AND (    DataB(2))AND(NOT DataI(1))AND(NOT DataI(0));
+        Result(3):= Enable AND (NOT DataI(2))AND(    DataB(1))AND(    DataB(0));
+        Result(2):= Enable AND (NOT DataI(2))AND(    DataB(1))AND(NOT DataI(0));
+        Result(1):= Enable AND (NOT DataI(2))AND(NOT DataI(1))AND(    DataB(0));
+        Result(0):= Enable AND (NOT DataI(2))AND(NOT DataI(1))AND(NOT DataI(0));
+        RETURN Result;
+    END;
+
+
+    FUNCTION VitalDECODER   (
+            CONSTANT DataB  : IN SchedArray;
+            CONSTANT DataI  : IN SchedArray;
+            CONSTANT Enable : IN SchedType
+          ) RETURN SchedArray IS
+        CONSTANT DMsb : INTEGER := DataB'LENGTH - 1;
+        ALIAS DataBAlias : SchedArray ( DMsb DOWNTO 0 ) IS DataB;
+        ALIAS DataIAlias : SchedArray ( DMsb DOWNTO 0 ) IS DataI;
+    BEGIN
+        IF DataB'LENGTH = 1 THEN
+            RETURN  VitalDECODER2 ( DataBAlias(    0     ),
+                                    DataIAlias(    0     ), Enable );
+        ELSIF DataB'LENGTH = 2 THEN
+            RETURN  VitalDECODER4 ( DataBAlias(1 DOWNTO 0),
+                                    DataIAlias(1 DOWNTO 0), Enable );
+        ELSIF DataB'LENGTH = 3 THEN
+            RETURN  VitalDECODER8 ( DataBAlias(2 DOWNTO 0),
+                                    DataIAlias(2 DOWNTO 0), Enable );
+        ELSIF DataB'LENGTH > 3 THEN
+            RETURN  VitalDECODER  ( DataBAlias(DMsb-1 DOWNTO 0),
+                                    DataIAlias(DMsb-1 DOWNTO 0),
+                                    Enable AND (    DataBAlias(DMsb)) )
+                  & VitalDECODER  ( DataBAlias(DMsb-1 DOWNTO 0),
+                                    DataIAlias(DMsb-1 DOWNTO 0),
+                                    Enable AND (NOT DataIAlias(DMsb)) );
+        ELSE
+            RETURN DefSchedArray2;
+        END IF;
+    END;
+
+
+-------------------------------------------------------------------------------
+-- PRIMITIVES
+-------------------------------------------------------------------------------
+    -- ------------------------------------------------------------------------
+    -- N-bit wide Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalAND    (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '1';
+        FOR i IN Data'RANGE LOOP
+            Result := Result AND Data(i);
+        END LOOP;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalOR     (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '0';
+        FOR i IN Data'RANGE LOOP
+            Result := Result OR Data(i);
+        END LOOP;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalXOR    (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '0';
+        FOR i IN Data'RANGE LOOP
+            Result := Result XOR Data(i);
+        END LOOP;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalNAND   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '1';
+        FOR i IN Data'RANGE LOOP
+            Result := Result AND Data(i);
+        END LOOP;
+        RETURN ResultMap(NOT Result);
+    END;
+--
+    FUNCTION VitalNOR    (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '0';
+        FOR i IN Data'RANGE LOOP
+            Result := Result OR Data(i);
+        END LOOP;
+        RETURN ResultMap(NOT Result);
+    END;
+--
+    FUNCTION VitalXNOR   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '0';
+        FOR i IN Data'RANGE LOOP
+            Result := Result XOR Data(i);
+        END LOOP;
+        RETURN ResultMap(NOT Result);
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Commonly used 2-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalAND2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a AND b);
+    END;
+--
+    FUNCTION VitalOR2    (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a OR b);
+    END;
+--
+    FUNCTION VitalXOR2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a XOR b);
+    END;
+--
+    FUNCTION VitalNAND2  (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a NAND b);
+    END;
+--
+    FUNCTION VitalNOR2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a NOR b);
+    END;
+--
+    FUNCTION VitalXNOR2  (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a XOR b));
+    END;
+--
+    -- ------------------------------------------------------------------------
+    -- Commonly used 3-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalAND3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a AND b AND c);
+    END;
+--
+    FUNCTION VitalOR3    (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a OR b OR c);
+    END;
+--
+    FUNCTION VitalXOR3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a XOR b XOR c);
+    END;
+--
+    FUNCTION VitalNAND3  (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a AND b AND c));
+    END;
+--
+    FUNCTION VitalNOR3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a OR b OR c));
+    END;
+--
+    FUNCTION VitalXNOR3  (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a XOR b XOR c));
+    END;
+
+    -- ---------------------------------------------------------------------------
+    -- Commonly used 4-bit Logical gates.
+    -- ---------------------------------------------------------------------------
+    FUNCTION VitalAND4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a AND b AND c AND d);
+    END;
+--
+    FUNCTION VitalOR4    (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a OR b OR c OR d);
+    END;
+--
+    FUNCTION VitalXOR4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a XOR b XOR c XOR d);
+    END;
+--
+    FUNCTION VitalNAND4  (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a AND b AND c AND d));
+    END;
+--
+    FUNCTION VitalNOR4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a OR b OR c OR d));
+    END;
+--
+    FUNCTION VitalXNOR4  (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a XOR b XOR c XOR d));
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Buffers
+    --   BUF    ....... standard non-inverting buffer
+    --   BUFIF0 ....... non-inverting buffer Data passes thru if (Enable = '0')
+    --   BUFIF1 ....... non-inverting buffer Data passes thru if (Enable = '1')
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalBUF    (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(To_UX01(Data));
+    END;
+--
+    FUNCTION VitalBUFIF0 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(BufIf0_Table(Enable,Data));
+    END;
+--
+    FUNCTION VitalBUFIF1 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(BufIf1_Table(Enable,Data));
+    END;
+    FUNCTION VitalIDENT  (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(To_UX01Z(Data));
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Invertors
+    --   INV    ......... standard inverting buffer
+    --   INVIF0 ......... inverting buffer Data passes thru if (Enable = '0')
+    --   INVIF1 ......... inverting buffer Data passes thru if (Enable = '1')
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalINV    (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT Data);
+    END;
+--
+    FUNCTION VitalINVIF0 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(InvIf0_Table(Enable,Data));
+    END;
+--
+    FUNCTION VitalINVIF1 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(InvIf1_Table(Enable,Data));
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Multiplexor
+    --   MUX   .......... result := data(dselect)
+    --   MUX2  .......... 2-input mux; result := data0 when (dselect = '0'),
+    --                                           data1 when (dselect = '1'),
+    --                        'X' when (dselect = 'X') and (data0 /= data1)
+    --   MUX4  .......... 4-input mux; result := data(dselect)
+    --   MUX8  .......... 8-input mux; result := data(dselect)
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalMUX2  (
+            CONSTANT Data1, Data0 :  IN std_ulogic;
+            CONSTANT      dSelect :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        CASE To_X01(dSelect) IS
+          WHEN '0'    => Result := To_UX01(Data0);
+          WHEN '1'    => Result := To_UX01(Data1);
+          WHEN OTHERS => Result := VitalSame( Data1, Data0 );
+        END CASE;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalMUX4  (
+            CONSTANT       Data :  IN std_logic_vector4;
+            CONSTANT    dSelect :  IN std_logic_vector2;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Slct : std_logic_vector2;
+        VARIABLE Result : UX01;
+    BEGIN
+        Slct := To_X01(dSelect);
+        CASE Slct IS
+          WHEN "00"   => Result := To_UX01(Data(0));
+          WHEN "01"   => Result := To_UX01(Data(1));
+          WHEN "10"   => Result := To_UX01(Data(2));
+          WHEN "11"   => Result := To_UX01(Data(3));
+          WHEN "0X"   => Result := VitalSame( Data(1), Data(0) );
+          WHEN "1X"   => Result := VitalSame( Data(2), Data(3) );
+          WHEN "X0"   => Result := VitalSame( Data(2), Data(0) );
+          WHEN "X1"   => Result := VitalSame( Data(3), Data(1) );
+          WHEN OTHERS => Result := VitalSame( VitalSame(Data(3),Data(2)),
+                                              VitalSame(Data(1),Data(0)));
+        END CASE;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalMUX8  (
+            CONSTANT       Data :  IN std_logic_vector8;
+            CONSTANT    dSelect :  IN std_logic_vector3;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        CASE To_X01(dSelect(2)) IS
+          WHEN '0'    => Result := VitalMUX4( Data(3 DOWNTO 0),
+                                              dSelect(1 DOWNTO 0));
+          WHEN '1'    => Result := VitalMUX4( Data(7 DOWNTO 4),
+                                              dSelect(1 DOWNTO 0));
+          WHEN OTHERS => Result := VitalSame( VitalMUX4( Data(3 DOWNTO 0),
+                                                         dSelect(1 DOWNTO 0)),
+                                              VitalMUX4( Data(7 DOWNTO 4),
+                                                         dSelect(1 DOWNTO 0)));
+        END CASE;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VInterMux    (
+            CONSTANT Data    : IN std_logic_vector;
+            CONSTANT dSelect : IN std_logic_vector
+          ) RETURN std_ulogic IS
+
+        CONSTANT sMsb     : INTEGER := dSelect'LENGTH;
+        CONSTANT dMsbHigh : INTEGER := Data'LENGTH;
+        CONSTANT dMsbLow  : INTEGER := Data'LENGTH/2;
+        ALIAS DataAlias : std_logic_vector (   Data'LENGTH DOWNTO 1) IS Data;
+        ALIAS dSelAlias : std_logic_vector (dSelect'LENGTH DOWNTO 1) IS dSelect;
+
+        VARIABLE Result : UX01;
+    BEGIN
+        IF dSelect'LENGTH = 1 THEN
+            Result := VitalMUX2( DataAlias(2), DataAlias(1), dSelAlias(1) );
+        ELSIF dSelect'LENGTH = 2 THEN
+            Result := VitalMUX4( DataAlias, dSelAlias );
+        ELSIF dSelect'LENGTH > 2 THEN
+          CASE To_X01(dSelect(sMsb)) IS
+            WHEN '0'    =>
+              Result := VInterMux( DataAlias(dMsbLow  DOWNTO          1),
+                                   dSelAlias(sMsb-1 DOWNTO 1) );
+            WHEN '1'    =>
+              Result := VInterMux( DataAlias(dMsbHigh DOWNTO dMsbLow+1),
+                                   dSelAlias(sMsb-1 DOWNTO 1) );
+            WHEN OTHERS =>
+              Result := VitalSame(
+                              VInterMux( DataAlias(dMsbLow  DOWNTO          1),
+                                         dSelAlias(sMsb-1 DOWNTO 1) ),
+                              VInterMux( DataAlias(dMsbHigh DOWNTO dMsbLow+1),
+                                         dSelAlias(sMsb-1 DOWNTO 1) )
+                              );
+          END CASE;
+        ELSE
+          Result := 'X'; -- dselect'LENGTH < 1
+        END IF;
+        RETURN Result;
+    END;
+--
+    FUNCTION VitalMUX   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT    dSelect :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        CONSTANT msb    : INTEGER := 2**dSelect'LENGTH;
+        ALIAS DataAlias : std_logic_vector (   Data'LENGTH DOWNTO 1) IS Data;
+        ALIAS dSelAlias : std_logic_vector (dSelect'LENGTH DOWNTO 1) IS dSelect;
+        VARIABLE lDat   : std_logic_vector(msb DOWNTO 1) := (OTHERS=>'X');
+        VARIABLE Result : UX01;
+    BEGIN
+        IF Data'LENGTH <= msb THEN
+            FOR i IN Data'LENGTH DOWNTO 1 LOOP
+                lDat(i) := DataAlias(i);
+            END LOOP;
+        ELSE
+            FOR i IN msb DOWNTO 1 LOOP
+                lDat(i) := DataAlias(i);
+            END LOOP;
+        END IF;
+        Result := VInterMux( lDat, dSelAlias );
+        RETURN ResultMap(Result);
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Decoder
+    --          General Algorithm :
+    --              (a) Result(...) := '0' when (enable = '0')
+    --              (b) Result(data) := '1'; all other subelements = '0'
+    --              ... Result array is decending (n-1 downto 0)
+    --
+    --          DECODERn  .......... n:2**n decoder
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalDECODER2  (
+            CONSTANT       Data :  IN std_ulogic;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector2 IS
+        VARIABLE Result : std_logic_vector2;
+    BEGIN
+        Result(1) := ResultMap(Enable AND (    Data));
+        Result(0) := ResultMap(Enable AND (NOT Data));
+        RETURN Result;
+    END;
+--
+    FUNCTION VitalDECODER4  (
+            CONSTANT       Data :  IN std_logic_vector2;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector4 IS
+        VARIABLE Result : std_logic_vector4;
+    BEGIN
+        Result(3) := ResultMap(Enable AND (    Data(1)) AND (    Data(0)));
+        Result(2) := ResultMap(Enable AND (    Data(1)) AND (NOT Data(0)));
+        Result(1) := ResultMap(Enable AND (NOT Data(1)) AND (    Data(0)));
+        Result(0) := ResultMap(Enable AND (NOT Data(1)) AND (NOT Data(0)));
+        RETURN Result;
+    END;
+--
+    FUNCTION VitalDECODER8  (
+            CONSTANT       Data :  IN std_logic_vector3;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector8 IS
+        VARIABLE Result : std_logic_vector8;
+    BEGIN
+        Result(7) := (    Data(2)) AND (    Data(1)) AND (    Data(0));
+        Result(6) := (    Data(2)) AND (    Data(1)) AND (NOT Data(0));
+        Result(5) := (    Data(2)) AND (NOT Data(1)) AND (    Data(0));
+        Result(4) := (    Data(2)) AND (NOT Data(1)) AND (NOT Data(0));
+        Result(3) := (NOT Data(2)) AND (    Data(1)) AND (    Data(0));
+        Result(2) := (NOT Data(2)) AND (    Data(1)) AND (NOT Data(0));
+        Result(1) := (NOT Data(2)) AND (NOT Data(1)) AND (    Data(0));
+        Result(0) := (NOT Data(2)) AND (NOT Data(1)) AND (NOT Data(0));
+
+        Result(0) := ResultMap ( Enable AND Result(0) );
+        Result(1) := ResultMap ( Enable AND Result(1) );
+        Result(2) := ResultMap ( Enable AND Result(2) );
+        Result(3) := ResultMap ( Enable AND Result(3) );
+        Result(4) := ResultMap ( Enable AND Result(4) );
+        Result(5) := ResultMap ( Enable AND Result(5) );
+        Result(6) := ResultMap ( Enable AND Result(6) );
+        Result(7) := ResultMap ( Enable AND Result(7) );
+
+        RETURN Result;
+    END;
+--
+    FUNCTION VitalDECODER   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector IS
+
+        CONSTANT DMsb : INTEGER := Data'LENGTH - 1;
+        ALIAS DataAlias : std_logic_vector ( DMsb DOWNTO 0 ) IS Data;
+    BEGIN
+        IF    Data'LENGTH = 1 THEN
+            RETURN VitalDECODER2 (DataAlias(    0     ), Enable, ResultMap );
+        ELSIF Data'LENGTH = 2 THEN
+            RETURN VitalDECODER4 (DataAlias(1 DOWNTO 0), Enable, ResultMap );
+        ELSIF Data'LENGTH = 3 THEN
+            RETURN VitalDECODER8 (DataAlias(2 DOWNTO 0), Enable, ResultMap );
+        ELSIF Data'LENGTH > 3 THEN
+            RETURN VitalDECODER  (DataAlias(DMsb-1 DOWNTO 0),
+                                  Enable AND (    DataAlias(DMsb)), ResultMap )
+                 & VitalDECODER  (DataAlias(DMsb-1 DOWNTO 0),
+                                  Enable AND (NOT DataAlias(DMsb)), ResultMap );
+        ELSE RETURN "X";
+        END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- N-bit wide Logical gates.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalAND   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge :  EdgeArray(Data'RANGE);
+        VARIABLE Data_Schd : SchedArray(Data'RANGE);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalAND(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := '1';
+        new_schd := Data_Schd(Data_Schd'LEFT);
+        FOR i IN Data'RANGE LOOP
+            NewValue  := NewValue  AND Data(i);
+            new_schd := new_schd AND Data_Schd(i);
+        END LOOP;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalOR    (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge :  EdgeArray(Data'RANGE);
+        VARIABLE Data_Schd : SchedArray(Data'RANGE);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalOR(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := '0';
+        new_schd := Data_Schd(Data_Schd'LEFT);
+        FOR i IN Data'RANGE LOOP
+            NewValue  := NewValue  OR Data(i);
+            new_schd := new_schd OR Data_Schd(i);
+        END LOOP;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalXOR   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge   :  EdgeArray(Data'RANGE);
+        VARIABLE DataB_Schd  : SchedArray(1 TO Data'LENGTH);
+        VARIABLE DataI_Schd  : SchedArray(1 TO Data'LENGTH);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS ADataB_Schd : SchedArray(Data'RANGE) IS DataB_Schd;
+        ALIAS ADataI_Schd : SchedArray(Data'RANGE) IS DataI_Schd;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalXOR(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( ADataB_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( ADataI_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( ADataB_Schd, Data_Edge, Atpd_data_q );
+        InvPath ( ADataI_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := VitalXOR ( Data );
+        new_schd := VitalXOR ( DataB_Schd, DataI_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalNAND  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge :  EdgeArray(Data'RANGE);
+        VARIABLE Data_Schd : SchedArray(Data'RANGE);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalNAND(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            InvPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        InvPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := '1';
+        new_schd := Data_Schd(Data_Schd'LEFT);
+        FOR i IN Data'RANGE LOOP
+            NewValue  := NewValue  AND Data(i);
+            new_schd := new_schd AND Data_Schd(i);
+        END LOOP;
+        NewValue  := NOT NewValue;
+        new_schd := NOT new_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF;
+    END;
+--
+    PROCEDURE VitalNOR   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge :  EdgeArray(Data'RANGE);
+        VARIABLE Data_Schd : SchedArray(Data'RANGE);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalNOR(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            InvPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        InvPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := '0';
+        new_schd := Data_Schd(Data_Schd'LEFT);
+        FOR i IN Data'RANGE LOOP
+            NewValue  := NewValue  OR Data(i);
+            new_schd := new_schd OR Data_Schd(i);
+        END LOOP;
+        NewValue  := NOT NewValue;
+        new_schd := NOT new_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalXNOR  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData    : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge   :  EdgeArray(Data'RANGE);
+        VARIABLE DataB_Schd  : SchedArray(1 TO Data'LENGTH);
+        VARIABLE DataI_Schd  : SchedArray(1 TO Data'LENGTH);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS ADataB_Schd : SchedArray(Data'RANGE) IS DataB_Schd;
+        ALIAS ADataI_Schd : SchedArray(Data'RANGE) IS DataI_Schd;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalXNOR(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( ADataB_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( ADataI_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( ADataB_Schd, Data_Edge, Atpd_data_q );
+        InvPath ( ADataI_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := VitalXNOR ( Data );
+        new_schd := VitalXNOR ( DataB_Schd, DataI_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+
+    -- ------------------------------------------------------------------------
+    -- Commonly used 2-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalAND2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalAND2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := a AND b;
+        new_schd := a_schd AND b_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalOR2   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalOR2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := a OR b;
+        new_schd := a_schd OR b_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNAND2 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNAND2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := a NAND b;
+        new_schd := a_schd NAND b_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNOR2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNOR2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := a NOR b;
+        new_schd := a_schd NOR b_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXOR2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd : SchedType;
+        VARIABLE ai_schd, bi_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXOR2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a XOR b;
+        new_schd := VitalXOR2 ( ab_schd,ai_schd, bb_schd,bi_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXNOR2 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd : SchedType;
+        VARIABLE ai_schd, bi_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXNOR2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := NOT (a XOR b);
+        new_schd := VitalXNOR2 ( ab_schd,ai_schd, bb_schd,bi_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Commonly used 3-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalAND3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+--
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalAND3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( c_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+        BufPath ( c_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a AND b AND c;
+        new_schd := a_schd AND b_schd AND c_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalOR3   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalOR3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( c_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+        BufPath ( c_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a OR b OR c;
+        new_schd := a_schd OR b_schd OR c_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNAND3 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNAND3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( c_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+        InvPath ( c_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := (a AND b) NAND c;
+        new_schd := (a_schd AND b_schd) NAND c_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNOR3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNOR3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( c_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+        InvPath ( c_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := (a OR b) NOR c;
+        new_schd := (a_schd OR b_schd) NOR c_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXOR3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd, cb_schd : SchedType;
+        VARIABLE ai_schd, bi_schd, ci_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXOR3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( cb_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( ci_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, GetEdge(c), tpd_c_q );
+        InvPath ( ci_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a XOR b XOR c;
+        new_schd := VitalXOR3 ( ab_schd,ai_schd,
+                                bb_schd,bi_schd,
+                                cb_schd,ci_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXNOR3 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd, cb_schd : SchedType;
+        VARIABLE ai_schd, bi_schd, ci_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXNOR3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( cb_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( ci_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, GetEdge(c), tpd_c_q );
+        InvPath ( ci_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := NOT (a XOR b XOR c);
+        new_schd := VitalXNOR3 ( ab_schd, ai_schd,
+                                 bb_schd, bi_schd,
+                                 cb_schd, ci_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Commonly used 4-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalAND4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalAND4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( c_schd, InitialEdge(c), tpd_c_q );
+        BufPath ( d_Schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+        BufPath ( c_schd, GetEdge(c), tpd_c_q );
+        BufPath ( d_Schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a AND b AND c AND d;
+        new_schd := a_schd AND b_schd AND c_schd AND d_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalOR4   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalOR4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( c_schd, InitialEdge(c), tpd_c_q );
+        BufPath ( d_Schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+        BufPath ( c_schd, GetEdge(c), tpd_c_q );
+        BufPath ( d_Schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a OR b OR c OR d;
+        new_schd := a_schd OR b_schd OR c_schd OR d_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNAND4 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNAND4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( c_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( d_Schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+        InvPath ( c_schd, GetEdge(c), tpd_c_q );
+        InvPath ( d_Schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := (a AND b) NAND (c AND d);
+        new_schd := (a_schd AND b_schd) NAND (c_schd AND d_Schd);
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNOR4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNOR4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( c_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( d_Schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+        InvPath ( c_schd, GetEdge(c), tpd_c_q );
+        InvPath ( d_Schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := (a OR b) NOR (c OR d);
+        new_schd := (a_schd OR b_schd) NOR (c_schd OR d_Schd);
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXOR4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd, cb_schd, DB_Schd : SchedType;
+        VARIABLE ai_schd, bi_schd, ci_schd, di_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXOR4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( ci_schd, InitialEdge(c), tpd_c_q );
+
+        BufPath ( DB_Schd, InitialEdge(d), tpd_d_q );
+        InvPath ( di_schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, GetEdge(c), tpd_c_q );
+        InvPath ( ci_schd, GetEdge(c), tpd_c_q );
+
+        BufPath ( DB_Schd, GetEdge(d), tpd_d_q );
+        InvPath ( di_schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a XOR b XOR c XOR d;
+        new_schd := VitalXOR4 ( ab_schd,ai_schd, bb_schd,bi_schd,
+                                cb_schd,ci_schd, DB_Schd,di_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXNOR4 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd, cb_schd, DB_Schd : SchedType;
+        VARIABLE ai_schd, bi_schd, ci_schd, di_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXNOR4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( ci_schd, InitialEdge(c), tpd_c_q );
+
+        BufPath ( DB_Schd, InitialEdge(d), tpd_d_q );
+        InvPath ( di_schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, GetEdge(c), tpd_c_q );
+        InvPath ( ci_schd, GetEdge(c), tpd_c_q );
+
+        BufPath ( DB_Schd, GetEdge(d), tpd_d_q );
+        InvPath ( di_schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := NOT (a XOR b XOR c XOR d);
+        new_schd := VitalXNOR4 ( ab_schd,ai_schd, bb_schd,bi_schd,
+                                 cb_schd,ci_schd, DB_Schd,di_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Buffers
+    --   BUF    ....... standard non-inverting buffer
+    --   BUFIF0 ....... non-inverting buffer Data passes thru if (Enable = '0')
+    --   BUFIF1 ....... non-inverting buffer Data passes thru if (Enable = '1')
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalBUF   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE NewValue      : UX01;
+        VARIABLE Glitch_Data  : GlitchDataType;
+        VARIABLE Dly, Glch    : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (tpd_a_q = VitalZeroDelay01) THEN
+      LOOP
+        q <= ResultMap(To_UX01(a));
+        WAIT ON a;
+      END LOOP;
+
+    ELSE
+      LOOP
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := To_UX01(a);     -- convert to forcing strengths
+        CASE EdgeType'(GetEdge(a)) IS
+          WHEN '1'|'/'|'R'|'r' => Dly := tpd_a_q(tr01);
+          WHEN '0'|'\'|'F'|'f' => Dly := tpd_a_q(tr10);
+          WHEN OTHERS          => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10));
+        END CASE;
+
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode );
+
+        WAIT ON a;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalBUFIF1 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        VARIABLE NewValue        : UX01Z;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_data_q   = VitalZeroDelay01 )
+         AND (tpd_enable_q = VitalZeroDelay01Z)) THEN
+      LOOP
+        q <= VitalBUFIF1( Data, Enable, ResultMap );
+        WAIT ON Data, Enable;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( d_Schd, InitialEdge(Data), tpd_data_q );
+        BufEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( d_Schd, GetEdge(Data), tpd_data_q );
+        BufEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := VitalBUFIF1( Data, Enable );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data),
+                        d_Schd, e1_Schd, e0_Schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalBUFIF0 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        VARIABLE NewValue        : UX01Z;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType;
+        VARIABLE ne1_schd, ne0_schd : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+  BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_data_q   = VitalZeroDelay01 )
+         AND (tpd_enable_q = VitalZeroDelay01Z)) THEN
+      LOOP
+        q <= VitalBUFIF0( Data, Enable, ResultMap );
+        WAIT ON Data, Enable;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( d_Schd, InitialEdge(Data), tpd_data_q );
+        InvEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( d_Schd, GetEdge(Data), tpd_data_q );
+        InvEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := VitalBUFIF0( Data, Enable );
+        ne1_schd := NOT e1_Schd;
+        ne0_schd := NOT e0_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data),
+                        d_Schd, ne1_schd, ne0_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+    END IF;
+    END;
+
+    PROCEDURE VitalIDENT (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT  ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        SUBTYPE v2 IS std_logic_vector(0 TO 1);
+        VARIABLE NewValue      : UX01Z;
+        VARIABLE Glitch_Data  : GlitchDataType;
+        VARIABLE Dly, Glch    : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (tpd_a_q = VitalZeroDelay01Z) THEN
+      LOOP
+        q <= ResultMap(To_UX01Z(a));
+        WAIT ON a;
+      END LOOP;
+
+    ELSE
+      LOOP
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        CASE v2'(To_X01Z(NewValue) & To_X01Z(a)) IS
+          WHEN "00"   => Dly := tpd_a_q(tr10);
+          WHEN "01"   => Dly := tpd_a_q(tr01);
+          WHEN "0Z"   => Dly := tpd_a_q(tr0z);
+          WHEN "0X"   => Dly := tpd_a_q(tr01);
+          WHEN "10"   => Dly := tpd_a_q(tr10);
+          WHEN "11"   => Dly := tpd_a_q(tr01);
+          WHEN "1Z"   => Dly := tpd_a_q(tr1z);
+          WHEN "1X"   => Dly := tpd_a_q(tr10);
+          WHEN "Z0"   => Dly := tpd_a_q(trz0);
+          WHEN "Z1"   => Dly := tpd_a_q(trz1);
+          WHEN "ZZ"   => Dly := 0 ns;
+          WHEN "ZX"   => Dly := Minimum (tpd_a_q(trz1), tpd_a_q(trz0));
+          WHEN "X0"   => Dly := tpd_a_q(tr10);
+          WHEN "X1"   => Dly := tpd_a_q(tr01);
+          WHEN "XZ"   => Dly := Minimum (tpd_a_q(tr0z), tpd_a_q(tr1z));
+          WHEN OTHERS => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10));
+        END CASE;
+        NewValue  := To_UX01Z(a);
+
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode );
+
+        WAIT ON a;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Invertors
+    --   INV    ......... standard inverting buffer
+    --   INVIF0 ......... inverting buffer Data passes thru if (Enable = '0')
+    --   INVIF1 ......... inverting buffer Data passes thru if (Enable = '1')
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalINV   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE NewValue      : UX01;
+        VARIABLE Glitch_Data  : GlitchDataType;
+        VARIABLE new_schd     : SchedType;
+        VARIABLE Dly, Glch    : TIME;
+    BEGIN
+    IF (tpd_a_q = VitalZeroDelay01) THEN
+      LOOP
+        q <= ResultMap(NOT a);
+        WAIT ON a;
+      END LOOP;
+
+    ELSE
+      LOOP
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := NOT a;
+        CASE EdgeType'(GetEdge(a)) IS
+          WHEN '1'|'/'|'R'|'r' => Dly := tpd_a_q(tr10);
+          WHEN '0'|'\'|'F'|'f' => Dly := tpd_a_q(tr01);
+          WHEN OTHERS          => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10));
+        END CASE;
+
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode );
+
+        WAIT ON a;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalINVIF1 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        VARIABLE NewValue        : UX01Z;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+  BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_data_q   = VitalZeroDelay01 )
+         AND (tpd_enable_q = VitalZeroDelay01Z)) THEN
+      LOOP
+        q <= VitalINVIF1( Data, Enable, ResultMap );
+        WAIT ON Data, Enable;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( d_Schd, InitialEdge(Data), tpd_data_q );
+        BufEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( d_Schd, GetEdge(Data), tpd_data_q );
+        BufEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := VitalINVIF1( Data, Enable );
+        new_schd := NOT d_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data),
+                        new_schd, e1_Schd, e0_Schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalINVIF0 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        VARIABLE NewValue        : UX01Z;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType;
+        VARIABLE ne1_schd, ne0_schd : SchedType := DefSchedType;
+        VARIABLE Dly, Glch      : TIME;
+  BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_data_q   = VitalZeroDelay01 )
+         AND (tpd_enable_q = VitalZeroDelay01Z)) THEN
+      LOOP
+        q <= VitalINVIF0( Data, Enable, ResultMap );
+        WAIT ON Data, Enable;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( d_Schd, InitialEdge(Data), tpd_data_q );
+        InvEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( d_Schd, GetEdge(Data), tpd_data_q );
+        InvEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := VitalINVIF0( Data, Enable );
+        ne1_schd := NOT e1_Schd;
+        ne0_schd := NOT e0_Schd;
+        new_schd := NOT d_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data),
+                        new_schd, ne1_schd, ne0_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Multiplexor
+    --   MUX   .......... result := data(dselect)
+    --   MUX2  .......... 2-input mux; result := data0 when (dselect = '0'),
+    --                                           data1 when (dselect = '1'),
+    --                        'X' when (dselect = 'X') and (data0 /= data1)
+    --   MUX4  .......... 4-input mux; result := data(dselect)
+    --   MUX8  .......... 8-input mux; result := data(dselect)
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalMUX2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL       d1, d0 :  IN std_ulogic;
+            SIGNAL         dSel :  IN std_ulogic;
+            CONSTANT   tpd_d1_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT   tpd_d0_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+        VARIABLE d1_Schd,  d0_Schd  : SchedType;
+        VARIABLE dSel_bSchd, dSel_iSchd : SchedType;
+        VARIABLE d1_Edge, d0_Edge, dSel_Edge : EdgeType;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_d1_q   = VitalZeroDelay01)
+         AND (tpd_d0_q   = VitalZeroDelay01)
+         AND (tpd_dsel_q = VitalZeroDelay01) ) THEN
+      LOOP
+        q <= VitalMUX2 ( d1, d0, dSel, ResultMap );
+        WAIT ON d1, d0, dSel;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( d1_Schd, InitialEdge(d1), tpd_d1_q );
+        BufPath ( d0_Schd, InitialEdge(d0), tpd_d0_q );
+        BufPath ( dSel_bSchd, InitialEdge(dSel), tpd_dsel_q );
+        InvPath ( dSel_iSchd, InitialEdge(dSel), tpd_dsel_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( d1_Schd, GetEdge(d1), tpd_d1_q );
+        BufPath ( d0_Schd, GetEdge(d0), tpd_d0_q );
+        BufPath ( dSel_bSchd, GetEdge(dSel), tpd_dsel_q );
+        InvPath ( dSel_iSchd, GetEdge(dSel), tpd_dsel_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalMUX2 ( d1, d0, dSel );
+        new_schd := VitalMUX2 ( d1_Schd, d0_Schd, dSel_bSchd, dSel_iSchd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON d1, d0, dSel;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalMUX4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector4;
+            SIGNAL         dSel :  IN std_logic_vector2;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE LastdSel  : std_logic_vector(dSel'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+        VARIABLE Data_Schd      : SchedArray4;
+        VARIABLE Data_Edge      : EdgeArray4;
+        VARIABLE dSel_Edge      : EdgeArray2;
+        VARIABLE dSel_bSchd     : SchedArray2;
+        VARIABLE dSel_iSchd     : SchedArray2;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN dSel'RANGE LOOP
+          IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN
+          FOR i IN Data'RANGE LOOP
+              IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+                  AllZeroDelay := FALSE;
+                  EXIT;
+              END IF;
+          END LOOP;
+
+          IF (AllZeroDelay) THEN LOOP
+              q <= VitalMUX(Data, dSel, ResultMap);
+              WAIT ON Data, dSel;
+          END LOOP;
+          END IF;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        FOR n IN dSel'RANGE LOOP
+            BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+            InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        GetEdge ( dSel, LastdSel, dSel_Edge );
+        BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q );
+        InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalMUX4 ( Data, dSel );
+        new_schd := VitalMUX4 ( Data_Schd, dSel_bSchd, dSel_iSchd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, dSel;
+      END LOOP;
+      END IF; --SN
+    END;
+
+    PROCEDURE VitalMUX8  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector8;
+            SIGNAL         dSel :  IN std_logic_vector3;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType  := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE LastdSel  : std_logic_vector(dSel'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+        VARIABLE Data_Schd      : SchedArray8;
+        VARIABLE Data_Edge      : EdgeArray8;
+        VARIABLE dSel_Edge      : EdgeArray3;
+        VARIABLE dSel_bSchd     : SchedArray3;
+        VARIABLE dSel_iSchd     : SchedArray3;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN dSel'RANGE LOOP
+          IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN
+          FOR i IN Data'RANGE LOOP
+              IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+                  AllZeroDelay := FALSE;
+                  EXIT;
+              END IF;
+          END LOOP;
+
+          IF (AllZeroDelay) THEN LOOP
+              q <= VitalMUX(Data, dSel, ResultMap);
+              WAIT ON Data, dSel;
+          END LOOP;
+          END IF;
+       ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        FOR n IN dSel'RANGE LOOP
+            BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+            InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        GetEdge ( dSel, LastdSel, dSel_Edge );
+        BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q );
+        InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalMUX8 ( Data, dSel );
+        new_schd := VitalMUX8 ( Data_Schd, dSel_bSchd, dSel_iSchd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, dSel;
+      END LOOP;
+      END IF;
+    END;
+--
+    PROCEDURE VitalMUX   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            SIGNAL         dSel :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE LastdSel  : std_logic_vector(dSel'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+        VARIABLE Data_Schd      : SchedArray(Data'RANGE);
+        VARIABLE Data_Edge      : EdgeArray(Data'RANGE);
+        VARIABLE dSel_Edge      : EdgeArray(dSel'RANGE);
+        VARIABLE dSel_bSchd     : SchedArray(dSel'RANGE);
+        VARIABLE dSel_iSchd     : SchedArray(dSel'RANGE);
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN dSel'RANGE LOOP
+          IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN
+          FOR i IN Data'RANGE LOOP
+              IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+                  AllZeroDelay := FALSE;
+                  EXIT;
+              END IF;
+          END LOOP;
+
+          IF (AllZeroDelay) THEN LOOP
+              q <= VitalMUX(Data, dSel, ResultMap);
+              WAIT ON Data, dSel;
+          END LOOP;
+          END IF;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        FOR n IN dSel'RANGE LOOP
+            BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+            InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        GetEdge ( dSel, LastdSel, dSel_Edge );
+        BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q );
+        InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalMUX ( Data, dSel );
+        new_schd := VitalMUX ( Data_Schd, dSel_bSchd, dSel_iSchd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, dSel;
+      END LOOP;
+     END IF; --SN
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Decoder
+    --          General Algorithm :
+    --              (a) Result(...) := '0' when (enable = '0')
+    --              (b) Result(data) := '1'; all other subelements = '0'
+    --              ... Result array is decending (n-1 downto 0)
+    --
+    --          DECODERn  .......... n:2**n decoder
+    -- Caution: If 'ResultMap' defines other than strength mapping, the
+    --          delay selection is not defined.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalDECODER2  (
+            SIGNAL              q : OUT std_logic_vector2;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE NewValue        : std_logic_vector2;
+        VARIABLE Glitch_Data    : GlitchArray2;
+        VARIABLE new_schd       : SchedArray2;
+        VARIABLE Dly, Glch      : TimeArray2;
+        VARIABLE Enable_Schd  : SchedType := DefSchedType;
+        VARIABLE Data_BSchd, Data_ISchd : SchedType;
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      IF (tpd_enable_q = VitalZeroDelay01) AND (tpd_data_q = VitalZeroDelay01) THEN
+      LOOP
+          q <= VitalDECODER2(Data, Enable, ResultMap);
+          WAIT ON Data, Enable;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( Data_BSchd, InitialEdge(Data), tpd_data_q );
+        InvPath ( Data_ISchd, InitialEdge(Data), tpd_data_q );
+        BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( Data_BSchd, GetEdge(Data), tpd_data_q );
+        InvPath ( Data_ISchd, GetEdge(Data), tpd_data_q );
+
+        BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalDECODER2 ( Data, Enable, ResultMap );
+        new_schd := VitalDECODER2 ( Data_BSchd, Data_ISchd, Enable_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+      END IF; -- SN
+    END;
+--
+    PROCEDURE VitalDECODER4  (
+            SIGNAL              q : OUT std_logic_vector4;
+            SIGNAL           Data :  IN std_logic_vector2;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType       := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : std_logic_vector4;
+        VARIABLE Glitch_Data    : GlitchArray4;
+        VARIABLE new_schd       : SchedArray4;
+        VARIABLE Dly, Glch      : TimeArray4;
+        VARIABLE Enable_Schd    : SchedType;
+        VARIABLE Enable_Edge    : EdgeType;
+        VARIABLE Data_Edge      : EdgeArray2;
+        VARIABLE Data_BSchd, Data_ISchd : SchedArray2;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      IF (tpd_enable_q /= VitalZeroDelay01) THEN
+          AllZeroDelay := FALSE;
+      ELSE
+          FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+          END LOOP;
+      END IF;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalDECODER4(Data, Enable, ResultMap);
+          WAIT ON Data, Enable;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_BSchd, Data_Edge, Atpd_data_q );
+        InvPath ( Data_ISchd, Data_Edge, Atpd_data_q );
+
+        BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalDECODER4 ( Data, Enable, ResultMap );
+        new_schd := VitalDECODER4 ( Data_BSchd, Data_ISchd, Enable_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+      END IF;
+    END;
+--
+    PROCEDURE VitalDECODER8  (
+            SIGNAL              q : OUT std_logic_vector8;
+            SIGNAL           Data :  IN std_logic_vector3;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : std_logic_vector8;
+        VARIABLE Glitch_Data    : GlitchArray8;
+        VARIABLE new_schd       : SchedArray8;
+        VARIABLE Dly, Glch      : TimeArray8;
+        VARIABLE Enable_Schd    : SchedType;
+        VARIABLE Enable_Edge    : EdgeType;
+        VARIABLE Data_Edge      : EdgeArray3;
+        VARIABLE Data_BSchd, Data_ISchd : SchedArray3;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      IF (tpd_enable_q /= VitalZeroDelay01) THEN
+          AllZeroDelay := FALSE;
+      ELSE
+          FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+          END LOOP;
+      END IF;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalDECODER(Data, Enable, ResultMap);
+          WAIT ON Data, Enable;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_BSchd, Data_Edge, Atpd_data_q );
+        InvPath ( Data_ISchd, Data_Edge, Atpd_data_q );
+
+        BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalDECODER8 ( Data, Enable, ResultMap );
+        new_schd := VitalDECODER8 ( Data_BSchd, Data_ISchd, Enable_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalDECODER   (
+            SIGNAL              q : OUT std_logic_vector;
+            SIGNAL           Data :  IN std_logic_vector;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : std_logic_vector(q'RANGE);
+        VARIABLE Glitch_Data    : GlitchDataArrayType(q'RANGE);
+        VARIABLE new_schd       : SchedArray(q'RANGE);
+        VARIABLE Dly, Glch      : VitalTimeArray(q'RANGE);
+        VARIABLE Enable_Schd    : SchedType;
+        VARIABLE Enable_Edge    : EdgeType;
+        VARIABLE Data_Edge      : EdgeArray(Data'RANGE);
+        VARIABLE Data_BSchd, Data_ISchd : SchedArray(Data'RANGE);
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE;
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      IF (tpd_enable_q /= VitalZeroDelay01) THEN
+          AllZeroDelay := FALSE;
+      ELSE
+          FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+          END LOOP;
+      END IF;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalDECODER(Data, Enable, ResultMap);
+          WAIT ON Data, Enable;
+      END LOOP;
+      ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_BSchd, Data_Edge, Atpd_data_q );
+        InvPath ( Data_ISchd, Data_Edge, Atpd_data_q );
+
+        BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalDECODER ( Data, Enable, ResultMap );
+        new_schd := VitalDECODER ( Data_BSchd, Data_ISchd, Enable_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+      END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalTruthTable  (
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+          ) RETURN std_logic_vector IS
+
+        CONSTANT InputSize   : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize     : INTEGER := TruthTable'LENGTH(2) - InputSize;
+        VARIABLE ReturnValue : std_logic_vector(OutSize - 1 DOWNTO 0)
+                               := (OTHERS => 'X');
+        VARIABLE DataInAlias : std_logic_vector(0 TO InputSize - 1)
+                               :=  To_X01(DataIn);
+        VARIABLE Index       : INTEGER;
+        VARIABLE Err         : BOOLEAN := FALSE;
+
+        -- This needs to be done since the TableLookup arrays must be
+        -- ascending starting with 0
+        VARIABLE TableAlias  : VitalTruthTableType(0 TO (TruthTable'LENGTH(1)-1),
+                                                   0 TO (TruthTable'LENGTH(2)-1))
+                                := TruthTable;
+
+    BEGIN
+        -- search through each row of the truth table
+        IF OutSize > 0 THEN
+          ColLoop:
+            FOR i IN TableAlias'RANGE(1) LOOP
+
+            RowLoop: -- Check each input element of the entry
+              FOR j IN 0 TO InputSize LOOP
+
+                IF (j = InputSize) THEN -- This entry matches
+                    -- Return the Result
+                    Index := 0;
+                    FOR k IN TruthTable'LENGTH(2) - 1 DOWNTO InputSize LOOP
+                        TruthOutputX01Z ( TableAlias(i,k),
+                                          ReturnValue(Index), Err);
+                        EXIT WHEN Err;
+                        Index := Index + 1;
+                    END LOOP;
+
+                    IF Err THEN
+                        ReturnValue := (OTHERS => 'X');
+                    END IF;
+                    RETURN ReturnValue;
+                END IF;
+                IF NOT ValidTruthTableInput(TableAlias(i,j)) THEN
+                    VitalError ( "VitalTruthTable", ErrInpSym,
+                                 To_TruthChar(TableAlias(i,j)) );
+                    EXIT ColLoop;
+                END IF;
+                EXIT RowLoop WHEN NOT ( TruthTableMatch( DataInAlias(j),
+                                                         TableAlias(i, j)));
+              END LOOP RowLoop;
+            END LOOP ColLoop;
+
+        ELSE
+            VitalError ( "VitalTruthTable", ErrTabWidSml );
+        END IF;
+        RETURN ReturnValue;
+    END VitalTruthTable;
+
+    FUNCTION VitalTruthTable  (
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+          ) RETURN std_logic IS
+
+        CONSTANT InputSize  : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize    : INTEGER := TruthTable'LENGTH(2) - InputSize;
+        VARIABLE TempResult : std_logic_vector(OutSize - 1 DOWNTO 0)
+                              := (OTHERS => 'X');
+    BEGIN
+        IF (OutSize > 0) THEN
+            TempResult := VitalTruthTable(TruthTable, DataIn);
+            IF ( 1 > OutSize) THEN
+                VitalError ( "VitalTruthTable", ErrTabResSml );
+            ELSIF ( 1 < OutSize) THEN
+                VitalError ( "VitalTruthTable", ErrTabResLrg );
+            END IF;
+            RETURN (TempResult(0));
+        ELSE
+            VitalError ( "VitalTruthTable", ErrTabWidSml );
+            RETURN 'X';
+        END IF;
+    END VitalTruthTable;
+
+    PROCEDURE VitalTruthTable (
+            SIGNAL   Result     : OUT std_logic_vector;
+            CONSTANT TruthTable : IN  VitalTruthTableType;
+            SIGNAL   DataIn     : IN  std_logic_vector        -- IR#236
+    ) IS
+        CONSTANT ResLeng     : INTEGER := Result'LENGTH;
+        CONSTANT ActResLen   : INTEGER := TruthTable'LENGTH(2) - DataIn'LENGTH;
+        CONSTANT FinalResLen : INTEGER := Minimum(ActResLen, ResLeng);
+        VARIABLE TempResult  : std_logic_vector(ActResLen - 1 DOWNTO 0)
+                                := (OTHERS => 'X');
+
+    BEGIN
+        TempResult := VitalTruthTable(TruthTable, DataIn);
+
+        IF (ResLeng > ActResLen) THEN
+            VitalError ( "VitalTruthTable", ErrTabResSml );
+        ELSIF (ResLeng < ActResLen) THEN
+            VitalError ( "VitalTruthTable", ErrTabResLrg );
+        END IF;
+        TempResult(FinalResLen-1 DOWNTO 0) := TempResult(FinalResLen-1 DOWNTO 0);
+        Result <= TempResult;
+
+    END VitalTruthTable;
+
+    PROCEDURE VitalTruthTable (
+            SIGNAL   Result     : OUT std_logic;
+            CONSTANT TruthTable : IN VitalTruthTableType;
+            SIGNAL DataIn       : IN std_logic_vector        -- IR#236
+    ) IS
+
+        CONSTANT ActResLen  : INTEGER := TruthTable'LENGTH(2) - DataIn'LENGTH;
+        VARIABLE TempResult : std_logic_vector(ActResLen - 1 DOWNTO 0)
+                              := (OTHERS => 'X');
+
+    BEGIN
+        TempResult := VitalTruthTable(TruthTable, DataIn);
+
+        IF ( 1 > ActResLen) THEN
+            VitalError ( "VitalTruthTable", ErrTabResSml );
+        ELSIF ( 1 < ActResLen) THEN
+            VitalError ( "VitalTruthTable", ErrTabResLrg );
+        END IF;
+        IF (ActResLen >  0) THEN
+            Result <= TempResult(0);
+        END IF;
+
+    END VitalTruthTable;
+
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalStateTable (
+            VARIABLE Result         : INOUT std_logic_vector;
+            VARIABLE PreviousDataIn : INOUT std_logic_vector;
+            CONSTANT StateTable     : IN VitalStateTableType;
+            CONSTANT DataIn         : IN std_logic_vector;
+            CONSTANT NumStates      : IN NATURAL
+    ) IS
+
+        CONSTANT InputSize     : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize       : INTEGER
+                                 := StateTable'LENGTH(2) - InputSize - NumStates;
+        CONSTANT ResLeng       : INTEGER := Result'LENGTH;
+        VARIABLE DataInAlias   : std_logic_vector(0 TO DataIn'LENGTH-1)
+                                 := To_X01(DataIn);
+        VARIABLE PrevDataAlias : std_logic_vector(0 TO PreviousDataIn'LENGTH-1)
+                                 := To_X01(PreviousDataIn);
+        VARIABLE ResultAlias   : std_logic_vector(0 TO ResLeng-1)
+                                 := To_X01(Result);
+        VARIABLE ExpResult     : std_logic_vector(0 TO OutSize-1);
+
+    BEGIN
+        IF (PreviousDataIn'LENGTH < DataIn'LENGTH) THEN
+            VitalError ( "VitalStateTable", ErrVctLng, "PreviousDataIn<DataIn");
+
+            ResultAlias := (OTHERS => 'X');
+            Result := ResultAlias;
+
+        ELSIF (OutSize <= 0) THEN
+            VitalError ( "VitalStateTable", ErrTabWidSml );
+
+            ResultAlias := (OTHERS => 'X');
+            Result := ResultAlias;
+
+        ELSE
+            IF (ResLeng > OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResSml );
+            ELSIF (ResLeng < OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResLrg );
+            END IF;
+
+            ExpResult := StateTableLookUp ( StateTable, DataInAlias,
+                                            PrevDataAlias, NumStates,
+                                            ResultAlias);
+            ResultAlias := (OTHERS => 'X');
+            ResultAlias ( Maximum(0, ResLeng - OutSize) TO ResLeng - 1)
+                   := ExpResult(Maximum(0, OutSize - ResLeng) TO OutSize-1);
+
+            Result := ResultAlias;
+            PrevDataAlias(0 TO InputSize - 1) := DataInAlias;
+            PreviousDataIn := PrevDataAlias;
+
+        END IF;
+    END VitalStateTable;
+
+
+    PROCEDURE VitalStateTable (
+            VARIABLE Result         : INOUT std_logic;        -- states
+            VARIABLE PreviousDataIn : INOUT std_logic_vector; -- previous inputs and states
+            CONSTANT StateTable     : IN VitalStateTableType; -- User's StateTable data
+            CONSTANT DataIn         : IN std_logic_vector     -- Inputs
+    ) IS
+
+        VARIABLE ResultAlias : std_logic_vector(0 TO 0);
+    BEGIN
+        ResultAlias(0) := Result;
+        VitalStateTable ( StateTable     => StateTable,
+                          DataIn         => DataIn,
+                          NumStates      => 1,
+                          Result         => ResultAlias,
+                          PreviousDataIn => PreviousDataIn
+                        );
+        Result := ResultAlias(0);
+
+    END VitalStateTable;
+
+    PROCEDURE VitalStateTable (
+            SIGNAL   Result     : INOUT std_logic_vector;
+            CONSTANT StateTable : IN VitalStateTableType;
+            SIGNAL   DataIn     : IN std_logic_vector;
+            CONSTANT NumStates  : IN NATURAL
+    ) IS
+
+        CONSTANT InputSize   : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize     : INTEGER
+                               := StateTable'LENGTH(2) - InputSize - NumStates;
+        CONSTANT ResLeng     : INTEGER := Result'LENGTH;
+
+        VARIABLE PrevData    : std_logic_vector(0 TO DataIn'LENGTH-1)
+                               := (OTHERS => 'X');
+        VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1);
+        VARIABLE ResultAlias : std_logic_vector(0 TO ResLeng-1);
+        VARIABLE ExpResult   : std_logic_vector(0 TO OutSize-1);
+
+    BEGIN
+        IF (OutSize <= 0) THEN
+            VitalError ( "VitalStateTable", ErrTabWidSml );
+
+            ResultAlias  := (OTHERS => 'X');
+            Result <= ResultAlias;
+
+        ELSE
+            IF (ResLeng > OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResSml );
+            ELSIF (ResLeng < OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResLrg );
+            END IF;
+
+            LOOP
+                DataInAlias := To_X01(DataIn);
+                ResultAlias := To_X01(Result);
+                ExpResult   := StateTableLookUp ( StateTable, DataInAlias,
+                                                  PrevData, NumStates,
+                                                  ResultAlias);
+                ResultAlias := (OTHERS => 'X');
+                ResultAlias(Maximum(0, ResLeng - OutSize) TO ResLeng-1)
+                       := ExpResult(Maximum(0, OutSize - ResLeng) TO OutSize-1);
+
+                Result   <= ResultAlias;
+                PrevData := DataInAlias;
+
+                WAIT ON DataIn;
+            END LOOP;
+
+        END IF;
+
+    END VitalStateTable;
+
+    PROCEDURE VitalStateTable (
+            SIGNAL   Result     : INOUT std_logic;
+            CONSTANT StateTable : IN VitalStateTableType;
+            SIGNAL   DataIn     : IN std_logic_vector
+    ) IS
+
+        CONSTANT InputSize   : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize     : INTEGER := StateTable'LENGTH(2) - InputSize-1;
+
+        VARIABLE PrevData    : std_logic_vector(0 TO DataIn'LENGTH-1)
+                               := (OTHERS => 'X');
+        VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1);
+        VARIABLE ResultAlias : std_logic_vector(0 TO 0);
+        VARIABLE ExpResult   : std_logic_vector(0 TO OutSize-1);
+
+    BEGIN
+        IF (OutSize <= 0) THEN
+            VitalError ( "VitalStateTable", ErrTabWidSml );
+
+            Result <= 'X';
+
+        ELSE
+            IF ( 1 > OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResSml );
+            ELSIF ( 1 < OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResLrg );
+            END IF;
+
+            LOOP
+                ResultAlias(0) := To_X01(Result);
+                DataInAlias := To_X01(DataIn);
+                ExpResult   := StateTableLookUp ( StateTable, DataInAlias,
+                                                  PrevData, 1, ResultAlias);
+
+                Result   <= ExpResult(OutSize-1);
+                PrevData := DataInAlias;
+
+                WAIT ON DataIn;
+            END LOOP;
+        END IF;
+
+    END VitalStateTable;
+
+    -- ------------------------------------------------------------------------
+    -- std_logic resolution primitive
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalResolve (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector  --IR236 4/2/98
+    ) IS
+        VARIABLE uData : std_ulogic_vector(Data'RANGE);
+    BEGIN
+        FOR i IN Data'RANGE LOOP
+            uData(i) := Data(i);
+        END LOOP;
+        q <= resolved(uData);
+    END;
+
+END VITAL_Primitives;
+
diff --git a/libraries/vital2000/prmtvs_p.vhdl b/libraries/vital2000/prmtvs_p.vhdl
new file mode 100644
index 000000000..764ac449a
--- /dev/null
+++ b/libraries/vital2000/prmtvs_p.vhdl
@@ -0,0 +1,1413 @@
+-- -----------------------------------------------------------------------------
+-- Title        : Standard VITAL_Primitives Package
+--              : $Revision: 598 $
+--              :
+-- Library      : This package shall be compiled into a library
+--              : symbolically named IEEE.
+--              :
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              :
+-- Purpose      : This packages defines standard types, constants, functions
+--              : and procedures for use in developing ASIC models.
+--              : Specifically a set of logic primitives are defined.
+--              :
+-- Known Errors :
+--              :
+-- Note         : No declarations or definitions shall be included in,
+--              : or excluded from this package. The "package declaration"
+--              : defines the objects (types, subtypes, constants, functions,
+--              : procedures ... etc.) that can be used by a user.  The package
+--              : body shall be considered the formal definition of the
+--              : semantics of this package.  Tool developers may choose to
+--              : implement the package body in the most efficient manner
+--              : available to them.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Acknowledgments:
+--   This code was originally developed under the "VHDL Initiative Toward ASIC
+--   Libraries" (VITAL), an industry sponsored initiative.  Technical
+--   Director: William Billowitch, VHDL Technology Group; U.S. Coordinator:
+--   Steve Schultz;  Steering Committee Members: Victor Berman, Cadence Design
+--   Systems; Oz Levia, Synopsys Inc.; Ray Ryan, Ryan & Ryan; Herman van Beek,
+--   Texas Instruments; Victor Martin, Hewlett-Packard Company.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History :
+-- ----------------------------------------------------------------------------
+-- Version No:|Auth:| Mod.Date:| Changes Made:
+--   v95.0 A  |     | 06/02/95 | Initial ballot draft 1995
+-- ----------------------------------------------------------------------------
+--   v95.3    | ddl | 09/24/96 | #236 - VitalTruthTable DataIn should be of
+--            |     |          |        of class SIGNAL  (PROPOSED)
+-- ----------------------------------------------------------------------------
+
+LIBRARY IEEE;
+USE     IEEE.Std_Logic_1164.ALL;
+USE     IEEE.VITAL_Timing.ALL;
+
+PACKAGE VITAL_Primitives IS
+    -- ------------------------------------------------------------------------
+    -- Type and Subtype Declarations
+    -- ------------------------------------------------------------------------
+
+    -- For Truth and State Tables
+    SUBTYPE VitalTruthSymbolType IS VitalTableSymbolType RANGE 'X' TO 'Z';
+    SUBTYPE VitalStateSymbolType IS VitalTableSymbolType RANGE '/' TO 'S';
+
+    TYPE VitalTruthTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> )
+         OF VitalTruthSymbolType;
+    TYPE VitalStateTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> )
+         OF VitalStateSymbolType;
+
+    -- ---------------------------------
+    -- Default values used by primitives
+    -- ---------------------------------
+    CONSTANT VitalDefDelay01  : VitalDelayType01;       -- Propagation delays
+    CONSTANT VitalDefDelay01Z : VitalDelayType01Z;
+
+    -- ------------------------------------------------------------------------
+    -- VITAL Primitives
+    -- 
+    --   The primitives packages contains a collections of common gates, 
+    -- including AND, OR, XOR, NAND, NOR, XNOR, BUF, INV, MUX and DECODER 
+    -- functions.  In addition, for sequential devices, a STATE TABLE construct
+    -- is provided.  For complex functions a modeler may wish to use either
+    -- a collection of connected VITAL primitives, or a TRUTH TABLE construct.
+    --
+    --   For each primitive a Function and Procedure is provided.  The primitive
+    -- functions are provided to support behavioral modeling styles.  The 
+    -- primitive procedures are provided to support structural modeling styles.
+    --
+    --   The procedures wait internally for an event on an input signal, compute
+    -- the new result, perform glitch handling, schedule transaction on the
+    -- output signals, and wait for future input events.  All of the functional 
+    -- (logic) input or output parameters of the primitive procedures are
+    -- signals.  All the other parameters are constants.
+    --
+    --   The procedure primitives are parameterized for separate path delays 
+    -- from each input signal.  All path delays default to 0 ns.
+    -- 
+    --   The sequential primitive functions compute the defined function and 
+    -- return a value of type std_ulogic or std_logic_vector.  All parameters
+    -- of the primitive functions are constants of mode IN.
+    --
+    --   The primitives are based on 1164 operators. The user may also elect to
+    --   express functions using the 1164 operators as well.  These styles are
+    --   all equally acceptable methods for device modeling.
+    --
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   N-input logic device function calls:
+    --                    VitalAND  VitalOR  VitalXOR 
+    --                    VitalNAND VitalNOR VitalXNOR             
+    --
+    -- Description:     The function calls return the evaluated logic function
+    --                  corresponding to the function name.
+    --
+    -- Arguments:         
+    --
+    --  IN                Type                  Description
+    --   Data              std_logic_vector      The input signals for the n-bit
+    --                                           wide logic functions.
+    --   ResultMap         VitalResultMapType    The output signal strength
+    --                                           result map to modify default
+    --                                           result mapping.  
+    --                    
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                      std_ulogic           The evaluated logic function of
+    --                                           the n-bit wide primitives.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalAND    (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalOR     (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXOR    (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNAND   (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNOR    (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXNOR   (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  N-input logic device concurrent procedure calls.
+    --                         VitalAND  VitalOR  VitalXOR 
+    --                         VitalNAND VitalNOR VitalXNOR             
+    --
+    -- Description:     The procedure calls return the evaluated logic function
+    --                  corresponding to the function name as a parameter to the
+    --                  procedure.  Propagation delay form data to q is a
+    --                  a parameter to the procedure.  A vector of delay values
+    --                  for inputs to output are provided.  It is noted that
+    --                  limitations in SDF make the back annotation of the delay
+    --                  array difficult.
+    --
+    -- Arguments:         
+    --
+    --  IN                  Type                  Description
+    --   Data               std_logic_vector       The input signals for the n-
+    --                                             bit wide logic functions.
+    --   tpd_data_q         VitalDelayArrayType01  The propagation delay from
+    --                                             the data inputs to the output
+    --                                             q.
+    --
+    --  INOUT
+    --   none 
+    --
+    --  OUT
+    --   q                  std_ulogic             The output signal of the 
+    --                                             evaluated logic function.
+    --
+    --  Returns  
+    --   none            
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalAND   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalOR    (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXOR   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNAND  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNOR   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXNOR  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   2,3 and 4 input logic device function calls.
+    -- 
+    --                    VitalAND2    VitalOR2    VitalXOR2 
+    --                    VitalAND3    VitalOR3    VitalXOR3             
+    --                    VitalAND4    VitalOR4    VitalXOR4
+    -- 
+    --                    VitalNAND2   VitalNOR2   VitalXNOR2             
+    --                    VitalNAND3   VitalNOR3   VitalXNOR3 
+    --                    VitalNAND4   VitalNOR4   VitalXNOR4             
+    --
+    -- Description:     The function calls return the evaluated 2, 3 or 4 input
+    --                  logic function corresponding to the function name.
+    --
+    -- Arguments:         
+    --
+    --  IN             Type               Description
+    --   a, b, c, d     std_ulogic         2 input devices have a and b as 
+    --                                     inputs.  3 input devices have a, b
+    --                                     and c as inputs.  4 input devices 
+    --                                     have a, b, c and d as inputs.
+    --   ResultMap      VitalResultMapType The output signal strength result map
+    --                                     to modify default result mapping.   
+    --                    
+    --  INOUT
+    --   none  
+    --
+    --  OUT
+    --   none 
+    --
+    --  Returns              
+    --                   std_ulogic        The result of the evaluated logic
+    --                                     function.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalAND2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalOR2    (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXOR2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNAND2  (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNOR2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXNOR2  (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalAND3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalOR3    (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXOR3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNAND3  (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNOR3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXNOR3  (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalAND4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalOR4    (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXOR4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNAND4  (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNOR4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXNOR4  (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  2, 3 and 4 input logic device concurrent procedure
+    --                  calls.
+    --
+    --                    VitalAND2    VitalOR2    VitalXOR2 
+    --                    VitalAND3    VitalOR3    VitalXOR3             
+    --                    VitalAND4    VitalOR4    VitalXOR4
+    -- 
+    --                    VitalNAND2   VitalNOR2   VitalXNOR2             
+    --                    VitalNAND3   VitalNOR3   VitalXNOR3 
+    --                    VitalNAND4   VitalNOR4   VitalXNOR4             
+    --
+    -- Description:     The procedure calls return the evaluated logic function
+    --                  corresponding to the function name as a parameter to the
+    --                  procedure.  Propagation delays from a and b to q are 
+    --                  a parameter to the procedure.  The default propagation
+    --                  delay is 0 ns.  
+    --
+    -- Arguments:         
+    --
+    --  IN             Type               Description
+    --   a, b, c, d     std_ulogic         2 input devices have a and b as 
+    --                                     inputs.  3 input devices have a, b
+    --                                     and c as inputs.  4 input devices 
+    --                                     have a, b, c and d as inputs.
+    --   tpd_a_q        VitalDelayType01   The propagation delay from the a
+    --                                     input to output q for 2, 3 and 4 
+    --                                     input devices.
+    --   tpd_b_q        VitalDelayType01   The propagation delay from the b
+    --                                     input to output q for 2, 3 and 4 
+    --                                     input devices.
+    --   tpd_c_q        VitalDelayType01   The propagation delay from the c
+    --                                     input to output q for 3 and 4 input 
+    --                                     devices.
+    --   tpd_d_q        VitalDelayType01   The propagation delay from the d
+    --                                     input to output q for 4 input 
+    --                                     devices.
+    --   ResultMap      VitalResultMapType The output signal strength result map
+    --                                     to modify default result mapping.  
+    --
+    --  INOUT
+    --   none 
+    --
+    --  OUT
+    --   q              std_ulogic         The output signal of the evaluated
+    --                                     logic function.
+    --
+    --  Returns              
+    --   none
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalAND2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalOR2   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXOR2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNAND2 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNOR2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXNOR2 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalAND3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalOR3   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXOR3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNAND3 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNOR3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXNOR3 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalAND4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalOR4   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXOR4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNAND4 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNOR4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXNOR4 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   Buffer logic device concurrent procedure calls.
+    --
+    -- Description:     Four buffer sequential primitive function calls are
+    --                  provided.  One is a simple buffer and the others 
+    --                  offer high and low enables and the four permits
+    --                  propagation of Z as shown below:
+    -- 
+    --                     VitalBUF     Standard non-inverting buffer
+    --                     VitalBUFIF0  Non-inverting buffer with Enable low
+    --                     VitalBUFIF1  Non-inverting buffer with Enable high
+    --                     VitalIDENT   Pass buffer capable of propagating Z
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   Data          std_ulogic          Input to the buffers
+    --   Enable        std_ulogic          Enable for the enable high and low
+    --                                     buffers.
+    --   ResultMap     VitalResultMapType  The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     simple buffer.  
+    --                 VitalResultZMapType The output signal strength result map
+    --                                     to modify default result mapping
+    --                                     which has high impedance capability
+    --                                     for the enable high, enable low and
+    --                                     identity buffers.
+    --                    
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                  std_ulogic        The output signal of the evaluated 
+    --                                    buffer function.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalBUF    (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+    FUNCTION VitalBUFIF0 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+    FUNCTION VitalBUFIF1 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+    FUNCTION VitalIDENT  (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  Buffer device procedure calls. 
+    --
+    -- Description:     Four buffer concurrent primitive procedure calls are
+    --                  provided.  One is a simple buffer and the others 
+    --                  offer high and low enables and the fourth permits
+    --                  propagation of Z as shown below:
+    -- 
+    --                     VitalBUF     Standard non-inverting buffer
+    --                     VitalBUFIF0  Non-inverting buffer with Enable low
+    --                     VitalBUFIF1  Non-inverting buffer with Enable high
+    --                     VitalIDENT   Pass buffer capable of propagating Z
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   a             std_ulogic          Input signal to the buffers
+    --   Enable        std_ulogic          Enable signal for the enable high and 
+    --                                     low buffers.
+    --   tpd_a_q       VitalDelayType01    Propagation delay from input to 
+    --                                     output for the simple buffer.
+    --                 VitalDelayType01Z   Propagation delay from input to 
+    --                                     to output for the enable high and low
+    --                                     and identity buffers.
+    --   tpd_enable_q  VitalDelayType01Z   Propagation delay from enable to
+    --                                     output for the enable high and low
+    --                                     buffers.
+    --   ResultMap     VitalResultMapType  The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     simple buffer.  
+    --                 VitalResultZMapType The output signal strength result map
+    --                                     to modify default result mapping
+    --                                     which has high impedance capability
+    --                                     for the enable high, enable low and
+    --                                     identity buffers.
+    --                    
+    -- INOUT
+    --  none   
+    --
+    -- OUT
+    --  q              std_ulogic          Output of the buffers.   
+    --
+    -- Returns 
+    --  none             
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalBUF   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalBUFIF0 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap);
+
+
+    PROCEDURE VitalBUFIF1 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap);
+
+    PROCEDURE VitalIDENT (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT  ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   VitalINV, VitalINVIF0, VitalINVIF1
+    --
+    -- Description:     Inverter functions which return the inverted signal
+    --                  value.  Inverters with enable low and high are provided
+    --                  which can drive high impedance when inactive.
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   Data          std_ulogic          Input to the inverter
+    --   Enable        std_ulogic          Enable to the enable high and low
+    --                                     inverters.
+    --   ResultMap     VitalResultMap      The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     simple inverter.
+    --                 VitalResultZMapType The output signal strength result map
+    --                                     to modify default result mapping
+    --                                     which has high impedance capability
+    --                                     for the enable high, enable low
+    --                                     inverters.
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                 std_ulogic          Output of the inverter
+    --
+    -- -------------------------------------------------------------------------
+
+    FUNCTION VitalINV    (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalINVIF0 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalINVIF1 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  VitalINV, VitalINVIF0, VitalINVIF1
+    --
+    -- Description:     The concurrent primitive procedure calls implement a 
+    --                  signal inversion function.  The output is a parameter to
+    --                  the procedure.  The path delay information is passed as
+    --                  a parameter to the call.
+    --                  
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   a             std_ulogic          Input signal for the simple inverter
+    --   Data          std_ulogic          Input signal for the enable high and
+    --                                     low inverters.
+    --   Enable        std_ulogic          Enable signal for the enable high and 
+    --                                     low inverters.
+    --   tpd_a_q       VitalDelayType01    Propagation delay from input a to
+    --                                     output q for the simple inverter.
+    --   tpd_data_q    VitalDelayType01    Propagation delay from input data to
+    --                                     output q for the enable high and low
+    --                                     inverters.
+    --   tpd_enable_q  VitalDelayType01Z   Propagation delay from input enable
+    --                                     to output q for the enable high and 
+    --                                     low inverters.
+    --   ResultMap     VitalResultMapType  The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     simple inverter. 
+    --                 VitalResultZMapType The output signal strength result map
+    --                                     to modify default result mapping
+    --                                     which has high impedance capability
+    --                                     for the enable high, enable low
+    --                                     inverters.
+    --                
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   q               std_ulogic        Output signal of the inverter.
+    --
+    --  Returns              
+    --   none
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalINV   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+    PROCEDURE VitalINVIF0 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap);
+
+    PROCEDURE VitalINVIF1 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap);
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   VitalMUX, VitalMUX2, VitalMUX4, VitalMUX8
+    --
+    -- Description:     The VitalMUX functions return the selected data bit 
+    --                  based on the value of dSelect.  For MUX2, the function
+    --                  returns data0 when dselect is 0 and returns data1 when
+    --                  dselect is 1.  When dselect is X, result is X for MUX2
+    --                  when data0 /= data1.  X propagation is reduced when the
+    --                  dselect signal is X and both data signals are identical.
+    --                  When this is the case, the result returned is the value
+    --                  of the data signals.
+    --
+    --                  For the N input device:
+    -- 
+    --                       N must equal 2**(bits of dSelect)  
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   Data           std_logic_vector   Input signal for the N-bit, 4-bit and 
+    --                                     8-bit mux.
+    --   Data1,Data0    std_ulogic         Input signals for the 2-bit mux.
+    --   dSelect        std_ulogic         Select signal for 2-bit mux
+    --                  std_logic_vector2  Select signal for 4-bit mux
+    --                  std_logic_vector3  Select signal for 8-bit mux
+    --                  std_logic_vector   Select signal for N-Bit mux
+    --   ResultMap      VitalResultMapType The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     all muxes. 
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                  std_ulogic         The value of the selected bit is 
+    --                                     returned.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalMUX   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT    dSelect :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalMUX2  (
+            CONSTANT Data1, Data0 :  IN std_ulogic;
+            CONSTANT      dSelect :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalMUX4  (
+            CONSTANT       Data :  IN std_logic_vector4;
+            CONSTANT    dSelect :  IN std_logic_vector2;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalMUX8  (
+            CONSTANT       Data :  IN std_logic_vector8;
+            CONSTANT    dSelect :  IN std_logic_vector3;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  VitalMUX, VitalMUX2, VitalMUX4, VitalMUX8
+    --
+    -- Description:     The VitalMUX concurrent primitive procedures calls
+    --                  return in the output q the value of the selected data
+    --                  bit based on the value of dsel.  For the two bit mux,
+    --                  the data returned is either d0 or d1, the data input.
+    --                  For 4, 8 and N-bit functions, data is the input and is
+    --                  of type std_logic_vector.  For the 2-bit mux, if d0 or
+    --                  d1 are X, the output is X only when d0 do not equal d1.
+    --                  When d0 and d1 are equal, the return value is this value
+    --                  to reduce X propagation.
+    --
+    --                  Propagation delay information is passed as a parameter
+    --                  to the procedure call for delays from data to output and
+    --                  select to output.  For 2-bit muxes, the propagation
+    --                  delays from data are provided for d0 and d1 to output.
+    --                  
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                   Description
+    --   d1,d0          std_ulogic            Input signals for the 2-bit mux.
+    --   Data           std_logic_vector4     Input signals for the 4-bit mux.
+    --                  std_logic_vector8     Input signals for the 8-bit mux.
+    --                  std_logic_vector      Input signals for the N-bit mux.
+    --   dsel           std_ulogic            Select signal for the 2-bit mux.
+    --                  std_logic_vector2     Select signals for the 4-bit mux.
+    --                  std_logic_vector3     Select signals for the 8-bit mux.
+    --                  std_logic_vector      Select signals for the N-bit mux.
+    --   tpd_d1_q       VitalDelayType01      Propagation delay from input d1 to
+    --                                        output q for 2-bit mux.
+    --   tpd_d0_q       VitalDelayType01      Propagation delay from input d0 to
+    --                                        output q for 2-bit mux.
+    --   tpd_data_q     VitalDelayArrayType01 Propagation delay from input data
+    --                                        to output q for 4-bit, 8-bit and
+    --                                        N-bit muxes.
+    --   tpd_dsel_q     VitalDelayType01      Propagation delay from input dsel
+    --                                        to output q for 2-bit mux.
+    --                  VitalDelayArrayType01 Propagation delay from input dsel
+    --                                        to output q for 4-bit, 8-bit and
+    --                                        N-bit muxes.
+    --   ResultMap      VitalResultMapType    The output signal strength result
+    --                                        map to modify default result
+    --                                        mapping for all muxes.
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   q              std_ulogic            The value of the selected signal.
+    --
+    --  Returns              
+    --   none
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalMUX   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            SIGNAL         dSel :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalMUX2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL       d1, d0 :  IN std_ulogic;
+            SIGNAL         dSel :  IN std_ulogic;
+            CONSTANT   tpd_d1_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT   tpd_d0_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalMUX4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector4;
+            SIGNAL         dSel :  IN std_logic_vector2;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalMUX8  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector8;
+            SIGNAL         dSel :  IN std_logic_vector3;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   VitalDECODER, VitalDECODER2, VitalDECODER4,
+    --                  VitalDECODER8
+    --
+    -- Description:     The VitalDECODER functions are the sequential primitive
+    --                  calls for decoder logic.  The functions are provided
+    --                  for N, 2, 4 and 8-bit outputs.  
+    --
+    --                  The N-bit decoder is (2**(bits of data)) wide.
+    --
+    --                  The VitalDECODER returns 0 if enable is 0.
+    --                  The VitalDECODER returns the result bit set to 1 if 
+    --                  enable is 1.  All other bits of returned result are 
+    --                  set to 0.
+    --
+    --                  The returned array is in descending order: 
+    --                  (n-1 downto 0).
+    --   
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   Data          std_ulogic          Input signal for 2-bit decoder.
+    --                 std_logic_vector2   Input signals for 4-bit decoder.
+    --                 std_logic_vector3   Input signals for 8-bit decoder.
+    --                 std_logic_vector    Input signals for N-bit decoder.
+    --   Enable        std_ulogic          Enable input signal.  The result is
+    --                                     output when enable is high.
+    --   ResultMap     VitalResultMapType  The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     all output signals of the decoders. 
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                 std_logic_vector2  The output of the 2-bit decoder.
+    --                 std_logic_vector4  The output of the 4-bit decoder.
+    --                 std_logic_vector8  The output of the 8-bit decoder.   
+    --                 std_logic_vector   The output of the n-bit decoder.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalDECODER   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector;
+
+    FUNCTION VitalDECODER2  (
+            CONSTANT       Data :  IN std_ulogic;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector2;
+
+    FUNCTION VitalDECODER4  (
+            CONSTANT       Data :  IN std_logic_vector2;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector4;
+
+    FUNCTION VitalDECODER8  (
+            CONSTANT       Data :  IN std_logic_vector3;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector8;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  VitalDECODER, VitalDECODER2, VitalDECODER4,
+    --                  VitalDECODER8
+    --
+    -- Description:     The VitalDECODER procedures are the concurrent primitive 
+    --                  procedure calls for decoder functions.  The procedures 
+    --                  are provided for N, 2, 4 and 8 outputs.  
+    --
+    --                  The N-bit decoder is (2**(bits of data)) wide.
+    --
+    --                  The procedural form of the decoder is used for
+    --                  distributed delay modeling.  The delay information for
+    --                  each path is passed as an argument to the procedure.
+    --
+    --                  Result is set to 0 if enable is 0.
+    --                  The result bit represented by data is set to 1 if 
+    --                  enable is 1.  All other bits of result are set to 0.
+    --
+    --                  The result array is in descending order: (n-1 downto 0).
+    --   
+    --                  For the N-bit decoder, the delay path is a vector of
+    --                  delays from inputs to outputs.  
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                  Description
+    --   Data          std_ulogic            Input signal for 2-bit decoder.
+    --                 std_logic_vector2     Input signals for 4-bit decoder.
+    --                 std_logic_vector3     Input signals for 8-bit decoder.
+    --                 std_logic_vector      Input signals for N-bit decoder.
+    --   enable        std_ulogic            Enable input signal.  The result is
+    --                                       output when enable is high. 
+    --   tpd_data_q    VitalDelayType01      Propagation delay from input data
+    --                                       to output q for 2-bit decoder.
+    --                 VitalDelayArrayType01 Propagation delay from input data
+    --                                       to output q for 4, 8 and n-bit
+    --                                       decoders.
+    --   tpd_enable_q  VitalDelayType01      Propagation delay from input enable
+    --                                       to output q for 2, 4, 8 and n-bit
+    --                                       decoders.
+    --
+    -- INOUT
+    --  none
+    --
+    -- OUT
+    --  q              std_logic_vector2     Output signals for 2-bit decoder. 
+    --                 std_logic_vector4     Output signals for 4-bit decoder.
+    --                 std_logic_vector8     Output signals for 8-bit decoder.
+    --                 std_logic_vector      Output signals for n-bit decoder.
+    --                        
+    -- Returns              
+    --  none
+    --
+    -- -------------------------------------------------------------------------    
+    PROCEDURE VitalDECODER   (
+            SIGNAL              q : OUT std_logic_vector;
+            SIGNAL           Data :  IN std_logic_vector;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+    PROCEDURE VitalDECODER2  (
+            SIGNAL              q : OUT std_logic_vector2;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalDECODER4  (
+            SIGNAL              q : OUT std_logic_vector4;
+            SIGNAL           Data :  IN std_logic_vector2;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+    PROCEDURE VitalDECODER8  (
+            SIGNAL              q : OUT std_logic_vector8;
+            SIGNAL           Data :  IN std_logic_vector3;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    -- -------------------------------------------------------------------------
+    -- Function Name:   VitalTruthTable
+    --
+    -- Description:     VitalTruthTable implements a truth table.  Given
+    --                  a set of inputs, a sequential search is performed
+    --                  to match the input.  If a match is found, the output
+    --                  is set based on the contents of the CONSTANT TruthTable.
+    --                  If there is no match, all X's are returned.  There is
+    --                  no limit to the size of the table.
+    --
+    --                  There is a procedure and function for VitalTruthTable.
+    --                  For each of these, a single value output (std_logic) and
+    --                  a multi-value output (std_logic_vector) are provided.
+    --
+    --                  The first dimension of the table is for number of
+    --                  entries in the truth table and second dimension is for
+    --                  the number of elements in a row. The number of inputs
+    --                  in the row should be Data'LENGTH plus result'LENGTH.
+    --
+    --                  Elements is a row will be interpreted as
+    --                  Input(NumInputs - 1),.., Input(0),
+    --                    Result(NumOutputs - 1),.., Result(0)
+    --
+    --                  All inputs will be mapped to the X01 subtype
+    --
+    --                  If the value of Result is not in the range 'X' to 'Z'
+    --                  then an error will be reported. Also, the Result is
+    --                  always given either as a 0, 1, X or Z value.
+    --
+    -- Arguments:         
+    --
+    --  IN            Type               Description
+    --                 TruthTable         The input constant which defines the
+    --                                    behavior in truth table form.
+    --                 DataIn             The inputs to the truth table used to
+    --                                    perform input match to select
+    --                                    output(s) to value(s) to drive.
+    --
+    --  INOUT
+    --   none                 
+    --
+    --  OUT
+    --   Result         std_logic         Concurrent procedure version scalar
+    --                                    output.
+    --                  std_logic_vector  Concurrent procedure version vector
+    --                                    output.
+    --
+    --  Returns              
+    --   Result         std_logic         Function version scalar output.
+    --                  std_logic_vector  Function version vector output.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalTruthTable  (
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+          ) RETURN std_logic_vector;
+
+    FUNCTION VitalTruthTable  (
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+          ) RETURN std_logic;
+
+    PROCEDURE VitalTruthTable (
+            SIGNAL   Result       : OUT std_logic_vector;
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            SIGNAL   DataIn       : IN std_logic_vector     -- IR#236
+                              );
+    PROCEDURE VitalTruthTable (
+            SIGNAL   Result       : OUT std_logic;
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            SIGNAL   DataIn       : IN std_logic_vector     -- IR#236
+                              );
+    -- -------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalStateTable
+    --
+    -- Description:     VitalStateTable is a non-concurrent implementation of a
+    --                  state machine (Moore Machine).  It is used to model
+    --                  sequential devices and devices with internal states.
+    --
+    --                  The procedure takes the value of the state table
+    --                  data set and performs a sequential search of the 
+    --                  CONSTANT StateTable until a match is found.  Once a 
+    --                  match is found, the result of that match is applied
+    --                  to Result.  If there is no match, all X's are returned.
+    --                  The resultant output becomes the input for the next 
+    --                  state.
+    --
+    --                  The first dimension of the table is the number of
+    --                  entries in the state table and second dimension is the
+    --                  number of elements in a row of the table. The number of
+    --                  inputs in the row should be DataIn'LENGTH. Result should
+    --                  contain the current state (which will become the next
+    --                  state) as well as the outputs
+    --
+    --                  Elements is a row of the table will be interpreted as
+    --                  Input(NumInputs-1),.., Input(0), State(NumStates-1),
+    --                   ..., State(0),Output(NumOutputs-1),.., Output(0)
+    -- 
+    --                  where State(numStates-1) DOWNTO State(0) represent the
+    --                  present state and Output(NumOutputs - 1) DOWNTO
+    --                  Outputs(NumOutputs - NumStates) represent the new
+    --                  values of the state variables (i.e. the next state).
+    --                  Also, Output(NumOutputs - NumStates - 1)
+    --
+    --                  This procedure returns the next state and the new
+    --                  outputs when a match is made between the present state
+    --                  and present inputs and the state table.  A search is
+    --                  made starting at the top of the state table and
+    --                  terminates with the first match.  If no match is found
+    --                  then the next state and new outputs are set to all 'X's.
+    --
+    --                  (Asynchronous inputs (i.e. resets and clears) must be
+    --                  handled by placing the corresponding entries at the top
+    --                  of the table. )
+    --
+    --                  All inputs will be mapped to the X01 subtype.
+    --
+    --                  NOTE:  Edge transitions should not be used as values
+    --                         for the state variables in the present state
+    --                         portion of the state table.  The only valid
+    --                         values that can be used for the present state
+    --                         portion of the state table are:
+    --                         'X', '0', '1', 'B', '-'
+    --
+    -- Arguments:         
+    --
+    --  IN             Type                 Description      
+    --   StateTable     VitalStateTableType  The input constant which defines
+    --                                       the behavior in state table form.
+    --   DataIn         std_logic_vector     The current state inputs to the
+    --                                       state table used to perform input
+    --                                       matches and transition
+    --                                       calculations.
+    --   NumStates      NATURAL              Number of state variables
+    --                    
+    --  INOUT
+    --   Result         std_logic            Output signal for scalar version of
+    --                                       the concurrent procedure call.
+    --                  std_logic_vector     Output signals for vector version
+    --                                       of the concurrent procedure call.
+    --   PreviousDataIn std_logic_vector     The previous inputs and states used
+    --                                       in transition calculations and to 
+    --                                       set outputs for steady state cases. 
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns  
+    --   none            
+    --
+    -- -------------------------------------------------------------------------
+   PROCEDURE VitalStateTable (
+            VARIABLE Result         : INOUT std_logic_vector;
+            VARIABLE PreviousDataIn : INOUT std_logic_vector;
+            CONSTANT StateTable     : IN VitalStateTableType;
+            CONSTANT DataIn         : IN  std_logic_vector;
+            CONSTANT NumStates      : IN NATURAL
+   );
+
+   PROCEDURE VitalStateTable (
+            VARIABLE Result         : INOUT std_logic;
+            VARIABLE PreviousDataIn : INOUT std_logic_vector;
+            CONSTANT StateTable     : IN VitalStateTableType;
+            CONSTANT DataIn         : IN  std_logic_vector
+   );
+
+   PROCEDURE VitalStateTable (
+            SIGNAL   Result     : INOUT std_logic_vector;
+            CONSTANT StateTable : IN VitalStateTableType;
+            SIGNAL   DataIn     : IN std_logic_vector;
+            CONSTANT NumStates  : IN NATURAL
+   );
+
+   PROCEDURE VitalStateTable (
+            SIGNAL   Result     : INOUT std_logic;
+            CONSTANT StateTable : IN VitalStateTableType;
+            SIGNAL   DataIn     : IN std_logic_vector
+   );
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalResolve
+    --
+    -- Description:     VitalResolve takes a vector of signals and resolves
+    --                  them to a std_ulogic value.  This procedure can be used
+    --                  to resolve multiple drivers in a single model.  
+    --                  
+    -- Arguments:         
+    --
+    --  IN           Type               Description
+    --   Data         std_logic_vector   Set of input signals which drive a
+    --                                   common signal.
+    --                    
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   q            std_ulogic         Output signal which is the resolved 
+    --                                   value being driven by the collection of
+    --                                   input signals.
+    --
+    --  Returns              
+    --   none
+    --                    
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalResolve (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_logic_vector);	--IR236 4/2/98
+
+END VITAL_Primitives;
diff --git a/libraries/vital2000/timing_b.vhdl b/libraries/vital2000/timing_b.vhdl
new file mode 100644
index 000000000..28bf52095
--- /dev/null
+++ b/libraries/vital2000/timing_b.vhdl
@@ -0,0 +1,2187 @@
+-------------------------------------------------------------------------------
+-- Title        : Standard VITAL TIMING Package
+--              : $Revision: 598 $
+-- Library      : VITAL
+--              :  
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              :  
+-- Purpose      : This packages defines standard types, attributes, constants,
+--              : functions and procedures for use in developing ASIC models.
+--              : This file contains the Package Body.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History : 
+-- ----------------------------------------------------------------------------
+-- Version No:|Auth:| Mod.Date:| Changes Made:
+--   v95.0 A  |     | 06/08/95 | Initial ballot draft 1995
+--   v95.1    |     | 08/31/95 | #IR203 - Timing violations at time 0
+--                               #IR204 - Output mapping prior to glitch detection
+--   v98.0    |TAG  | 03/27/98 | Initial ballot draft 1998
+--                             | #IR225 - Negative Premptive Glitch
+--                                      **Code_effected=ReportGlitch,VitalGlitch,
+--		                                VitalPathDelay,VitalPathDelay01,
+--                                      VitalPathDelay01z.
+--                               #IR105 - Skew timing check needed
+--                                      **Code_effected=NONE, New code added!! 
+--                               #IR245,IR246,IR251 ITC code to fix false boundry cases
+--					                    **Code_effected=InternalTimingCheck.
+--				                 #IR248 - Allows VPD to use a default timing delay
+--                                      **Code_effected=VitalPathDelay,
+--                                        VitalPathDelay01,VitalPathDelay01z,
+--                                        VitalSelectPathDelay,VitalSelectPathDelay01,
+--                                        VitalSelectPathDelay01z.
+--				                 #IR250 - Corrects fastpath condition in VPD
+--                                      **Code_effected=VitalPathDelay01,
+--                                        VitalPathDelay01z,
+--                               #IR252 - Corrects cancelled timing check call if
+--                                        condition expires.  
+--                                        **Code_effected=VitalSetupHoldCheck,
+--                                        VitalRecoveryRemovalCheck.
+--   v98.1    | jdc | 03/25/99 | Changed UseDefaultDelay to IgnoreDefaultDelay
+--                               and set default to FALSE in VitalPathDelay()
+--
+-- ----------------------------------------------------------------------------
+
+LIBRARY STD;
+USE STD.TEXTIO.ALL;
+
+PACKAGE BODY VITAL_Timing IS
+
+    -- --------------------------------------------------------------------
+    -- Package Local Declarations
+    -- --------------------------------------------------------------------
+ 
+    TYPE CheckType IS ( SetupCheck, HoldCheck, RecoveryCheck, RemovalCheck,
+                        PulseWidCheck, PeriodCheck );
+
+    TYPE CheckInfoType IS RECORD
+            Violation : BOOLEAN;
+            CheckKind : CheckType;
+            ObsTime   : TIME;
+            ExpTime   : TIME;
+            DetTime   : TIME;
+            State     : X01;
+    END RECORD;
+
+    TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; 
+    TYPE HiLoStrType IS ARRAY (std_ulogic RANGE 'X' TO '1') OF STRING(1 TO 4); 
+
+    CONSTANT LogicCvtTable : LogicCvtTableType 
+                     := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); 
+    CONSTANT HiLoStr     : HiLoStrType := ("  X ", " Low", "High" ); 
+
+    TYPE EdgeSymbolMatchType IS ARRAY (X01,X01,VitalEdgeSymbolType) OF BOOLEAN;
+    -- last value, present value, edge symbol
+    CONSTANT EdgeSymbolMatch : EdgeSymbolMatchType :=  (
+      'X'=>('X'=>(                                 OTHERS => FALSE),
+            '0'=>('N'|'F'|'v'|'E'|'D'|'*' => TRUE, OTHERS => FALSE ),
+            '1'=>('P'|'R'|'^'|'E'|'A'|'*' => TRUE, OTHERS => FALSE ) ),
+      '0'=>('X'=>(    'r'|'p'|'R'|'A'|'*' => TRUE, OTHERS => FALSE ),
+            '0'=>(                                 OTHERS => FALSE ),
+            '1'=>(    '/'|'P'|'p'|'R'|'*' => TRUE, OTHERS => FALSE ) ),
+      '1'=>('X'=>(    'f'|'n'|'F'|'D'|'*' => TRUE, OTHERS => FALSE ),
+            '0'=>(    '\'|'N'|'n'|'F'|'*' => TRUE, OTHERS => FALSE ),
+            '1'=>(                                 OTHERS => FALSE ) ) );
+
+
+
+
+    ---------------------------------------------------------------------------
+    -- Tables used to implement 'posedge' and 'negedge' in path delays
+    -- These are new tables for Skewcheck routines.  IR105
+    ---------------------------------------------------------------------------
+ 
+    TYPE EdgeRable IS ARRAY(std_ulogic, std_ulogic) OF boolean;
+ 
+    CONSTANT Posedge : EdgeRable := (
+    -- ------------------------------------------------------------------------
+    -- |  U       X     0      1       Z      W      L      H     -
+    -- ------------------------------------------------------------------------
+       ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ), -- U
+       ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ), -- X
+       ( TRUE , TRUE , FALSE, TRUE , TRUE , TRUE , FALSE, TRUE , TRUE  ), -- 0
+       ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- 1
+       ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ), -- Z
+       ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ), -- W
+       ( TRUE , TRUE , FALSE, TRUE , TRUE , TRUE , FALSE, TRUE , TRUE  ), -- L
+       ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- H
+       ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE )  -- -
+ 
+    );	 --IR105
+ 
+ 
+    CONSTANT Negedge : EdgeRable := (
+    -- -----------------------------------------------------------------------
+    -- |  U       X     0      1       Z      W      L      H     -
+    -- -----------------------------------------------------------------------
+       ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ), -- U
+       ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ), -- X
+       ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- 0
+       ( TRUE , TRUE , TRUE , FALSE, TRUE , TRUE , TRUE , FALSE, TRUE  ), -- 1
+       ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ), -- Z
+       ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ), -- W
+       ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- L
+       ( TRUE , TRUE , TRUE , FALSE, TRUE , TRUE , TRUE , FALSE, TRUE  ), -- H
+       ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ) --  -
+ 
+    );	  --IR105
+ 
+    TYPE SkewType IS (Inphase, Outphase);  --IR105
+
+    CONSTANT noTrigger : TIME := -1 ns;	   --IR105
+    ---------------------------------------------------------------------------
+	--    End of Skew (IR105 additions)
+    ---------------------------------------------------------------------------
+   	
+ 
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    -- Misc Utilities Local Utilities
+    ---------------------------------------------------------------------------
+    -----------------------------------------------------------------------
+    FUNCTION Minimum ( CONSTANT t1,t2 : IN TIME ) RETURN TIME IS
+    BEGIN
+        IF ( t1 < t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+    END Minimum;
+    -----------------------------------------------------------------------
+    FUNCTION Maximum ( CONSTANT t1,t2 : IN TIME ) RETURN TIME IS
+    BEGIN
+        IF ( t1 > t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+    END Maximum;
+
+    --------------------------------------------------------------------
+    -- Error Message Types and Tables
+    --------------------------------------------------------------------
+    TYPE VitalErrorType IS (
+        ErrVctLng  ,
+        ErrNoPath  ,
+        ErrNegPath ,
+        ErrNegDel
+    );
+ 
+    TYPE VitalErrorSeverityType IS ARRAY (VitalErrorType) OF SEVERITY_LEVEL;
+    CONSTANT VitalErrorSeverity : VitalErrorSeverityType := (
+        ErrVctLng    => ERROR,
+        ErrNoPath    => WARNING,
+        ErrNegPath   => WARNING,
+        ErrNegDel    => WARNING
+    );
+ 
+    CONSTANT MsgNoPath : STRING :=
+      "No Delay Path Condition TRUE.  0-delay used. Output signal is: ";
+    CONSTANT MsgNegPath : STRING :=
+      "Path Delay less than time since input. 0 delay used. Output signal is: ";
+    CONSTANT MsgNegDel : STRING :=
+      "Negative delay. New output value not scheduled. Output signal is: ";
+    CONSTANT MsgVctLng : STRING :=
+      "Vector (array) lengths not equal. ";
+ 
+    CONSTANT MsgUnknown : STRING :=
+      "Unknown error message.";
+ 
+    FUNCTION VitalMessage (
+            CONSTANT ErrorId : IN VitalErrorType
+          ) RETURN STRING IS
+    BEGIN
+        CASE ErrorId IS
+            WHEN ErrVctLng    => RETURN MsgVctLng;
+            WHEN ErrNoPath    => RETURN MsgNoPath;
+            WHEN ErrNegPath   => RETURN MsgNegPath;
+            WHEN ErrNegDel    => RETURN MsgNegDel;
+            WHEN OTHERS       => RETURN MsgUnknown;
+        END CASE;
+    END;
+
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId)
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+ 
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType;
+            CONSTANT Info    : IN STRING
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId) & Info
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+ 
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType;
+            CONSTANT Info    : IN CHARACTER
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId) & Info
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+ 
+    ---------------------------------------------------------------------------
+    -- Time Delay Assignment Subprograms
+    ---------------------------------------------------------------------------
+    FUNCTION VitalExtendToFillDelay ( 
+            CONSTANT Delay : IN VitalDelayType
+          ) RETURN VitalDelayType01Z IS
+    BEGIN
+        RETURN (OTHERS => Delay);
+    END VitalExtendToFillDelay;
+
+    FUNCTION VitalExtendToFillDelay ( 
+            CONSTANT Delay : IN VitalDelayType01
+          ) RETURN VitalDelayType01Z IS
+        VARIABLE Delay01Z  : VitalDelayType01Z;
+    BEGIN
+        Delay01Z(tr01) := Delay(tr01);
+        Delay01Z(tr0z) := Delay(tr01);
+        Delay01Z(trz1) := Delay(tr01);
+        Delay01Z(tr10) := Delay(tr10);
+        Delay01Z(tr1z) := Delay(tr10);
+        Delay01Z(trz0) := Delay(tr10);
+        RETURN (Delay01Z);
+    END VitalExtendToFillDelay;
+
+    FUNCTION VitalExtendToFillDelay ( 
+            CONSTANT Delay : IN VitalDelayType01Z
+          ) RETURN VitalDelayType01Z IS
+    BEGIN
+        RETURN Delay;
+    END VitalExtendToFillDelay;
+
+    ---------------------------------------------------------------------------
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType
+          ) RETURN TIME IS
+    BEGIN
+          RETURN delay;
+    END VitalCalcDelay;
+
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType01
+          ) RETURN TIME IS
+        VARIABLE Result : TIME;
+    BEGIN
+        CASE Newval IS
+          WHEN '0' | 'L' => Result := Delay(tr10);
+          WHEN '1' | 'H' => Result := Delay(tr01);
+          WHEN 'Z' =>
+            CASE Oldval IS
+              WHEN '0' | 'L' => Result := Delay(tr01);
+              WHEN '1' | 'H' => Result := Delay(tr10);
+              WHEN OTHERS    => Result := MAXIMUM(Delay(tr10), Delay(tr01));
+            END CASE;
+          WHEN OTHERS =>
+            CASE Oldval IS
+              WHEN '0' | 'L' => Result := Delay(tr01);
+              WHEN '1' | 'H' => Result := Delay(tr10);
+              WHEN 'Z'       => Result := MINIMUM(Delay(tr10), Delay(tr01));
+              WHEN OTHERS    => Result := MAXIMUM(Delay(tr10), Delay(tr01));
+            END CASE;
+        END CASE;
+        RETURN Result;
+    END VitalCalcDelay;
+
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType01Z
+          ) RETURN TIME IS
+        VARIABLE Result : TIME;
+    BEGIN
+        CASE Oldval IS
+          WHEN '0' | 'L' =>
+            CASE Newval IS
+              WHEN '0' | 'L' => Result := Delay(tr10);
+              WHEN '1' | 'H' => Result := Delay(tr01);
+              WHEN 'Z'       => Result := Delay(tr0z);
+              WHEN OTHERS    => Result := MINIMUM(Delay(tr01), Delay(tr0z));
+            END CASE;
+          WHEN '1' | 'H' =>
+            CASE Newval IS
+              WHEN '0' | 'L' => Result := Delay(tr10);
+              WHEN '1' | 'H' => Result := Delay(tr01);
+              WHEN 'Z'       => Result := Delay(tr1z);
+              WHEN OTHERS    => Result := MINIMUM(Delay(tr10), Delay(tr1z));
+            END CASE;
+          WHEN 'Z' =>
+            CASE Newval IS
+              WHEN '0' | 'L' => Result := Delay(trz0);
+              WHEN '1' | 'H' => Result := Delay(trz1);
+              WHEN 'Z'       => Result := MAXIMUM (Delay(tr0z), Delay(tr1z));
+              WHEN OTHERS    => Result := MINIMUM (Delay(trz1), Delay(trz0));
+            END CASE;
+          WHEN 'U' | 'X' | 'W' | '-'  =>
+            CASE Newval IS
+              WHEN '0' | 'L' => Result := MAXIMUM(Delay(tr10), Delay(trz0));
+              WHEN '1' | 'H' => Result := MAXIMUM(Delay(tr01), Delay(trz1));
+              WHEN 'Z'       => Result := MAXIMUM(Delay(tr1z), Delay(tr0z));
+              WHEN OTHERS    => Result := MAXIMUM(Delay(tr10), Delay(tr01));
+            END CASE;
+        END CASE;
+        RETURN Result;
+    END VitalCalcDelay;
+
+   ---------------------------------------------------------------------------
+    --
+    -- VitalSelectPathDelay returns the path delay selected by the Paths array.
+    -- If no paths are selected, it returns either the appropriate default
+    -- delay or TIME'HIGH, depending upon the value of IgnoreDefaultDelay.
+    --
+
+    FUNCTION VitalSelectPathDelay (
+            CONSTANT NewValue           : IN  std_logic;
+            CONSTANT OldValue           : IN  std_logic;
+            CONSTANT OutSignalName      : IN  string;
+            CONSTANT Paths              : IN  VitalPathArrayType;
+            CONSTANT DefaultDelay       : IN  VitalDelayType;
+            CONSTANT IgnoreDefaultDelay : IN  BOOLEAN
+          ) RETURN TIME IS
+ 
+        VARIABLE TmpDelay  : TIME;
+        VARIABLE InputAge  : TIME := TIME'HIGH;
+        VARIABLE PropDelay : TIME := TIME'HIGH;
+    BEGIN
+        -- for each delay path
+        FOR i IN Paths'RANGE LOOP
+            -- ignore the delay path if it is not enabled
+            NEXT WHEN NOT Paths(i).PathCondition;
+            -- ignore the delay path if a more recent input event has been seen
+            NEXT WHEN Paths(i).InputChangeTime > InputAge;
+ 
+            -- This is the most recent input change (so far)
+            -- Get the transition dependent delay
+            TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay);
+ 
+            -- If other inputs changed at the same time,
+            -- then use the minimum of their propagation delays,
+            -- else use the propagation delay from this input.
+            IF Paths(i).InputChangeTime < InputAge THEN
+                PropDelay := TmpDelay;
+            ELSE -- Simultaneous inputs change
+                IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF;
+            end if;
+ 
+            InputAge := Paths(i).InputChangeTime;
+        END LOOP;
+ 
+        -- If there were no paths (with an enabled condition),
+        -- use the default delay, if so indicated, otherwise return TIME'HIGH
+        IF (PropDelay = TIME'HIGH) THEN
+	  IF (IgnoreDefaultDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+	  END IF;
+	  
+	-- If the time since the most recent selected input event is
+	-- greater than the propagation delay from that input,
+	-- then use the default delay (won't happen if no paths are selected)
+        ELSIF (InputAge > PropDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- Adjust the propagation delay by the time since the
+        -- the input event occurred  (Usually 0 ns).
+        ELSE
+            PropDelay := PropDelay - InputAge;
+        END IF;
+ 
+        RETURN PropDelay;
+    END;
+ 
+    FUNCTION VitalSelectPathDelay (
+            CONSTANT NewValue           : IN  std_logic;
+            CONSTANT OldValue           : IN  std_logic;
+            CONSTANT OutSignalName      : IN  string;
+            CONSTANT Paths              : IN  VitalPathArray01Type;
+            CONSTANT DefaultDelay       : IN  VitalDelayType01;
+            CONSTANT IgnoreDefaultDelay : IN  BOOLEAN
+          ) RETURN TIME IS
+ 
+        VARIABLE TmpDelay  : TIME;
+        VARIABLE InputAge  : TIME := TIME'HIGH;
+        VARIABLE PropDelay : TIME := TIME'HIGH;
+    BEGIN
+        -- for each delay path
+        FOR i IN Paths'RANGE LOOP
+            -- ignore the delay path if it is not enabled
+            NEXT WHEN NOT Paths(i).PathCondition;
+            -- ignore the delay path if a more recent input event has been seen
+            NEXT WHEN Paths(i).InputChangeTime > InputAge;
+ 
+            -- This is the most recent input change (so far)
+            -- Get the transition dependent delay
+            TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay);
+ 
+            -- If other inputs changed at the same time,
+            -- then use the minimum of their propagation delays,
+            -- else use the propagation delay from this input.
+            IF Paths(i).InputChangeTime < InputAge THEN
+                PropDelay := TmpDelay;
+            ELSE -- Simultaneous inputs change
+                IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF;
+            end if;
+ 
+            InputAge := Paths(i).InputChangeTime;
+        END LOOP;
+ 
+        -- If there were no paths (with an enabled condition),
+        -- use the default delay, if so indicated, otherwise return TIME'HIGH
+        IF (PropDelay = TIME'HIGH) THEN
+	  IF (IgnoreDefaultDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+	  END IF;
+	  
+	-- If the time since the most recent selected input event is
+	-- greater than the propagation delay from that input,
+	-- then use the default delay (won't happen if no paths are selected)
+        ELSIF (InputAge > PropDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- Adjust the propagation delay by the time since the
+        -- the input event occurred  (Usually 0 ns).
+        ELSE
+            PropDelay := PropDelay - InputAge;
+        END IF;
+ 
+        RETURN PropDelay;
+    END;
+ 
+    FUNCTION VitalSelectPathDelay (
+            CONSTANT NewValue           : IN  std_logic;
+            CONSTANT OldValue           : IN  std_logic;
+            CONSTANT OutSignalName      : IN  string;
+            CONSTANT Paths              : IN  VitalPathArray01ZType;
+            CONSTANT DefaultDelay       : IN  VitalDelayType01Z;
+    	    CONSTANT IgnoreDefaultDelay : IN  BOOLEAN
+          ) RETURN TIME IS
+ 
+        VARIABLE TmpDelay  : TIME;
+        VARIABLE InputAge  : TIME := TIME'HIGH;
+        VARIABLE PropDelay : TIME := TIME'HIGH;
+    BEGIN
+        -- for each delay path
+        FOR i IN Paths'RANGE LOOP
+            -- ignore the delay path if it is not enabled
+            NEXT WHEN NOT Paths(i).PathCondition;
+            -- ignore the delay path if a more recent input event has been seen
+            NEXT WHEN Paths(i).InputChangeTime > InputAge;
+ 
+            -- This is the most recent input change (so far)
+            -- Get the transition dependent delay
+            TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay);
+ 
+            -- If other inputs changed at the same time,
+            -- then use the minimum of their propagation delays,
+            -- else use the propagation delay from this input.
+            IF Paths(i).InputChangeTime < InputAge THEN
+                PropDelay := TmpDelay;
+            ELSE -- Simultaneous inputs change
+                IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF;
+            end if;
+ 
+            InputAge := Paths(i).InputChangeTime;
+        END LOOP;
+ 
+        -- If there were no paths (with an enabled condition),
+        -- use the default delay, if so indicated, otherwise return TIME'HIGH
+        IF (PropDelay = TIME'HIGH) THEN
+	  IF (IgnoreDefaultDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+	  END IF;
+	  
+	-- If the time since the most recent selected input event is
+	-- greater than the propagation delay from that input,
+	-- then use the default delay (won't happen if no paths are selected)
+        ELSIF (InputAge > PropDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- Adjust the propagation delay by the time since the
+        -- the input event occurred  (Usually 0 ns).
+        ELSE
+            PropDelay := PropDelay - InputAge;
+        END IF;
+ 
+        RETURN PropDelay;
+    END;
+ 
+
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    -- Glitch Handlers
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    PROCEDURE ReportGlitch ( 
+            CONSTANT GlitchRoutine  : IN  STRING;
+            CONSTANT OutSignalName  : IN  STRING;
+            CONSTANT PreemptedTime  : IN  TIME;
+            CONSTANT PreemptedValue : IN  std_ulogic;
+            CONSTANT NewTime        : IN  TIME;
+            CONSTANT NewValue       : IN  std_ulogic;
+            CONSTANT Index          : IN  INTEGER := 0;
+            CONSTANT IsArraySignal  : IN  BOOLEAN := FALSE;
+            CONSTANT MsgSeverity    : IN  SEVERITY_LEVEL := WARNING
+    ) IS
+
+        VARIABLE StrPtr1, StrPtr2, StrPtr3, StrPtr4, StrPtr5 : LINE;
+    BEGIN
+
+        Write (StrPtr1, PreemptedTime );
+        Write (StrPtr2, NewTime);
+        Write (StrPtr3, LogicCvtTable(PreemptedValue));
+        Write (StrPtr4, LogicCvtTable(NewValue));
+        IF IsArraySignal THEN
+            Write (StrPtr5, STRING'( "(" ) );
+            Write (StrPtr5, Index);
+            Write (StrPtr5, STRING'( ")" ) );
+        ELSE
+            Write (StrPtr5, STRING'( " " ) );
+        END IF;
+
+        -- Issue Report only if Preempted value has not been
+        --  removed from event queue
+        ASSERT PreemptedTime >  NewTime
+          REPORT GlitchRoutine & ": GLITCH Detected on port " & 
+                 OutSignalName & StrPtr5.ALL &
+                 "; Preempted Future Value := " & StrPtr3.ALL &
+                 " @ " & StrPtr1.ALL &
+                 "; Newly Scheduled Value := " & StrPtr4.ALL &
+                 " @ " & StrPtr2.ALL &
+                 ";"
+          SEVERITY MsgSeverity;
+          	
+
+  ASSERT PreemptedTime <= NewTime
+          REPORT GlitchRoutine & ": GLITCH Detected on port " & 
+                 OutSignalName & StrPtr5.ALL &
+                 "; Negative Preempted Value := " & StrPtr3.ALL &
+                 " @ " & StrPtr1.ALL &
+                 "; Newly Scheduled Value := " & StrPtr4.ALL &
+                 " @ " & StrPtr2.ALL &
+                 ";"
+          SEVERITY MsgSeverity;
+
+
+        DEALLOCATE(StrPtr1);
+        DEALLOCATE(StrPtr2);
+        DEALLOCATE(StrPtr3);
+        DEALLOCATE(StrPtr4); 
+        DEALLOCATE(StrPtr5); 
+        RETURN;
+    END ReportGlitch;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalGlitch (
+        SIGNAL   OutSignal     : OUT   std_logic;
+        VARIABLE GlitchData    : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName : IN    string;
+        CONSTANT NewValue      : IN    std_logic;
+        CONSTANT NewDelay      : IN    TIME           := 0 ns;
+        CONSTANT Mode          : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn           : IN    BOOLEAN        := TRUE;
+        CONSTANT NegPreemptOn  : IN    BOOLEAN        := FALSE;	 --IR225
+        CONSTANT MsgOn         : IN    BOOLEAN        := FALSE;
+        CONSTANT MsgSeverity   : IN    SEVERITY_LEVEL := WARNING
+        ) IS
+    ---------------------------------------------------------------------------
+        VARIABLE NewGlitch : BOOLEAN := TRUE;
+        VARIABLE dly       : TIME    := NewDelay;
+        VARIABLE NOW_TIME  : TIME    := NOW;
+        VARIABLE NegPreemptGlitch : BOOLEAN := FALSE;
+        	
+    BEGIN
+      NegPreemptGlitch:=FALSE;--reset Preempt-Glitch 
+ 
+        -- If nothing to schedule, just return
+        IF NewDelay < 0 ns THEN
+            IF (NewValue /= GlitchData.SchedValue) THEN
+                VitalError ( "VitalGlitch", ErrNegDel, OutSignalName );
+            END IF;
+            RETURN;
+        END IF;
+ 
+        -- If simple signal assignment
+        --   perform the signal assignment
+        IF    ( Mode = VitalInertial) THEN
+            OutSignal <= NewValue AFTER dly;
+        ELSIF ( Mode = VitalTransport ) THEN
+            OutSignal <= TRANSPORT NewValue AFTER dly;
+        ELSE
+          -- Glitch Processing ---
+          -- If nothing currently scheduled
+          IF GlitchData.SchedTime <= NOW THEN		  -- NOW >= last event
+            -- Note: NewValue is always /= OldValue when called from VPPD
+            IF (NewValue = GlitchData.SchedValue) THEN RETURN; END IF;
+  		  NewGlitch := FALSE;
+          GlitchData.GlitchTime := NOW+dly;
+     
+          -- New value earlier than the earliest previous value scheduled
+          --  (negative preemptive)
+          ELSIF (NOW+dly <= GlitchData.GlitchTime)
+             AND (NOW+dly <= GlitchData.SchedTime)  THEN
+      
+            -- Glitch is negative preemptive - check if same value and
+            -- NegPreempt is on IR225 
+            IF (GlitchData.SchedValue /= NewValue) AND (NegPreemptOn) AND
+               (NOW > 0 NS) THEN
+              NewGlitch := TRUE;
+              NegPreemptGlitch :=TRUE;	-- Set preempt Glitch condition
+            ELSE 
+              NewGlitch := FALSE;    	-- No new glitch, save time for
+                                        -- possible future glitch
+            END IF;
+            GlitchData.GlitchTime := NOW+dly;
+                  
+            -- Transaction currently scheduled - if glitch already happened
+            ELSIF GlitchData.GlitchTime <= NOW THEN
+               IF (GlitchData.SchedValue = NewValue) THEN
+                   dly := Minimum( GlitchData.SchedTime-NOW, NewDelay );
+               END IF;
+               NewGlitch := FALSE;
+     
+            -- Transaction currently scheduled (no glitch if same value)
+            ELSIF (GlitchData.SchedValue = NewValue)
+                  AND (GlitchData.SchedTime = GlitchData.GlitchTime) THEN
+                -- revise scheduled output time if new delay is sooner
+                dly := Minimum( GlitchData.SchedTime-NOW, NewDelay );
+                -- No new glitch, save time for possable future glitch
+                NewGlitch := FALSE;
+                GlitchData.GlitchTime := NOW+dly;
+
+            -- Transaction currently scheduled represents a glitch
+            ELSE
+              NewGlitch := TRUE; -- A new glitch has been detected
+            END IF;
+     
+            IF NewGlitch THEN
+              -- If  messages requested, report the glitch
+              IF MsgOn THEN 
+                IF NegPreemptGlitch THEN	  --IR225
+                  ReportGlitch ("VitalGlitch-Neg", OutSignalName,
+                                 GlitchData.GlitchTime, GlitchData.SchedValue,
+                                 (dly + NOW), NewValue,
+                                 MsgSeverity=>MsgSeverity  );
+                ELSE
+	              ReportGlitch ("VitalGlitch", OutSignalName,
+                                 GlitchData.GlitchTime, GlitchData.SchedValue,
+                                 (dly + NOW), NewValue,
+                                 MsgSeverity=>MsgSeverity  );
+		        END IF;
+	        END IF;
+              
+            -- If 'X' generation is requested, schedule the new value 
+            --  preceeded by a glitch pulse.
+            -- Otherwise just schedule the new value (inertial mode).
+            IF XOn THEN 
+              IF (Mode = OnDetect) THEN
+                OutSignal <= 'X';
+              ELSE
+                OutSignal <= 'X' AFTER GlitchData.GlitchTime-NOW;
+            END IF;
+		                             	
+            IF NegPreemptGlitch THEN -- IR225
+               OutSignal <= TRANSPORT NewValue AFTER GlitchData.SchedTime-NOW;	
+            ELSE
+              OutSignal <= TRANSPORT NewValue AFTER dly;    
+            END IF; 
+            ELSE
+              OutSignal <= NewValue AFTER dly; -- no glitch regular prop delay
+            END IF;
+     
+            -- If there no new glitch was detected, just schedule the new value.
+            ELSE
+              OutSignal <= NewValue AFTER dly;
+            END IF;
+        END IF;
+ 
+       -- Record the new value and time depending on glitch type just scheduled.
+       IF NOT NegPreemptGlitch THEN -- 5/2/96 for "x-pulse" IR225
+          GlitchData.SchedValue := NewValue; 
+          GlitchData.SchedTime  := NOW+dly;	   -- pulse timing.
+	   ELSE
+         GlitchData.SchedValue := 'X';
+         -- leave GlitchData.SchedTime to old value since glitch is negative
+       END IF;
+      RETURN;
+    END;
+ 
+    ---------------------------------------------------------------------------
+   PROCEDURE VitalPathDelay (
+        SIGNAL   OutSignal          : OUT   std_logic;
+        VARIABLE GlitchData         : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName      : IN    string;
+        CONSTANT OutTemp            : IN    std_logic;
+        CONSTANT Paths              : IN    VitalPathArrayType;
+        CONSTANT DefaultDelay       : IN    VitalDelayType      := VitalZeroDelay;
+        CONSTANT Mode               : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn                : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn              : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity        : IN    SEVERITY_LEVEL      := WARNING;
+        CONSTANT NegPreemptOn       : IN    BOOLEAN             := FALSE;	--IR225	3/14/98
+        CONSTANT IgnoreDefaultDelay : IN    BOOLEAN             := FALSE        --IR248 3/14/98
+    ) IS
+ 
+        VARIABLE PropDelay : TIME;
+    
+    BEGIN
+        -- Check if the new value to be scheduled is different than the
+        -- previously scheduled value
+        IF (GlitchData.SchedTime <= NOW) AND
+           (GlitchData.SchedValue = OutTemp)
+             THEN RETURN;
+        END IF;
+ 
+        -- Evaluate propagation delay paths
+        PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue,
+                                           OutSignalName, Paths, DefaultDelay,
+	                    				   IgnoreDefaultDelay);
+
+        GlitchData.LastValue := OutTemp;
+ 
+        -- Schedule the output transactions - including glitch handling
+        VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp,
+                     PropDelay, Mode, XOn, NegPreemptOn, MsgOn, MsgSeverity );
+ 
+    END VitalPathDelay;
+
+    ---------------------------------------------------------------------------
+
+    PROCEDURE VitalPathDelay01 (
+        SIGNAL   OutSignal          : OUT   std_logic;
+        VARIABLE GlitchData         : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName      : IN    string;
+        CONSTANT OutTemp            : IN    std_logic;
+        CONSTANT Paths              : IN    VitalPathArray01Type;
+        CONSTANT DefaultDelay       : IN    VitalDelayType01    := VitalZeroDelay01;
+        CONSTANT Mode               : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn                : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn              : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity        : IN    SEVERITY_LEVEL      := WARNING;
+        CONSTANT NegPreemptOn       : IN    BOOLEAN             := FALSE;	--IR225	3/14/98
+        CONSTANT IgnoreDefaultDelay : IN    BOOLEAN             := FALSE;       --IR248 3/14/98
+        CONSTANT RejectFastPath     : IN    BOOLEAN             := FALSE        --IR250
+ 
+ 
+    ) IS
+ 
+        VARIABLE PropDelay : TIME;
+    BEGIN
+    	
+        -- Check if the new value to be scheduled is different than the
+        -- previously scheduled value
+        IF (GlitchData.SchedTime <= NOW) AND
+           (GlitchData.SchedValue = OutTemp)
+             THEN RETURN;
+        -- Check if the new value to be Scheduled is the same as the
+        -- previously scheduled output transactions.  If this condition
+        -- exists and the new scheduled time is < the current GlitchData.
+        -- schedTime then a fast path condition exists (IR250).  If the 
+        -- modeler wants this condition rejected by setting the 
+        -- RejectFastPath actual to true then exit out.  
+        ELSIF (GlitchData.SchedValue=OutTemp)  AND (RejectFastPath)
+             THEN RETURN;
+        END IF;
+ 
+        -- Evaluate propagation delay paths
+        PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue,
+                                           OutSignalName, Paths, DefaultDelay,
+	                    				   IgnoreDefaultDelay);
+
+        GlitchData.LastValue := OutTemp;
+
+
+        VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp,
+                     PropDelay, Mode, XOn, NegPreemptOn, MsgOn, MsgSeverity );
+    END VitalPathDelay01;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalPathDelay01Z (
+        SIGNAL   OutSignal          : OUT   std_logic;
+        VARIABLE GlitchData         : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName      : IN    string;
+        CONSTANT OutTemp            : IN    std_logic;
+        CONSTANT Paths              : IN    VitalPathArray01ZType;
+        CONSTANT DefaultDelay       : IN    VitalDelayType01Z   := VitalZeroDelay01Z;
+        CONSTANT Mode               : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn                : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn              : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity        : IN    SEVERITY_LEVEL      := WARNING;
+        CONSTANT OutputMap          : IN    VitalOutputMapType	:= VitalDefaultOutputMap;
+        CONSTANT NegPreemptOn       : IN    BOOLEAN             := FALSE;	--IR225	3/14/98
+        CONSTANT IgnoreDefaultDelay : IN    BOOLEAN             := FALSE;       --IR248 3/14/98
+        CONSTANT RejectFastPath     : IN    BOOLEAN             := FALSE        --IR250
+     ) IS
+ 
+        VARIABLE PropDelay : TIME;
+  
+    BEGIN
+       -- Check if the new value to be scheduled is different than the
+       -- previously scheduled value
+        IF (GlitchData.SchedTime <= NOW) AND
+           (GlitchData.SchedValue = OutTemp)
+             THEN RETURN;
+       -- Check if the new value to be Scheduled is the same as the
+       -- previously scheduled output transactions.  If this condition
+       -- exists and the new scheduled time is < the current GlitchData.
+       -- schedTime then a fast path condition exists (IR250).  If the 
+       -- modeler wants this condition rejected by setting the 
+       -- RejectFastPath actual to true then exit out.  
+        ELSIF (GlitchData.SchedValue=OutTemp)  AND (RejectFastPath)
+             THEN RETURN;
+        END IF;
+     	
+        -- Evaluate propagation delay paths
+        PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue,
+                                           OutSignalName, Paths, DefaultDelay,
+	                    				   IgnoreDefaultDelay);
+
+        GlitchData.LastValue := OutTemp;
+			
+
+        -- Schedule the output transactions - including glitch handling
+          VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp,
+                     PropDelay, Mode, XOn, NegPreemptOn, MsgOn, MsgSeverity );
+    END VitalPathDelay01Z;
+
+
+    ----------------------------------------------------------------------------
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig  : OUT   std_ulogic;
+            SIGNAL   InSig   : IN    std_ulogic;
+            CONSTANT twire   : IN    VitalDelayType
+    ) IS
+    BEGIN
+        OutSig <= TRANSPORT InSig AFTER twire;
+    END VitalWireDelay;    
+
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig  : OUT   std_ulogic;
+            SIGNAL   InSig   : IN    std_ulogic;
+            CONSTANT twire   : IN    VitalDelayType01
+    ) IS
+       VARIABLE Delay   : TIME;
+    BEGIN
+        Delay := VitalCalcDelay( InSig, InSig'LAST_VALUE, twire );
+        OutSig <= TRANSPORT InSig AFTER Delay;
+    END VitalWireDelay;    
+
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig  : OUT   std_ulogic;
+            SIGNAL   InSig   : IN    std_ulogic;
+            CONSTANT twire   : IN    VitalDelayType01Z
+    ) IS
+       VARIABLE Delay   : TIME;
+    BEGIN
+        Delay := VitalCalcDelay( InSig, InSig'LAST_VALUE, twire );
+        OutSig <= TRANSPORT InSig AFTER Delay;
+    END VitalWireDelay;    
+
+    ----------------------------------------------------------------------------
+    PROCEDURE VitalSignalDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT dly        : IN   TIME
+    ) IS
+    BEGIN
+        OutSig <= TRANSPORT InSig AFTER dly;
+    END;
+
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    -- Setup and Hold Time Check Routine 
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    PROCEDURE ReportViolation (
+            CONSTANT TestSignalName : IN STRING := "";
+            CONSTANT RefSignalName  : IN STRING := "";
+            CONSTANT HeaderMsg      : IN STRING := " ";
+            CONSTANT CheckInfo      : IN CheckInfoType;
+            CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+    ) IS
+        VARIABLE Message : LINE;
+    BEGIN
+        IF NOT CheckInfo.Violation THEN RETURN; END IF;
+
+        Write ( Message, HeaderMsg );
+        Case CheckInfo.CheckKind IS
+          WHEN    SetupCheck => Write ( Message, STRING'(" SETUP ")      );
+          WHEN     HoldCheck => Write ( Message, STRING'(" HOLD ")       );
+          WHEN RecoveryCheck => Write ( Message, STRING'(" RECOVERY ")   );
+          WHEN  RemovalCheck => Write ( Message, STRING'(" REMOVAL ")    );
+          WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH "));
+          WHEN   PeriodCheck => Write ( Message, STRING'(" PERIOD ")     );
+        END CASE;
+        Write ( Message, HiLoStr(CheckInfo.State) );
+        Write ( Message, STRING'(" VIOLATION ON ") );
+        Write ( Message, TestSignalName );
+        IF (RefSignalName'LENGTH > 0) THEN
+            Write ( Message, STRING'(" WITH RESPECT TO ") );
+            Write ( Message, RefSignalName );
+        END IF;
+        Write ( Message, ';' & LF );
+        Write ( Message, STRING'("  Expected := ")  );
+        Write ( Message, CheckInfo.ExpTime);
+        Write ( Message, STRING'("; Observed := ")  );
+        Write ( Message, CheckInfo.ObsTime);
+        Write ( Message, STRING'("; At : ")         );
+        Write ( Message, CheckInfo.DetTime);
+
+        ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity;
+
+        DEALLOCATE (Message);
+    END ReportViolation;
+
+  
+    ---------------------------------------------------------------------------
+    -- Procedure  : InternalTimingCheck
+    ---------------------------------------------------------------------------
+    PROCEDURE InternalTimingCheck (
+            CONSTANT TestSignal    : IN     std_ulogic;
+            CONSTANT RefSignal     : IN     std_ulogic;
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            VARIABLE RefTime       : IN     TIME;
+            VARIABLE RefEdge       : IN     BOOLEAN;
+            VARIABLE TestTime      : IN     TIME;
+            VARIABLE TestEvent     : IN     BOOLEAN;
+            VARIABLE SetupEn       : INOUT  BOOLEAN;
+            VARIABLE HoldEn        : INOUT  BOOLEAN;
+            VARIABLE CheckInfo     : INOUT  CheckInfoType;
+            CONSTANT MsgOn         : IN     BOOLEAN
+    ) IS
+        VARIABLE bias : TIME;
+	VARIABLE actualObsTime : TIME;
+        VARIABLE BC : TIME;
+	VARIABLE Message:LINE;
+    BEGIN
+        -- Check SETUP constraint
+      IF RefEdge THEN
+          IF SetupEn THEN
+            CheckInfo.ObsTime   := RefTime - TestTime;
+            CheckInfo.State     := To_X01(TestSignal);
+            CASE CheckInfo.State IS
+              WHEN '0' => CheckInfo.ExpTime := SetupLow;
+			  -- start of new code IR245-246
+				BC := HoldHigh;
+			  -- end of new code IR245-246
+              WHEN '1' => CheckInfo.ExpTime := SetupHigh;
+			  -- start of new code IR245-246
+				BC := HoldLow;
+			  -- end of new code IR245-246
+              WHEN 'X' => CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow);
+			  -- start of new code IR245-246
+				BC := Maximum(HoldHigh,HoldLow);
+			  -- end of new code IR245-246
+            END CASE;
+			-- added the second condition for IR 245-246
+			CheckInfo.Violation := ( (CheckInfo.ObsTime < CheckInfo.ExpTime) 
+				AND ( NOT ((CheckInfo.ObsTime = BC) and (BC = 0 ns))) );
+			-- start of new code IR245-246
+			IF(CheckInfo.ExpTime = 0 ns) THEN
+				CheckInfo.CheckKind := HoldCheck;
+			ELSE
+				CheckInfo.CheckKind := SetupCheck;
+			END IF;
+			-- end of new code IR245-246
+			SetupEn  := FALSE;
+          ELSE
+            CheckInfo.Violation := FALSE;
+          END IF;
+  
+        -- Check HOLD constraint
+      ELSIF TestEvent THEN
+          IF HoldEn THEN
+            CheckInfo.ObsTime := TestTime - RefTime;
+            CheckInfo.State := To_X01(TestSignal);
+            CASE CheckInfo.State IS
+              WHEN '0' => CheckInfo.ExpTime := HoldHigh;
+
+			  -- new code for unnamed IR 
+			     CheckInfo.State := '1';
+
+			  -- start of new code IR245-246
+				BC := SetupLow;
+			  -- end of new code IR245-246
+              WHEN '1' => CheckInfo.ExpTime := HoldLow;
+
+			  -- new code for unnamed IR 
+			     CheckInfo.State := '0';
+
+			  -- start of new code IR245-246
+				BC := SetupHigh;
+			  -- end of new code IR245-246
+              WHEN 'X' => CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow);
+			  -- start of new code IR245-246
+				BC := Maximum(SetupHigh,SetupLow);
+			  -- end of new code IR245-246
+            END CASE;
+			-- added the second condition for IR 245-246
+			CheckInfo.Violation := ( (CheckInfo.ObsTime < CheckInfo.ExpTime) 
+				AND ( NOT ((CheckInfo.ObsTime = BC) and (BC = 0 ns))) );
+
+			-- start of new code IR245-246
+			IF(CheckInfo.ExpTime = 0 ns) THEN
+				CheckInfo.CheckKind := SetupCheck;
+			ELSE
+				CheckInfo.CheckKind := HoldCheck;
+			END IF;
+			-- end of new code IR245-246
+            HoldEn := NOT CheckInfo.Violation;
+          ELSE
+            CheckInfo.Violation := FALSE;
+          END IF;
+      ELSE
+          CheckInfo.Violation := FALSE;
+      END IF;
+
+      -- Adjust report values to account for internal model delays
+      -- Note: TestDelay, RefDelay, TestTime, RefTime are non-negative
+      -- Note: bias may be negative or positive
+      IF MsgOn AND CheckInfo.Violation THEN
+      -- modified the code for correct reporting of violation in case of 
+      -- order of signals being reversed because of internal delays
+	 -- new variable 
+	 actualObsTime := (TestTime-TestDelay)-(RefTime-RefDelay);
+	 bias := TestDelay - RefDelay;
+	 IF (actualObsTime < 0 ns) THEN -- It should be a setup check
+           IF ( CheckInfo.CheckKind = HoldCheck) then
+               CheckInfo.CheckKind := SetupCheck;
+               CASE CheckInfo.State IS
+                 WHEN '0' => CheckInfo.ExpTime := SetupLow; 
+                 WHEN '1' => CheckInfo.ExpTime := SetupHigh;
+                 WHEN 'X' => CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow);
+               END CASE;	       	  
+           END IF;
+
+	   CheckInfo.ObsTime := -actualObsTime;
+	   CheckInfo.ExpTime := CheckInfo.ExpTime + bias;
+	   CheckInfo.DetTime := RefTime - RefDelay;
+         ELSE -- It should be a hold check
+          IF ( CheckInfo.CheckKind = SetupCheck) then
+	    CheckInfo.CheckKind :=  HoldCheck;
+	    CASE CheckInfo.State IS
+	      WHEN '0' => CheckInfo.ExpTime := HoldHigh;
+			  CheckInfo.State   := '1';
+	      WHEN '1' => CheckInfo.ExpTime := HoldLow;
+			  CheckInfo.State   := '0';
+	      WHEN 'X' => CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow);
+	    END CASE;
+          END IF;
+
+	  CheckInfo.ObsTime := actualObsTime;
+	  CheckInfo.ExpTime := CheckInfo.ExpTime - bias;
+	  CheckInfo.DetTime := TestTime - TestDelay;
+	 END IF;
+
+      END IF;
+    END InternalTimingCheck;
+
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    FUNCTION VitalTimingDataInit 
+            RETURN VitalTimingDataType IS
+    BEGIN
+        RETURN (FALSE,'X', 0 ns, FALSE, 'X', 0 ns, FALSE, NULL, NULL, NULL, NULL);
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : VitalSetupHoldCheck
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalSetupHoldCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_ulogic;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING  := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+            CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+    	    CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE;  --IR252 3/23/98
+	        CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE	--IR252 3/23/98
+    ) IS 
+
+        VARIABLE CheckInfo : CheckInfoType;
+        VARIABLE RefEdge, TestEvent : BOOLEAN;
+        VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay);
+        VARIABLE RefDly  : TIME := Maximum(0 ns, RefDelay);
+        VARIABLE bias : TIME;
+    BEGIN
+
+      IF (TimingData.NotFirstFlag = FALSE) THEN
+         TimingData.TestLast := To_X01(TestSignal);
+         TimingData.RefLast := To_X01(RefSignal);
+         TimingData.NotFirstFlag := TRUE;
+      END IF;
+
+      -- Detect reference edges and record the time of the last edge
+      RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+                                 RefTransition);
+      TimingData.RefLast := To_X01(RefSignal);
+      IF RefEdge THEN
+        TimingData.RefTime := NOW;
+    	TimingData.SetupEn := TimingData.SetupEn AND EnableSetupOnRef;  --IR252 3/23/98
+        TimingData.HoldEn  := EnableHoldOnRef;						    --IR252 3/23/98
+      END IF;
+
+      -- Detect test (data) changes and record the time of the last change
+      TestEvent := TimingData.TestLast /= To_X01Z(TestSignal);
+      TimingData.TestLast := To_X01Z(TestSignal);
+      IF TestEvent THEN
+        TimingData.TestTime := NOW;
+        TimingData.SetupEn  := EnableSetupOnTest;						--IR252 3/23/98
+    	TimingData.HoldEn   := TimingData.HoldEn AND EnableHoldOnTest;	--IR252 3/23/98
+      END IF;
+
+      -- Perform timing checks (if enabled)
+      Violation := '0';
+      IF (CheckEnabled) THEN
+         InternalTimingCheck (
+             TestSignal   => TestSignal,
+             RefSignal    => RefSignal,
+             TestDelay    => TestDly,
+             RefDelay     => RefDly,
+             SetupHigh    => SetupHigh,
+             SetupLow     => SetupLow,
+             HoldHigh     => HoldHigh,
+             HoldLow      => HoldLow,
+             RefTime      => TimingData.RefTime,
+             RefEdge      => RefEdge,
+             TestTime     => TimingData.TestTime,
+             TestEvent    => TestEvent,
+             SetupEn      => TimingData.SetupEn,
+             HoldEn       => TimingData.HoldEn,
+             CheckInfo    => CheckInfo,
+             MsgOn        => MsgOn );
+
+        -- Report any detected violations and set return violation flag
+        IF CheckInfo.Violation THEN
+            IF (MsgOn) THEN
+                ReportViolation (TestSignalName, RefSignalName,
+                                 HeaderMsg, CheckInfo, MsgSeverity );
+            END IF;
+            IF (XOn) THEN Violation := 'X'; END IF;
+        END IF;
+      END IF;
+
+    END VitalSetupHoldCheck;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalSetupHoldCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_logic_vector;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+            CONSTANT EnableSetupOnTest : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableSetupOnRef  : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+    	    CONSTANT EnableHoldOnRef   : IN   BOOLEAN := TRUE;  --IR252 3/23/98
+	        CONSTANT EnableHoldOnTest  : IN   BOOLEAN := TRUE	--IR252 3/23/98
+
+    ) IS 
+
+        VARIABLE CheckInfo : CheckInfoType;
+        VARIABLE RefEdge : BOOLEAN;
+        VARIABLE TestEvent : VitalBoolArrayT(TestSignal'RANGE);
+        VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay);
+        VARIABLE RefDly  : TIME := Maximum(0 ns, RefDelay);
+        VARIABLE bias : TIME;
+        VARIABLE ChangedAllAtOnce : BOOLEAN := TRUE;
+        VARIABLE StrPtr1 : LINE;
+
+    BEGIN
+      -- Initialization of working area. 
+      IF (TimingData.NotFirstFlag = FALSE) THEN
+        TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE);
+        TimingData.TestTimeA := NEW  VitalTimeArrayT(TestSignal'RANGE);
+        TimingData.HoldEnA   := NEW  VitalBoolArrayT(TestSignal'RANGE);
+        TimingData.SetupEnA  := NEW  VitalBoolArrayT(TestSignal'RANGE);
+        FOR i IN TestSignal'RANGE LOOP
+          TimingData.TestLastA(i) := To_X01(TestSignal(i));
+        END LOOP;
+        TimingData.RefLast := To_X01(RefSignal);
+        TimingData.NotFirstFlag := TRUE;
+      END IF;
+
+      -- Detect reference edges and record the time of the last edge
+      RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+                                 RefTransition);
+      TimingData.RefLast := To_X01(RefSignal);
+      IF RefEdge THEN
+        TimingData.RefTime := NOW;
+    	TimingData.SetupEn := TimingData.SetupEn AND EnableSetupOnRef;		--IR252 3/23/98
+        TimingData.HoldEnA.all := (TestSignal'RANGE => EnableHoldOnRef);	--IR252 3/23/98
+      END IF;
+  
+      -- Detect test (data) changes and record the time of the last change
+      FOR i IN TestSignal'RANGE LOOP
+        TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i));
+        TimingData.TestLastA(i) := To_X01Z(TestSignal(i));
+        IF TestEvent(i) THEN 
+          TimingData.TestTimeA(i) := NOW;
+          TimingData.SetupEnA(i) := EnableSetupOnTest;				--IR252 3/23/98
+  	      TimingData.HoldEnA(i) := TimingData.HoldEn AND EnableHoldOnTest;	--IR252 3/23/98
+          TimingData.TestTime := NOW;	                                	--IR252 3/23/98	 
+        END IF;
+      END LOOP;
+
+      -- Check to see if the Bus subelements changed all at the same time.
+      -- If so, then we can reduce the volume of error messages since we no
+      -- longer have to report every subelement individually
+      FOR i IN TestSignal'RANGE LOOP
+        IF TimingData.TestTimeA(i) /= TimingData.TestTime THEN
+            ChangedAllAtOnce := FALSE;
+            EXIT;
+        END IF;
+      END LOOP;
+  
+      -- Perform timing checks (if enabled)
+      Violation := '0';
+      IF (CheckEnabled) THEN
+        FOR i IN TestSignal'RANGE LOOP
+          InternalTimingCheck (
+              TestSignal   => TestSignal(i),
+              RefSignal    => RefSignal,
+              TestDelay    => TestDly,
+              RefDelay     => RefDly,
+              SetupHigh    => SetupHigh,
+              SetupLow     => SetupLow,
+              HoldHigh     => HoldHigh,
+              HoldLow      => HoldLow,
+              RefTime      => TimingData.RefTime,
+              RefEdge      => RefEdge,
+              TestTime     => TimingData.TestTimeA(i),
+              TestEvent    => TestEvent(i),
+              SetupEn      => TimingData.SetupEnA(i),
+              HoldEn       => TimingData.HoldEnA(i),
+              CheckInfo    => CheckInfo,
+              MsgOn        => MsgOn );
+
+          -- Report any detected violations and set return violation flag
+          IF CheckInfo.Violation THEN
+            IF (MsgOn) THEN
+              IF ( ChangedAllAtOnce AND (i = TestSignal'LEFT) ) THEN
+                ReportViolation (TestSignalName&"(...)", RefSignalName,
+                                 HeaderMsg, CheckInfo, MsgSeverity );
+              ELSIF (NOT ChangedAllAtOnce) THEN
+                Write (StrPtr1, i);
+                ReportViolation (TestSignalName & "(" & StrPtr1.ALL & ")", 
+                                 RefSignalName,
+                                 HeaderMsg, CheckInfo, MsgSeverity );
+                DEALLOCATE (StrPtr1);
+              END IF;
+            END IF;
+            IF (XOn) THEN
+              Violation := 'X';
+            END IF;
+          END IF;
+        END LOOP;
+      END IF;
+
+      DEALLOCATE (StrPtr1);
+
+    END VitalSetupHoldCheck;
+    
+    ---------------------------------------------------------------------------
+    -- Function   : VitalRecoveryRemovalCheck
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalRecoveryRemovalCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_ulogic;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT Recovery      : IN     TIME := 0 ns;
+            CONSTANT Removal       : IN     TIME := 0 ns;
+            CONSTANT ActiveLow     : IN     BOOLEAN := TRUE;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+    	    CONSTANT EnableRecOnTest : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableRecOnRef  : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableRemOnRef  : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableRemOnTest : IN   BOOLEAN := TRUE		--IR252 3/23/98
+        ) IS
+        VARIABLE CheckInfo : CheckInfoType;
+        VARIABLE RefEdge, TestEvent : BOOLEAN;
+        VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay);
+        VARIABLE RefDly  : TIME := Maximum(0 ns, RefDelay);
+        VARIABLE bias : TIME;
+    BEGIN
+ 
+      IF (TimingData.NotFirstFlag = FALSE) THEN
+         TimingData.TestLast := To_X01(TestSignal);
+         TimingData.RefLast := To_X01(RefSignal);
+         TimingData.NotFirstFlag := TRUE;
+      END IF;
+
+      -- Detect reference edges and record the time of the last edge
+      RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+                                 RefTransition);
+      TimingData.RefLast := To_X01(RefSignal);
+      IF RefEdge THEN
+        TimingData.RefTime := NOW;
+    	TimingData.SetupEn := TimingData.SetupEn AND EnableRecOnRef;	  --IR252 3/23/98
+        TimingData.HoldEn  := EnableRemOnRef;							  --IR252 3/23/98
+      END IF;
+ 
+      -- Detect test (data) changes and record the time of the last change
+      TestEvent := TimingData.TestLast /= To_X01Z(TestSignal);
+      TimingData.TestLast := To_X01Z(TestSignal);
+      IF TestEvent THEN
+        TimingData.TestTime := NOW;
+        TimingData.SetupEn  := EnableRecOnTest;							  --IR252 3/23/98
+    	TimingData.HoldEn   := TimingData.HoldEn AND EnableRemOnTest;	  --IR252 3/23/98
+      END IF;
+ 
+      -- Perform timing checks (if enabled)
+      Violation := '0';
+      IF (CheckEnabled) THEN
+
+        IF ActiveLow THEN
+         InternalTimingCheck (
+             TestSignal, RefSignal, TestDly, RefDly,
+             Recovery, 0 ns, 0 ns, Removal,
+             TimingData.RefTime, RefEdge,
+             TimingData.TestTime, TestEvent,
+             TimingData.SetupEn, TimingData.HoldEn,
+             CheckInfo, MsgOn );
+        ELSE 
+         InternalTimingCheck (
+             TestSignal, RefSignal, TestDly, RefDly,
+             0 ns, Recovery, Removal, 0 ns,
+             TimingData.RefTime, RefEdge,
+             TimingData.TestTime, TestEvent,
+             TimingData.SetupEn, TimingData.HoldEn,
+             CheckInfo, MsgOn );
+        END IF;
+
+ 
+        -- Report any detected violations and set return violation flag
+        IF CheckInfo.Violation THEN
+            IF CheckInfo.CheckKind = SetupCheck THEN
+                CheckInfo.CheckKind := RecoveryCheck;
+            ELSE
+                CheckInfo.CheckKind := RemovalCheck;
+            END IF;
+            IF (MsgOn) THEN
+                ReportViolation (TestSignalName, RefSignalName, 
+                                 HeaderMsg, CheckInfo, MsgSeverity );
+            END IF;
+            IF (XOn) THEN Violation := 'X'; END IF;
+        END IF;
+      END IF;
+
+    END VitalRecoveryRemovalCheck;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalPeriodPulseCheck  (
+            VARIABLE Violation      : OUT    X01;
+            VARIABLE PeriodData     : INOUT  VitalPeriodDataType;
+            SIGNAL   TestSignal     : IN     std_ulogic;
+            CONSTANT TestSignalName : IN     STRING := "";
+            CONSTANT TestDelay      : IN     TIME := 0 ns;
+            CONSTANT Period         : IN     TIME := 0 ns;
+            CONSTANT PulseWidthHigh : IN     TIME := 0 ns;
+            CONSTANT PulseWidthLow  : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled   : IN     BOOLEAN := TRUE;
+            CONSTANT HeaderMsg      : IN     STRING := " ";
+            CONSTANT XOn            : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn          : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity    : IN     SEVERITY_LEVEL := WARNING
+    ) IS 
+
+        VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay);
+        VARIABLE CheckInfo : CheckInfoType;
+        VARIABLE PeriodObs : TIME;
+        VARIABLE PulseTest, PeriodTest : BOOLEAN;
+        VARIABLE TestValue : X01 := To_X01(TestSignal);
+    BEGIN
+
+        IF (PeriodData.NotFirstFlag = FALSE) THEN
+           PeriodData.Rise :=
+                -maximum(Period, maximum(PulseWidthHigh, PulseWidthLow));
+           PeriodData.Fall :=
+                -maximum(Period, maximum(PulseWidthHigh, PulseWidthLow));
+           PeriodData.Last := To_X01(TestSignal);
+           PeriodData.NotFirstFlag := TRUE;
+        END IF;
+
+        -- Initialize for no violation
+        -- No violation possible if no test signal change
+        Violation := '0';
+        IF (PeriodData.Last = TestValue) THEN
+            RETURN;
+        END IF;
+
+        -- record starting pulse times
+        IF EdgeSymbolMatch(PeriodData.Last, TestValue, 'P') THEN
+            -- Compute period times, then record the High Rise Time
+            PeriodObs := NOW - PeriodData.Rise;
+            PeriodData.Rise := NOW;
+            PeriodTest := TRUE;
+        ELSIF EdgeSymbolMatch(PeriodData.Last, TestValue, 'N') THEN
+            -- Compute period times, then record the Low Fall Time
+            PeriodObs := NOW - PeriodData.Fall;
+            PeriodData.Fall := NOW;
+            PeriodTest := TRUE;
+        ELSE
+            PeriodTest := FALSE;
+	END IF;
+
+        -- do checks on pulse ends
+        IF EdgeSymbolMatch(PeriodData.Last, TestValue, 'p') THEN
+            -- Compute pulse times
+            CheckInfo.ObsTime := NOW - PeriodData.Fall;
+            CheckInfo.ExpTime := PulseWidthLow;
+            PulseTest := TRUE;
+        ELSIF EdgeSymbolMatch(PeriodData.Last, TestValue, 'n') THEN
+            -- Compute pulse times
+            CheckInfo.ObsTime := NOW - PeriodData.Rise;
+            CheckInfo.ExpTime := PulseWidthHigh;
+            PulseTest := TRUE;
+        ELSE
+            PulseTest := FALSE;
+        END IF;
+
+        IF PulseTest AND CheckEnabled THEN
+           -- Verify Pulse Width [ignore 1st edge]
+            IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN
+                IF (XOn) THEN Violation := 'X'; END IF;
+                IF (MsgOn) THEN
+                    CheckInfo.Violation := TRUE;
+                    CheckInfo.CheckKind := PulseWidCheck;
+                    CheckInfo.DetTime   := NOW - TestDly;
+                    CheckInfo.State     := PeriodData.Last;
+                    ReportViolation (TestSignalName, "", 
+                                     HeaderMsg, CheckInfo, MsgSeverity );
+                END IF; -- MsgOn
+            END IF;
+        END IF;
+
+        IF PeriodTest AND CheckEnabled THEN
+            -- Verify the Period [ignore 1st edge]
+            CheckInfo.ObsTime := PeriodObs;
+            CheckInfo.ExpTime := Period;
+            IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN
+                IF (XOn) THEN Violation := 'X'; END IF;
+                IF (MsgOn) THEN
+                    CheckInfo.Violation := TRUE;
+                    CheckInfo.CheckKind := PeriodCheck;
+                    CheckInfo.DetTime   := NOW - TestDly;
+                    CheckInfo.State     := TestValue;
+                    ReportViolation (TestSignalName, "",
+                                     HeaderMsg, CheckInfo, MsgSeverity );
+                END IF; -- MsgOn
+            END IF;
+        END IF;
+
+        PeriodData.Last := TestValue;
+
+    END VitalPeriodPulseCheck;
+
+
+ 
+    PROCEDURE ReportSkewViolation (
+        CONSTANT Signal1Name    : IN STRING := "";
+        CONSTANT Signal2Name    : IN STRING := "";
+        CONSTANT ExpectedTime   : IN TIME;
+        CONSTANT OccuranceTime  : IN TIME;
+        CONSTANT HeaderMsg      : IN STRING;
+        CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING;
+        CONSTANT SkewPhase      : IN SkewType;
+        CONSTANT ViolationFlag 	: IN BOOLEAN := TRUE
+    ) IS
+        VARIABLE Message : LINE;
+    BEGIN
+        Write ( Message, HeaderMsg );
+        IF (ViolationFlag /= TRUE) THEN
+          Write ( Message, STRING'(" POSSIBLE") );
+        END IF;
+        IF (SkewPhase = Inphase) THEN
+          Write ( Message, STRING'(" IN PHASE ")      ); 
+        ELSE
+          Write ( Message, STRING'(" OUT OF PHASE ")      );
+        END IF;
+        Write ( Message, STRING'("SKEW VIOLATION ON ")      );
+        Write ( Message, Signal2Name );
+        IF (Signal1Name'LENGTH > 0) THEN
+            Write ( Message, STRING'(" WITH RESPECT TO ") );
+            Write ( Message, Signal1Name );
+        END IF;
+        Write ( Message, ';' & LF );
+        Write ( Message, STRING'(" At : ")         );
+        Write ( Message, OccuranceTime);
+        Write ( Message, STRING'("; Skew Limit : ")  );
+        Write ( Message, ExpectedTime);
+ 
+        ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity;
+ 
+        DEALLOCATE (Message);
+    END ReportSkewViolation;
+ 
+ 
+    PROCEDURE VitalInPhaseSkewCheck (
+        VARIABLE Violation         : OUT    X01;
+        VARIABLE SkewData          : INOUT  VitalSkewDataType;
+        SIGNAL   Signal1           : IN     std_ulogic;
+        CONSTANT Signal1Name       : IN     STRING := "";
+        CONSTANT Signal1Delay      : IN     TIME := 0 ns;
+        SIGNAL   Signal2           : IN     std_ulogic;
+        CONSTANT Signal2Name       : IN     STRING := "";
+        CONSTANT Signal2Delay      : IN     TIME := 0 ns;
+        CONSTANT SkewS1S2RiseRise  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS2S1RiseRise  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS1S2FallFall  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS2S1FallFall  : IN     TIME := TIME'HIGH;
+        CONSTANT CheckEnabled      : IN     BOOLEAN := TRUE;
+        CONSTANT XOn               : IN     BOOLEAN := TRUE;
+        CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+        CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+        CONSTANT HeaderMsg         : IN     STRING  := "";
+        SIGNAL   Trigger           : INOUT  std_ulogic
+    ) IS
+        VARIABLE ReportType  : VitalSkewExpectedType := none;
+        VARIABLE ExpectedType  : VitalSkewExpectedType := none;
+        VARIABLE ReportTime  : TIME;
+        VARIABLE TriggerDelay  : TIME;
+        VARIABLE ViolationCertain  : Boolean := TRUE;
+    BEGIN
+        Violation := '0';
+        ReportType := none;
+        TriggerDelay := noTrigger;
+
+        IF (CheckEnabled) THEN
+            IF (SkewData.ExpectedType /= none) THEN
+                IF (trigger'Event) THEN
+                    CASE SkewData.ExpectedType IS
+                    WHEN s1r => ReportType := s1r;
+                                ReportTime := NOW - Signal1Delay;
+                    WHEN s1f => ReportType := s1f;
+                                ReportTime := NOW - Signal1Delay;
+                    WHEN s2r => ReportType := s2r;
+                                ReportTime := NOW - Signal2Delay;
+                    WHEN s2f => ReportType := s2f;
+                                ReportTime := NOW - Signal2Delay;
+                    WHEN OTHERS =>
+                    END CASE;
+                    SkewData.ExpectedType := none;
+                ELSIF ( Signal1'Event OR Signal2'Event ) THEN
+                    IF ( Signal1 /= 'X' AND Signal2 /= 'X' ) THEN
+                        TriggerDelay := 0 ns;
+                        ExpectedType := none;
+                    END IF;
+                END IF;
+            END IF;
+    
+            IF (Signal1'EVENT and Signal2'EVENT) THEN
+                IF (Signal1 = Signal2) THEN
+                    IF (Posedge(Signal1'LAST_VALUE, Signal1)) THEN
+                        IF ((Signal1Delay - Signal2Delay) >= 
+                                SkewS1S2RiseRise) THEN
+                            ReportType := s2r;
+                            ReportTime := NOW - Signal1Delay +
+                                          SkewS1S2RiseRise;
+                        ELSIF ((Signal2Delay -Signal1Delay) >= 
+                                SkewS2S1RiseRise) THEN
+                            ReportType := s1r;
+                            ReportTime := NOW - Signal2Delay +
+                                          SkewS2S1RiseRise;
+                        END IF;
+                    ELSIF (Negedge(Signal1'LAST_VALUE, Signal1)) THEN
+                        IF ((Signal1Delay - Signal2Delay) >= 
+                                SkewS1S2FallFall) THEN 
+                            ReportType := s2f;
+                            ReportTime := NOW - Signal1Delay +
+                                          SkewS1S2FallFall;
+                        ELSIF ((Signal2Delay - Signal1Delay) >= 
+                                SkewS2S1FallFall) THEN  
+                            ReportType := s1f;
+                            ReportTime := NOW - Signal2Delay +
+                                          SkewS2S1FallFall;
+                        END IF;
+                    END IF; 
+                ELSIF (Posedge(Signal1'LAST_VALUE , Signal1)) THEN
+                    IF ((Signal1Delay >= Signal2Delay) and (Signal2Delay > 
+                            SkewS2S1FallFall)) THEN 
+                        ReportType := s1f;
+                        ReportTime := NOW - Signal2Delay + 
+                                               SkewS2S1FallFall;
+                    ELSIF ((Signal2Delay >= Signal1Delay) and (Signal1Delay > 
+                            SkewS1S2RiseRise)) THEN
+                        ReportType := s2r;
+                        ReportTime := NOW - Signal1Delay + 
+                                               SkewS1S2RiseRise;
+                    ELSIF (Signal2Delay > Signal1Delay) THEN
+                        SkewData.ExpectedType := s2r;
+                        TriggerDelay := SkewS1S2RiseRise + 
+                                                 Signal2Delay - Signal1Delay;
+                    ELSIF (Signal1Delay > Signal2Delay) THEN 
+                        SkewData.ExpectedType := s1r;    
+                        TriggerDelay := SkewS2S1RiseRise + 
+                                                 Signal1Delay - Signal2Delay;
+                    ELSIF (SkewS1S2RiseRise < SkewS2S1RiseRise) THEN
+                        SkewData.ExpectedType := s2r;
+                        TriggerDelay := SkewS1S2RiseRise;
+                    ELSE
+                        SkewData.ExpectedType := s1r;
+                        TriggerDelay := SkewS2S1RiseRise;
+                    END IF;
+                ELSIF (Negedge(Signal1'LAST_VALUE , Signal1)) THEN 
+                    IF ((Signal1Delay >= Signal2Delay) and (Signal2Delay > 
+                            SkewS2S1RiseRise)) THEN  
+                        ReportType := s1r;
+                        ReportTime := NOW - Signal2Delay + 
+                                               SkewS2S1RiseRise;
+                    ELSIF ((Signal2Delay >= Signal1Delay) and (Signal1Delay > 
+                            SkewS1S2FallFall)) THEN 
+                        ReportType := s2f;
+                        ReportTime := NOW - Signal1Delay + 
+                                               SkewS1S2FallFall;
+                    ELSIF (Signal2Delay > Signal1Delay) THEN
+                        SkewData.ExpectedType := s2f;
+                        TriggerDelay := SkewS1S2FallFall + 
+                                                 Signal2Delay - Signal1Delay;
+                    ELSIF (Signal1Delay > Signal2Delay) THEN
+                        SkewData.ExpectedType := s1f;    
+                        TriggerDelay := SkewS2S1FallFall + 
+                                                 Signal1Delay - Signal2Delay;
+                    ELSIF (SkewS1S2FallFall < SkewS2S1FallFall) THEN
+                        SkewData.ExpectedType := s2f;
+                        TriggerDelay := SkewS1S2FallFall;
+                    ELSE
+                        SkewData.ExpectedType := s1f;    
+                        TriggerDelay := SkewS2S1FallFall;
+                    END IF;
+                END IF;   
+            ELSIF (Signal1'EVENT) THEN
+                IF ( Signal1 /= Signal2) THEN
+                    IF ( Posedge( Signal1'LAST_VALUE,  Signal1)) THEN
+                        IF (SkewS1S2RiseRise > (Signal1Delay - 
+                                Signal2Delay)) THEN
+                            SkewData.ExpectedType := s2r;
+                            TriggerDelay := SkewS1S2RiseRise + 
+                                                     Signal2Delay - 
+                                                     Signal1Delay;
+                        ELSE
+                            ReportType := s2r;
+                            ReportTime := NOW + SkewS1S2RiseRise - 
+                                                   Signal1Delay;
+                        END IF; 
+                    ELSIF ( Negedge( Signal1'LAST_VALUE,  Signal1)) THEN
+                        IF (SkewS1S2FallFall > (Signal1Delay - 
+                                Signal2Delay)) THEN    
+                            SkewData.ExpectedType := s2f; 
+                            TriggerDelay := SkewS1S2FallFall + 
+                                                     Signal2Delay - 
+                                                     Signal1Delay;
+                        ELSE     
+                            ReportType := s2f;
+                            ReportTime := NOW + SkewS1S2FallFall - 
+                                                   Signal1Delay;
+                        END IF; 
+                    END IF;
+                ELSE 
+                    IF ( Posedge( Signal1'LAST_VALUE,  Signal1)) THEN
+                        IF ((Signal1Delay - SkewS1S2RiseRise) > 
+                                (Signal2'LAST_EVENT + Signal2Delay)) THEN
+                            IF ((SkewData.Signal2Old2 - Signal2Delay) >
+                                    (NOW - Signal1Delay + 
+                                    SkewS1S2RiseRise)) THEN
+                                ViolationCertain := FALSE;
+                                ReportType := s2r;
+                                ReportTime := NOW + SkewS1S2RiseRise - 
+                                                   Signal1Delay;
+                            END IF;
+                        END IF;
+                    ELSIF ( Negedge( Signal1'LAST_VALUE,  Signal1)) THEN
+                        IF ((Signal1Delay - SkewS1S2FallFall) > 
+                                (Signal2'LAST_EVENT + Signal2Delay)) THEN
+                            IF (( SkewData.Signal2Old2 - Signal2Delay) >
+                                    (NOW - Signal1Delay + 
+                                    SkewS1S2FallFall )) THEN
+                                ViolationCertain := FALSE;
+                                ReportType := s2f;
+                                ReportTime := NOW + SkewS1S2FallFall - 
+                                                   Signal1Delay;
+                            END IF;
+                        END IF;  
+                    END IF;  
+                END IF;
+            ELSIF (Signal2'EVENT) THEN
+                IF (Signal1 /= Signal2) THEN
+                    IF (Posedge(Signal2'LAST_VALUE,Signal2)) THEN
+                        IF ( SkewS2S1RiseRise > (Signal2Delay - 
+                                Signal1Delay)) THEN
+                            SkewData.ExpectedType := s1r;
+                            TriggerDelay := SkewS2S1RiseRise + 
+                                                     Signal1Delay - 
+                                                     Signal2Delay;
+                        ELSE
+                            ReportType := s2r;
+                            ReportTime := NOW + SkewS2S1RiseRise - 
+                                                   Signal2Delay;
+                        END IF;
+                    ELSIF (Negedge(Signal2'LAST_VALUE,Signal2)) THEN
+                        IF ( SkewS2S1FallFall > (Signal2Delay - 
+                                Signal1Delay)) THEN
+                            SkewData.ExpectedType := s1f; 
+                            TriggerDelay := SkewS2S1FallFall + 
+                                                     Signal1Delay - 
+                                                     Signal2Delay;
+                        ELSE  
+                            ReportType := s1f;
+                            ReportTime := NOW + SkewS2S1FallFall - 
+                                                   Signal2Delay;
+                        END IF;
+                    END IF; 
+                ELSE 
+                    IF (Posedge(Signal2'LAST_VALUE, Signal2)) THEN
+                        IF ((Signal2Delay - SkewS2S1RiseRise) > 
+                                (Signal1'LAST_EVENT + Signal1Delay)) THEN
+                            IF (( SkewData.Signal1Old2 - Signal1Delay) >
+                                    (NOW - Signal2Delay +
+                                    SkewS2S1RiseRise )) THEN
+                                ViolationCertain := FALSE;
+                                ReportType := s1r;
+                                ReportTime := NOW + SkewS2S1RiseRise - 
+                                                   Signal2Delay;
+                            END IF;
+                        END IF;
+                    ELSIF (Negedge(Signal2'LAST_VALUE, Signal2)) THEN
+                        IF ((Signal2Delay - SkewS2S1FallFall) > 
+                                (Signal1'LAST_EVENT + Signal1Delay)) THEN
+                            IF (( SkewData.Signal1Old2 - Signal1Delay) >
+                                    (NOW - Signal2Delay +
+                                    SkewS2S1FallFall )) THEN
+                                ViolationCertain := FALSE;
+                                ReportType := s1f;
+                                ReportTime := NOW + SkewS2S1FallFall - 
+                                                   Signal2Delay;
+                            END IF;
+                        END IF;
+                    END IF; 
+                END IF; 
+            END IF;        
+
+            IF (ReportType /= none) THEN
+                IF (MsgOn) THEN
+                    CASE ReportType IS
+                    WHEN s1r => 
+                        ReportSkewViolation(
+                            Signal2Name,
+                            Signal1Name,
+                            SkewS2S1RiseRise,
+                            ReportTime,
+                            HeaderMsg,
+                            MsgSeverity,
+                            Inphase,
+                            ViolationCertain);
+                    WHEN s1f =>
+                        ReportSkewViolation(
+                            Signal2Name,
+                            Signal1Name,
+                            SkewS2S1FallFall,
+                            ReportTime,
+                            HeaderMsg,
+                            MsgSeverity,
+                            Inphase,
+                            ViolationCertain);
+                    WHEN s2r =>
+                        ReportSkewViolation(
+                            Signal1Name,
+                            Signal2Name,
+                            SkewS1S2RiseRise,
+                            ReportTime,
+                            HeaderMsg,
+                            MsgSeverity,
+                            Inphase,
+                            ViolationCertain);
+                    WHEN s2f =>
+                        ReportSkewViolation(
+                            Signal1Name,
+                            Signal2Name,
+                            SkewS1S2FallFall,
+                            ReportTime,
+                            HeaderMsg,
+                            MsgSeverity,
+                            Inphase,
+                            ViolationCertain);
+                    WHEN OTHERS =>
+                    END CASE;
+                END IF;
+                IF (XOn) THEN
+                    Violation := 'X';
+                END IF;
+                SkewData.ExpectedType := none;
+            END IF;        
+            IF (TriggerDelay /= noTrigger) THEN
+                IF (TriggerDelay = 0 ns) THEN
+                    trigger <= TRANSPORT trigger AFTER 0 ns;
+                ELSE
+                    trigger <= TRANSPORT not (trigger) AFTER 
+                               TriggerDelay;
+                END IF;
+            END IF;
+        END IF;
+        IF (Signal1'EVENT and SkewData.Signal1Old1 /= NOW) THEN
+            SkewData.Signal1Old2 := SkewData.Signal1Old1;
+            SkewData.Signal1Old1 := NOW;
+        END IF;
+        IF (Signal2'EVENT and SkewData.Signal2Old1 /= NOW) THEN
+            SkewData.Signal2Old2 := SkewData.Signal2Old1;
+            SkewData.Signal2Old1 := NOW;
+        END IF;
+    END VitalInPhaseSkewCheck;
+
+    PROCEDURE VitalOutPhaseSkewCheck (
+        VARIABLE Violation         : OUT    X01;
+        VARIABLE SkewData          : INOUT  VitalSkewDataType;
+        SIGNAL   Signal1           : IN     std_ulogic;
+        CONSTANT Signal1Name       : IN     STRING := "";
+        CONSTANT Signal1Delay      : IN     TIME := 0 ns;
+        SIGNAL   Signal2           : IN     std_ulogic;
+        CONSTANT Signal2Name       : IN     STRING := "";
+        CONSTANT Signal2Delay      : IN     TIME := 0 ns;
+        CONSTANT SkewS1S2RiseFall  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS2S1RiseFall  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS1S2FallRise  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS2S1FallRise  : IN     TIME := TIME'HIGH;
+        CONSTANT CheckEnabled      : IN     BOOLEAN := TRUE;
+        CONSTANT XOn               : IN     BOOLEAN := TRUE;
+        CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+        CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+        CONSTANT HeaderMsg         : IN     STRING  := "";
+        SIGNAL   Trigger           : INOUT  std_ulogic
+    ) IS
+        VARIABLE ReportType  : VitalSkewExpectedType := none;
+        VARIABLE ExpectedType  : VitalSkewExpectedType := none;
+        VARIABLE ReportTime  : TIME;
+        VARIABLE TriggerDelay  : TIME;
+        VARIABLE ViolationCertain  : Boolean := TRUE;
+    BEGIN
+        Violation := '0';
+        TriggerDelay := noTrigger;
+        IF (CheckEnabled) THEN
+            IF (SkewData.ExpectedType /= none) THEN
+                IF (trigger'Event) THEN
+                    CASE SkewData.ExpectedType IS 
+                    WHEN s1r => ReportType := s1r;
+                                ReportTime := NOW - Signal1Delay;
+                    WHEN s1f => ReportType := s1f;
+                                ReportTime := NOW - Signal1Delay;
+                    WHEN s2r => ReportType := s2r;
+                                ReportTime := NOW - Signal2Delay;
+                    WHEN s2f => ReportType := s2f;
+                                ReportTime := NOW - Signal2Delay;
+                    WHEN OTHERS =>
+                    END CASE;
+                    SkewData.ExpectedType := none;
+                ELSIF (Signal1'Event OR Signal2'Event ) THEN
+                    IF (Signal1 /= 'X' AND Signal2 /= 'X' ) THEN
+                        TriggerDelay := 0 ns;
+                        SkewData.ExpectedType := none;
+                    END IF;
+                END IF;
+            END IF; 
+           
+            IF (Signal1'EVENT and Signal2'EVENT) THEN
+                IF (Signal1 /= Signal2) THEN
+                    IF (Posedge(Signal1'LAST_VALUE, Signal1)) THEN
+                        IF ((Signal1Delay - Signal2Delay) >= 
+                                        SkewS1S2RiseFall) THEN
+                            ReportType := s2f;
+                            ReportTime := NOW - Signal1Delay +
+                                          SkewS1S2RiseFall;
+                        ELSIF ((Signal2Delay - Signal1Delay) >=
+                                        SkewS2S1FallRise) THEN
+                            ReportType := s1r;
+                            ReportTime := NOW - Signal2Delay +
+                                          SkewS2S1FallRise;
+                        END IF;
+                    ELSIF (Negedge(Signal1'LAST_VALUE, Signal1)) THEN
+                        IF ((Signal1Delay - Signal2Delay) >= 
+                                SkewS1S2FallRise) THEN 
+                            ReportType := s2r;
+                            ReportTime := NOW - Signal1Delay +
+                                          SkewS1S2FallRise;
+                        ELSIF ((Signal2Delay - Signal1Delay) >= 
+                                SkewS2S1RiseFall) THEN  
+                            ReportType := s1f;
+                            ReportTime := NOW - Signal2Delay +
+                                          SkewS2S1RiseFall;
+                        END IF;
+                    END IF; 
+                ELSIF (Posedge(Signal1'LAST_VALUE, Signal1)) THEN
+                    IF ((Signal1Delay >= Signal2Delay) and (Signal2Delay >
+                              SkewS2S1RiseFall)) THEN 
+                        ReportType := s1f;
+                        ReportTime := NOW - Signal2Delay +
+                                      SkewS2S1RiseFall;
+                    ELSIF ((Signal2Delay >= Signal1Delay) and (Signal1Delay >
+                                      SkewS1S2RiseFall)) THEN
+                        ReportType := s2f;
+                        ReportTime := NOW - Signal1Delay +
+                                      SkewS1S2RiseFall;
+                    ELSIF (Signal1Delay > Signal2Delay) THEN
+                        SkewData.ExpectedType := s1f;
+                        TriggerDelay := SkewS2S1RiseFall +
+                                        Signal1Delay - Signal2Delay;
+                    ELSIF (Signal2Delay > Signal1Delay) THEN 
+                        SkewData.ExpectedType := s2f;
+                        TriggerDelay := SkewS1S2RiseFall + 
+                                        Signal2Delay - Signal1Delay;
+                    ELSIF (SkewS2S1RiseFall < SkewS1S2RiseFall) THEN
+                        SkewData.ExpectedType := s1f;   
+                        TriggerDelay := SkewS2S1RiseFall;
+                    ELSE
+                        SkewData.ExpectedType := s2f;   
+                        TriggerDelay := SkewS1S2RiseFall;
+                    END IF; 
+                ELSIF (Negedge(Signal1'LAST_VALUE, Signal1)) THEN
+                    IF ((Signal1Delay >= Signal2Delay) and (Signal2Delay > 
+                                                    SkewS2S1FallRise)) THEN
+                        ReportType := s1r;
+                        ReportTime := NOW - Signal2Delay +
+                                      SkewS2S1FallRise;
+                    ELSIF ((Signal2Delay >= Signal1Delay) and (Signal1Delay >
+                                                SkewS1S2FallRise)) THEN
+                        ReportType := s2r;
+                        ReportTime := NOW - Signal1Delay +
+                                      SkewS1S2FallRise;
+                    ELSIF (Signal1Delay > Signal2Delay) THEN
+                        SkewData.ExpectedType := s1r;     
+                        TriggerDelay := SkewS2S1FallRise + 
+                                        Signal1Delay - Signal2Delay;
+                    ELSIF (Signal2Delay > Signal1Delay) THEN
+                        SkewData.ExpectedType := s2r;
+                        TriggerDelay := SkewS1S2FallRise + 
+                                                Signal2Delay - Signal1Delay;
+                    ELSIF (SkewS2S1FallRise < SkewS1S2FallRise) THEN
+                        SkewData.ExpectedType := s1r;    
+                        TriggerDelay := SkewS2S1FallRise;
+                    ELSE
+                        SkewData.ExpectedType := s2r;
+                        TriggerDelay := SkewS1S2FallRise;
+                    END IF;
+                END IF;
+            ELSIF (Signal1'EVENT) THEN
+                IF (Signal1 = Signal2) THEN
+                    IF (Posedge(Signal1'LAST_VALUE,Signal1)) THEN
+                        IF (SkewS1S2RiseFall > (Signal1Delay - 
+                                                   Signal2Delay)) THEN
+                            SkewData.ExpectedType := s2f;
+                            TriggerDelay := SkewS1S2RiseFall +
+                                            Signal2Delay - Signal1Delay;
+                        ELSE
+                            ReportType := s2f;
+                            ReportTime := NOW - Signal1Delay +
+                                          SkewS1S2RiseFall;
+                        END IF;
+                    ELSIF ( Negedge(Signal1'LAST_VALUE, Signal1)) THEN
+                        IF ( SkewS1S2FallRise > (Signal1Delay - 
+                                                   Signal2Delay)) THEN
+                            SkewData.ExpectedType := s2r;
+                            TriggerDelay := SkewS1S2FallRise +
+                                            Signal2Delay - Signal1Delay;
+                        ELSE
+                            ReportType := s2r;
+                            ReportTime := NOW - Signal1Delay +
+                                          SkewS1S2FallRise; 
+                        END IF;
+                    END IF;
+                ELSE
+                    IF (Posedge( Signal1'LAST_VALUE, Signal1 )) THEN 
+                        IF ((Signal1Delay - SkewS1S2RiseFall) >
+                            (Signal2'LAST_EVENT + Signal2Delay)) THEN
+                            IF (( SkewData.Signal2Old2 - Signal2Delay) >
+                                    (NOW - Signal1Delay + 
+                                    SkewS1S2RiseFall )) THEN
+                                ViolationCertain := FALSE;
+                                ReportType := s2f;
+                                ReportTime := NOW + SkewS1S2RiseFall - 
+                                                   Signal1Delay;
+                            END IF;
+                        END IF;
+                    ELSIF (Negedge(Signal1'LAST_VALUE, Signal1)) THEN
+                        IF ((Signal1Delay - SkewS1S2FallRise) > 
+                            (Signal2'LAST_EVENT + Signal2Delay)) THEN
+                            IF (( SkewData.Signal2Old2 - Signal2Delay) >
+                                    (NOW - Signal1Delay + 
+                                    SkewS1S2FallRise )) THEN
+                                ViolationCertain := FALSE;
+                                ReportType := s2r;
+                                ReportTime := NOW + SkewS1S2FallRise - 
+                                                   Signal1Delay;
+                            END IF;
+                        END IF;
+                    END IF;
+                END IF;
+            ELSIF (Signal2'EVENT) THEN
+                IF (Signal1 = Signal2) THEN
+                    IF (Posedge(Signal2'LAST_VALUE,Signal2)) THEN
+                        IF (SkewS2S1RiseFall > (Signal2Delay - 
+                                                   Signal1Delay)) THEN
+                            SkewData.ExpectedType := s1f;
+                            TriggerDelay := SkewS2S1RiseFall + Signal1Delay -
+                                                  Signal2Delay ;
+                        ELSE
+                            ReportType := s1f;
+                            ReportTime := NOW + SkewS2S1RiseFall -
+                                                Signal2Delay;
+                        END IF;
+                    ELSIF (Negedge(Signal2'LAST_VALUE,Signal2)) THEN
+                        IF (SkewS2S1FallRise > (Signal2Delay - 
+                                                  Signal1Delay)) THEN
+                            SkewData.ExpectedType := s1r;
+                            TriggerDelay := SkewS2S1FallRise + Signal1Delay -
+                                                  Signal2Delay;
+                        ELSE 
+                            ReportType := s1r;
+                            ReportTime := NOW + SkewS2S1FallRise -
+                                                Signal2Delay;
+                        END IF;
+                    END IF; 
+                ELSE
+                    IF (Posedge(Signal2'LAST_VALUE,Signal2)) THEN
+                        IF ((Signal2Delay - SkewS2S1RiseFall) >
+                              (Signal1'LAST_EVENT + Signal1Delay)) THEN
+                            IF (( SkewData.Signal1Old2 - Signal1Delay) >
+                                    (NOW - Signal2Delay +
+                                    SkewS2S1RiseFall )) THEN
+                                ViolationCertain := FALSE;
+                                ReportType := s1f;
+                                ReportTime := NOW + SkewS2S1RiseFall - 
+                                                   Signal2Delay;
+                            END IF;
+                        END IF;
+                    ELSIF (Negedge(Signal2'LAST_VALUE,Signal2)) THEN
+                        IF ((Signal2Delay - SkewS2S1FallRise) >
+                               (Signal1'LAST_EVENT + Signal1Delay)) THEN
+                            IF (( SkewData.Signal1Old2 - Signal1Delay) >
+                                    (NOW - Signal2Delay +
+                                    SkewS2S1FallRise )) THEN
+                                ViolationCertain := FALSE;
+                                ReportType := s1r;
+                                ReportTime := NOW + SkewS2S1FallRise - 
+                                                   Signal2Delay;
+                            END IF;
+                        END IF;
+                    END IF;
+                END IF;
+            END IF;    
+                  
+            IF (ReportType /= none) THEN
+                IF (MsgOn) THEN
+                    CASE ReportType IS
+                    WHEN s1r =>
+                        ReportSkewViolation(
+                            Signal2Name,
+                            Signal1Name,
+                            SkewS2S1FallRise, 
+                            ReportTime,
+                            HeaderMsg,
+                            MsgSeverity,
+                            Outphase,
+                            ViolationCertain);
+                    WHEN s1f =>
+                        ReportSkewViolation(
+                            Signal2Name,
+                            Signal1Name,
+                            SkewS2S1RiseFall,
+                            ReportTime,
+                            HeaderMsg,
+                            MsgSeverity,
+                            Outphase,
+                            ViolationCertain);
+                    WHEN s2r =>
+                        ReportSkewViolation(
+                            Signal1Name,
+                            Signal2Name,
+                            SkewS1S2FallRise,
+                            ReportTime,
+                            HeaderMsg,
+                            MsgSeverity,
+                            Outphase,
+                            ViolationCertain);
+                    WHEN s2f =>
+                        ReportSkewViolation(
+                            Signal1Name,
+                            Signal2Name,
+                            SkewS1S2RiseFall,
+                            ReportTime,
+                            HeaderMsg,
+                            MsgSeverity,
+                            Outphase,
+                            ViolationCertain);
+                    WHEN OTHERS =>
+                    END CASE;
+                END IF;
+                IF (XOn) THEN
+                    Violation := 'X';
+                END IF;
+                ReportType := none;
+            END IF;
+            IF (TriggerDelay /= noTrigger) THEN
+                IF (TriggerDelay = 0 ns) THEN
+                    trigger <= TRANSPORT trigger AFTER 0 ns;
+                ELSE
+                    trigger <= TRANSPORT not (trigger) AFTER
+                               TriggerDelay;
+                END IF;
+            END IF;
+        END IF;
+        IF (Signal1'EVENT and SkewData.Signal1Old1 /= NOW) THEN
+            SkewData.Signal1Old2 := SkewData.Signal1Old1;
+            SkewData.Signal1Old1 := NOW;
+        END IF;
+        IF (Signal2'EVENT and SkewData.Signal2Old1 /= NOW) THEN
+            SkewData.Signal2Old2 := SkewData.Signal2Old1;
+            SkewData.Signal2Old1 := NOW;
+        END IF;
+    END VitalOutPhaseSkewCheck;
+
+END VITAL_Timing;
diff --git a/libraries/vital2000/timing_p.vhdl b/libraries/vital2000/timing_p.vhdl
new file mode 100644
index 000000000..e18c8c24a
--- /dev/null
+++ b/libraries/vital2000/timing_p.vhdl
@@ -0,0 +1,1202 @@
+-------------------------------------------------------------------------------
+-- Title        : Standard VITAL TIMING Package
+--              : $Revision: 598 $
+--              :
+-- Library      : This package shall be compiled into a library
+--              : symbolically named IEEE.
+--              :
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              :
+-- Purpose      : This packages defines standard types, attributes, constants,
+--              : functions and procedures for use in developing ASIC models.
+--              :
+-- Known Errors : 
+--              :
+-- Note         : No declarations or definitions shall be included in,
+--              : or excluded from this package. The "package declaration"
+--              : defines the objects (types, subtypes, constants, functions,
+--              : procedures ... etc.) that can be used by a user.  The package
+--              : body shall be considered the formal definition of the
+--              : semantics of this package.  Tool developers may choose to
+--              : implement the package body in the most efficient manner
+--              : available to them.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Acknowledgments:
+--   This code was originally developed under the "VHDL Initiative Toward ASIC
+--   Libraries" (VITAL), an industry sponsored initiative.  Technical
+--   Director: William Billowitch, VHDL Technology Group; U.S. Coordinator:
+--   Steve Schultz;  Steering Committee Members: Victor Berman, Cadence Design
+--   Systems; Oz Levia, Synopsys Inc.; Ray Ryan, Ryan & Ryan; Herman van Beek,
+--   Texas Instruments; Victor Martin, Hewlett-Packard Company.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History :
+-- ----------------------------------------------------------------------------
+-- Version No:|Auth:| Mod.Date:| Changes Made:
+--   v95.0 A  |     | 06/02/95 | Initial ballot draft 1995
+--   v95.1    |     | 08/31/95 | #203 - Timing violations at time 0
+--                               #204 - Output mapping prior to glitch detection 
+--   v98.0    |TAG  | 03/27/98 | Initial ballot draft 1998
+--                             | #IR225 - Negative Premptive Glitch
+--                                      **Pkg_effected=VitalPathDelay,
+--                                      VitalPathDelay01,VitalPathDelay01z.
+--                               #IR105 - Skew timing check needed
+--                                      **Pkg_effected=NONE, New code added!! 
+--                               #IR248 - Allows VPD to use a default timing 
+--                                        delay
+--                                      **Pkg_effected=VitalPathDelay,
+--                                        VitalPathDelay01,VitalPathDelay01z,
+--				                 #IR250 - Corrects fastpath condition in VPD
+--                                      **Pkg_effected=VitalPathDelay01,
+--                                        VitalPathDelay01z,
+--                               #IR252 - Corrects cancelled timing check call if
+--                                        condition expires.  
+--                                        **Pkg_effected=VitalSetupHoldCheck,
+--                                        VitalRecoveryRemovalCheck.
+--                               #IR105 - Skew timing check 
+--                                        **Pkg_effected=NONE, New code added
+--   v98.1    | jdc | 03/25/99 | Changed UseDefaultDelay to IgnoreDefaultDelay
+--                               and set default to FALSE in VitalPathDelay()
+--   v00.7    | dbb | 07/18/00 | Removed "maximum" from VitalPeriodPulse()
+--                               comments
+
+
+LIBRARY IEEE;
+USE     IEEE.Std_Logic_1164.ALL;
+
+PACKAGE VITAL_Timing IS
+    TYPE VitalTransitionType IS ( tr01, tr10, tr0z, trz1, tr1z, trz0,
+                                  tr0X, trx1, tr1x, trx0, trxz, trzx);
+
+    SUBTYPE VitalDelayType     IS TIME;
+    TYPE VitalDelayType01   IS ARRAY (VitalTransitionType   RANGE tr01 to tr10)
+         OF TIME;
+    TYPE VitalDelayType01Z  IS ARRAY (VitalTransitionType   RANGE tr01 to trz0)
+         OF TIME;
+    TYPE VitalDelayType01ZX IS ARRAY (VitalTransitionType   RANGE tr01 to trzx)
+         OF TIME;
+
+    TYPE VitalDelayArrayType     IS ARRAY (NATURAL RANGE <>) OF VitalDelayType;
+    TYPE VitalDelayArrayType01   IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01;
+    TYPE VitalDelayArrayType01Z  IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01Z;
+    TYPE VitalDelayArrayType01ZX IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01ZX;
+    -- ----------------------------------------------------------------------
+    -- **********************************************************************
+    -- ----------------------------------------------------------------------
+
+    CONSTANT VitalZeroDelay     : VitalDelayType     :=   0 ns;
+    CONSTANT VitalZeroDelay01   : VitalDelayType01   := ( 0 ns, 0 ns );
+    CONSTANT VitalZeroDelay01Z  : VitalDelayType01Z  := ( OTHERS => 0 ns );
+    CONSTANT VitalZeroDelay01ZX : VitalDelayType01ZX := ( OTHERS => 0 ns );
+
+    ---------------------------------------------------------------------------
+    -- examples of usage:
+    ---------------------------------------------------------------------------
+    -- tpd_CLK_Q : VitalDelayType  := 5 ns;
+    -- tpd_CLK_Q : VitalDelayType01  := (tr01 => 2 ns, tr10 => 3 ns);
+    -- tpd_CLK_Q : VitalDelayType01Z := ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns );
+    -- tpd_CLK_Q : VitalDelayArrayType(0 to 1)
+    --                          := (0 => 5 ns, 1 => 6 ns);
+    -- tpd_CLK_Q : VitalDelayArrayType01(0 to 1)
+    --                          := (0 => (tr01 => 2 ns, tr10 => 3 ns),
+    --                              1 => (tr01 => 2 ns, tr10 => 3 ns));
+    -- tpd_CLK_Q : VitalDelayArrayType01Z(0 to 1)
+    --                        := (0 => ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns ),
+    --                            1 => ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns ));
+    ---------------------------------------------------------------------------
+
+    -- TRUE if the model is LEVEL0 | LEVEL1 compliant
+    ATTRIBUTE VITAL_Level0 : BOOLEAN;
+    ATTRIBUTE VITAL_Level1 : BOOLEAN;
+
+    SUBTYPE std_logic_vector2 IS std_logic_vector(1 DOWNTO 0);
+    SUBTYPE std_logic_vector3 IS std_logic_vector(2 DOWNTO 0);
+    SUBTYPE std_logic_vector4 IS std_logic_vector(3 DOWNTO 0);
+    SUBTYPE std_logic_vector8 IS std_logic_vector(7 DOWNTO 0);
+
+    -- Types for strength mapping of outputs
+    TYPE VitalOutputMapType  IS ARRAY ( std_ulogic ) OF std_ulogic;
+    TYPE VitalResultMapType  IS ARRAY ( UX01       ) OF std_ulogic;
+    TYPE VitalResultZMapType IS ARRAY ( UX01Z      ) OF std_ulogic;
+    CONSTANT VitalDefaultOutputMap  : VitalOutputMapType
+                                    := "UX01ZWLH-";
+    CONSTANT VitalDefaultResultMap  : VitalResultMapType
+                                    := ( 'U', 'X', '0', '1' );
+    CONSTANT VitalDefaultResultZMap : VitalResultZMapType
+                                    := ( 'U', 'X', '0', '1', 'Z' );
+
+    -- Types for fields of VitalTimingDataType
+    TYPE VitalTimeArrayT  IS ARRAY (INTEGER RANGE <>) OF TIME;
+    TYPE VitalTimeArrayPT IS ACCESS VitalTimeArrayT;
+    TYPE VitalBoolArrayT  IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+    TYPE VitalBoolArrayPT IS ACCESS VitalBoolArrayT;
+    TYPE VitalLogicArrayPT IS ACCESS std_logic_vector;
+
+    TYPE VitalTimingDataType IS RECORD
+        NotFirstFlag : BOOLEAN;
+        RefLast   : X01;
+        RefTime   : TIME;
+        HoldEn    : BOOLEAN;
+        TestLast  : std_ulogic;
+        TestTime  : TIME;
+        SetupEn   : BOOLEAN;
+        TestLastA : VitalLogicArrayPT;
+        TestTimeA : VitalTimeArrayPT;
+        HoldEnA   : VitalBoolArrayPT;
+        SetupEnA  : VitalBoolArrayPT;
+    END RECORD;
+
+    FUNCTION VitalTimingDataInit RETURN VitalTimingDataType;
+
+    -- type for internal data of VitalPeriodPulseCheck
+    TYPE VitalPeriodDataType IS RECORD
+        Last : X01;
+        Rise : TIME;
+        Fall : TIME;
+        NotFirstFlag : BOOLEAN;
+    END RECORD;
+    CONSTANT VitalPeriodDataInit : VitalPeriodDataType 
+                                 := ('X', 0 ns, 0 ns, FALSE );
+
+    -- Type for specifying the kind of Glitch handling to use
+    TYPE VitalGlitchKindType IS (OnEvent,
+                                 OnDetect,
+                                 VitalInertial,
+                                 VitalTransport);
+
+    TYPE VitalGlitchDataType IS
+      RECORD
+        SchedTime    : TIME;
+        GlitchTime   : TIME;
+        SchedValue   : std_ulogic;
+        LastValue    : std_ulogic;
+      END RECORD;
+    TYPE VitalGlitchDataArrayType IS ARRAY (NATURAL RANGE <>)
+         OF VitalGlitchDataType;
+
+    -- PathTypes: for handling simple PathDelay info
+    TYPE VitalPathType IS RECORD
+        InputChangeTime : TIME;             -- timestamp for path input signal
+        PathDelay       : VitalDelayType;   -- delay for this path
+        PathCondition   : BOOLEAN;          -- path sensitize condition
+    END RECORD;
+    TYPE VitalPath01Type IS RECORD
+        InputChangeTime : TIME;             -- timestamp for path input signal
+        PathDelay       : VitalDelayType01; -- delay for this path
+        PathCondition   : BOOLEAN;          -- path sensitize condition
+    END RECORD;
+    TYPE VitalPath01ZType IS RECORD
+        InputChangeTime : TIME;             -- timestamp for path input signal
+        PathDelay       : VitalDelayType01Z;-- delay for this path
+        PathCondition   : BOOLEAN;          -- path sensitize condition
+    END RECORD;
+
+    -- For representing multiple paths to an output
+    TYPE VitalPathArrayType    IS ARRAY (NATURAL RANGE <> ) OF VitalPathType;
+    TYPE VitalPathArray01Type  IS ARRAY (NATURAL RANGE <> ) OF VitalPath01Type;
+    TYPE VitalPathArray01ZType IS ARRAY (NATURAL RANGE <> ) OF VitalPath01ZType;
+
+    TYPE VitalTableSymbolType IS (
+       '/',      -- 0 -> 1                                      
+       '\',      -- 1 -> 0                                      
+       'P',      -- Union of '/' and '^' (any edge to 1)                     
+       'N',      -- Union of '\' and 'v' (any edge to 0)                       
+       'r',      -- 0 -> X                                      
+       'f',      -- 1 -> X                                      
+       'p',      -- Union of '/' and 'r' (any edge from 0)               
+       'n',      -- Union of '\' and 'f' (any edge from 1)               
+       'R',      -- Union of '^' and 'p' (any possible rising edge)      
+       'F',      -- Union of 'v' and 'n' (any possible falling edge)     
+       '^',      -- X -> 1                                      
+       'v',      -- X -> 0                                      
+       'E',      -- Union of 'v' and '^' (any edge from X)               
+       'A',      -- Union of 'r' and '^' (rising edge to or from 'X')                           
+       'D',      -- Union of 'f' and 'v' (falling edge to or from 'X')                          
+       '*',      -- Union of 'R' and 'F' (any edge)                      
+       'X',      -- Unknown level                               
+       '0',      -- low level                                   
+       '1',      -- high level                                  
+       '-',      -- don't care                                  
+       'B',      -- 0 or 1                                      
+       'Z',      -- High Impedance                              
+       'S'       -- steady value                                
+    );
+
+    SUBTYPE VitalEdgeSymbolType IS VitalTableSymbolType RANGE '/' TO '*';
+
+
+
+
+ -- Addition of Vital Skew Type Information 
+ -- March 14, 1998 
+
+    ---------------------------------------------------------------------------
+    -- Procedures and Type Definitions for Defining Skews 
+    ---------------------------------------------------------------------------
+    
+    TYPE VitalSkewExpectedType IS (none, s1r, s1f, s2r, s2f);
+   
+    TYPE VitalSkewDataType IS RECORD
+        ExpectedType : VitalSkewExpectedType;
+        Signal1Old1 : TIME;
+        Signal2Old1 : TIME;
+        Signal1Old2 : TIME;
+        Signal2Old2 : TIME;
+    END RECORD;
+
+    CONSTANT VitalSkewDataInit : VitalSkewDataType := ( none, 0 ns, 0 ns, 0 ns, 0 ns );
+
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalExtendToFillDelay
+    --
+    -- Description:     A six element array of delay values of type 
+    --                  VitalDelayType01Z is returned when a 1, 2 or 6
+    --                  element array is given.  This function will convert
+    --                  VitalDelayType and VitalDelayType01 delay values into
+    --                  a VitalDelayType01Z type following these rules:
+    --
+    --                  When a VitalDelayType is passed, all six transition
+    --                  values are assigned the input value.  When a 
+    --                  VitalDelayType01 is passed, the 01 transitions are
+    --                  assigned to the 01, 0Z and Z1 transitions and the 10
+    --                  transitions are assigned to 10, 1Z and Z0 transition
+    --                  values.  When a VitalDelayType01Z is passed, the values
+    --                  are kept as is.
+    --
+    --                  The function is overloaded based on input type.
+    --
+    --                  There is no function to fill a 12 value delay
+    --                  type.
+    --
+    -- Arguments:         
+    --
+    --  IN                 Type           Description
+    --                     Delay          A one, two or six delay value Vital-
+    --                                    DelayType is passed and a six delay,
+    --                                    VitalDelayType01Z, item is returned.        
+    --                    
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --   VitalDelayType01Z
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalExtendToFillDelay (
+            CONSTANT Delay : IN VitalDelayType
+          ) RETURN VitalDelayType01Z;
+    FUNCTION VitalExtendToFillDelay (
+            CONSTANT Delay : IN VitalDelayType01
+          ) RETURN VitalDelayType01Z;
+    FUNCTION VitalExtendToFillDelay (
+            CONSTANT Delay : IN VitalDelayType01Z
+          ) RETURN VitalDelayType01Z;
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalCalcDelay
+    --
+    -- Description:     This function accepts a 1, 2 or 6 value delay and 
+    --                  chooses the correct delay time to delay the NewVal 
+    --                  signal.  This function is overloaded based on the
+    --                  delay type passed. The function returns a single value
+    --                  of time.
+    --
+    --                  This function is provided for Level 0 models in order
+    --                  to calculate the delay which should be applied 
+    --                  for the passed signal. The delay selection is performed
+    --                  using the OldVal and the NewVal to determine the 
+    --                  transition to select.  The default value of OldVal is X.
+    --
+    --                  This function cannot be used in a Level 1 model since
+    --                  the VitalPathDelay routines perform the delay path
+    --                  selection and output driving function.
+    --
+    -- Arguments:         
+    --
+    --  IN                 Type           Description
+    --                      NewVal         New value of the signal to be
+    --                                     assigned   
+    --                      OldVal         Previous value of the signal.
+    --                                     Default value is 'X'
+    --                      Delay          The delay structure from which to
+    --                                     select the appropriate delay.  The
+    --                                     function overload is based on the
+    --                                     type of delay passed.  In the case of
+    --                                     the single delay, VitalDelayType, no
+    --                                     selection is performed, since there
+    --                                     is only one value to choose from.
+    --                                     For the other cases, the transition
+    --                                     from the old value to the new value
+    --                                     decide the value returned.  
+    --                    
+    --  INOUT
+    --   none 
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --   Time                              The time value selected from the
+    --                                     Delay INPUT is returned.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType
+          ) RETURN TIME;
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType01
+          ) RETURN TIME;
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType01Z
+          ) RETURN TIME;
+
+   -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalPathDelay
+    --
+    -- Description:     VitalPathDelay is the Level 1 routine used to select
+    --                  the propagation delay path and schedule a new output 
+    --                  value.
+    --
+    --                  For single and dual delay values, VitalDelayType and
+    --                  VitalDelayType01 are used.  The output value is
+    --                  scheduled with a calculated delay without strength
+    --                  modification.  
+    --
+    --                  For the six delay value, VitalDelayType01Z, the output 
+    --                  value is scheduled with a calculated delay.  The drive 
+    --                  strength can be modified to handle weak signal strengths
+    --                  to model tri-state devices, pull-ups and pull-downs as
+    --                  an example.
+    --
+    --                  The correspondence between the delay type and the
+    --                  path delay function is as follows:
+    --
+    --                  Delay Type                Path Type
+    --
+    --                  VitalDelayType            VitalPathDelay
+    --                  VitalDelayType01          VitalPathDelay01
+    --                  VitalDelayType01Z         VitalPathDelay01Z
+    --
+    --                  For each of these routines, the following capabilities
+    --                  is provided:
+    --     
+    --                  o Transition dependent path delay selection
+    --                  o User controlled glitch detection with the ability
+    --                    to generate "X" on output and report the violation
+    --                  o Control of the severity level for message generation
+    --                  o Scheduling of the computed values on the specified
+    --                    signal.
+    --                  
+    --                  Selection of the appropriate path delay begins with the
+    --                  candidate paths.  The candidate paths are selected by
+    --                  identifying the paths for which the PathCondition is 
+    --                  true.  If there is a single candidate path, then that
+    --                  delay is selected.  If there is more than one candidate
+    --                  path, then the shortest delay is selected using 
+    --                  transition dependent delay selection.  If there is no 
+    --                  candidate paths, then the delay specified by the 
+    --                  DefaultDelay parameter to the path delay is used.
+    --                  
+    --                  Once the delay is known, the output signal is then
+    --                  scheduled with that delay.  In the case of 
+    --                  VitalPathDelay01Z, an additional result mapping of
+    --                  the output value is performed before scheduling.  The
+    --                  result mapping is performed after transition dependent
+    --                  delay selection but before scheduling the final output.
+    --                      
+    --                  In order to perform glitch detection, the user is
+    --                  obligated to provide a variable of VitalGlitchDataType
+    --                  for the propagation delay functions to use.  The user
+    --                  cannot modify or use this information.
+    --
+    -- Arguments:         
+    --
+    --  IN             Type                   Description
+    --   OutSignalName  string                 The name of the output signal
+    --   OutTemp        std_logic              The new output value to be driven
+    --   Paths          VitalPathArrayType     A list of paths of VitalPathArray
+    --                  VitalPathArrayType01   type.  The VitalPathDelay routine
+    --                  VitalPathArrayType01Z  is overloaded based on the type
+    --                                         of constant passed in.  With
+    --                                         VitalPathArrayType01Z, the
+    --                                         resulting output strengths can be
+    --                                         mapped.
+    --   DefaultDelay   VitalDelayType         The default delay can be changed 
+    --                  VitalDelayType01       from zero-delay to another set
+    --                  VitalDelayType01Z      of values.
+    --
+    --   IgnoreDefaultDelay BOOLEAN            If TRUE, the default delay will
+    --                                         be used when no paths are
+    --                                         selected.  If false, no event
+    --                                         will be scheduled if no paths are
+    --                                         selected.
+    --
+    --   Mode           VitalGlitchKindType    The value of this constant
+    --                                         selects the type of glitch
+    --                                         detection.
+    --                       OnEvent           Glitch on transition event
+    --                     | OnDetect          Glitch immediate on detection
+    --                     | VitalInertial     No glitch, use INERTIAL
+    --                                         assignment
+    --                     | VitalTransport    No glitch, use TRANSPORT 
+    --                                         assignment
+    --   XOn            BOOLEAN                Control for generation of 'X' on 
+    --                                         glitch.  When TRUE, 'X's are
+    --                                         scheduled for glitches, otherwise
+    --                                         no are generated.             
+    --   MsgOn          BOOLEAN                Control for message generation on
+    --                                         glitch detect.  When TRUE,
+    --                                         glitches are reported, otherwise
+    --                                         they are not reported.      
+    --   MsgSeverity    SEVERITY_LEVEL         The level at which the message,
+    --                                         or assertion, will be reported. 
+    --   IgnoreDefaultDelay BOOLEAN            Tells the VPD whether to use the
+    --                                         default delay value in the absense
+    --                                         of a valid delay for input conditions 3/14/98 MG
+    --
+    --   OutputMap      VitalOutputMapType     For VitalPathDelay01Z, the output
+    --                                         can be mapped to alternate
+    --                                         strengths to model tri-state 
+    --                                         devices, pull-ups and pull-downs.  
+    -- 
+    --  INOUT
+    --   GlitchData     VitalGlitchDataType    The internal data storage
+    --                                         variable required to detect
+    --                                         glitches.
+    --
+    --  OUT
+    --   OutSignal      std_logic              The output signal to be driven
+    --
+    --  Returns              
+    --   none 
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalPathDelay (
+        SIGNAL   OutSignal          : OUT   std_logic;
+        VARIABLE GlitchData         : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName      : IN    string;
+        CONSTANT OutTemp            : IN    std_logic;
+        CONSTANT Paths              : IN    VitalPathArrayType;
+        CONSTANT DefaultDelay       : IN    VitalDelayType      := VitalZeroDelay;
+        CONSTANT Mode               : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn                : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn              : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity        : IN    SEVERITY_LEVEL      := WARNING;
+        CONSTANT NegPreemptOn       : IN    BOOLEAN             := FALSE;  --IR225 3/14/98
+        CONSTANT IgnoreDefaultDelay : IN    BOOLEAN             := FALSE   --IR248 3/14/98 
+    );
+    PROCEDURE VitalPathDelay01 (
+        SIGNAL   OutSignal          : OUT   std_logic;
+        VARIABLE GlitchData         : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName      : IN    string;
+        CONSTANT OutTemp            : IN    std_logic;
+        CONSTANT Paths              : IN    VitalPathArray01Type;
+        CONSTANT DefaultDelay       : IN    VitalDelayType01    := VitalZeroDelay01;
+        CONSTANT Mode               : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn                : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn              : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity        : IN    SEVERITY_LEVEL      := WARNING;
+        CONSTANT NegPreemptOn       : IN    BOOLEAN             := FALSE;  --IR225 3/14/98
+        CONSTANT IgnoreDefaultDelay : IN    BOOLEAN             := FALSE;  --IR248 3/14/98 
+        CONSTANT RejectFastPath     : IN    BOOLEAN             := FALSE   --IR250
+    );
+    PROCEDURE VitalPathDelay01Z (
+        SIGNAL   OutSignal          : OUT   std_logic;
+        VARIABLE GlitchData         : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName      : IN    string;
+        CONSTANT OutTemp            : IN    std_logic;
+        CONSTANT Paths              : IN    VitalPathArray01ZType;
+        CONSTANT DefaultDelay       : IN    VitalDelayType01Z   := VitalZeroDelay01Z;
+        CONSTANT Mode               : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn                : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn              : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity        : IN    SEVERITY_LEVEL      := WARNING;
+        CONSTANT OutputMap          : IN    VitalOutputMapType  := VitalDefaultOutputMap;
+        CONSTANT NegPreemptOn       : IN    BOOLEAN             := FALSE;  --IR225 3/14/98
+        CONSTANT IgnoreDefaultDelay : IN    BOOLEAN             := FALSE;  --IR248 3/14/98 
+        CONSTANT RejectFastPath     : IN    BOOLEAN             := FALSE   --IR250
+    );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalWireDelay
+    --
+    -- Description:     VitalWireDelay is used to delay an input signal.
+    --                  The delay is selected from the input parameter passed.
+    --                  The function is useful for back annotation of actual
+    --                  net delays.  
+    --                  
+    --                  The function is overloaded to permit passing a delay
+    --                  value for twire for VitalDelayType, VitalDelayType01
+    --                  and VitalDelayType01Z.  twire is a generic which can
+    --                  be back annotated and must be constructed to follow
+    --                  the SDF to generic mapping rules.       
+    --                  
+    -- Arguments:         
+    --
+    --  IN          Type                  Description         
+    --   InSig       std_ulogic            The input signal (port) to be
+    --                                     delayed.
+    --   twire       VitalDelayType        The delay value for which the input 
+    --               VitalDelayType01      signal should be delayed.  For Vital-
+    --               VitalDelayType01Z     DelayType, the value is single value 
+    --                                     passed.  For VitalDelayType01 and
+    --                                     VitalDelayType01Z, the appropriate
+    --                                     delay value is selected by VitalCalc-
+    --                                     Delay.
+    --
+    --  INOUT
+    --   none 
+    --
+    --  OUT
+    --   OutSig      std_ulogic            The internal delayed signal
+    --
+    --  Returns              
+    --   none 
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT twire      : IN    VitalDelayType
+        );
+
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT twire      : IN    VitalDelayType01
+        );
+
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT twire      : IN    VitalDelayType01Z
+        );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalSignalDelay
+    --
+    -- Description:     The VitalSignalDelay procedure is called in a signal
+    --                  delay block in the architecture to delay the 
+    --                  appropriate test or reference signal in order to 
+    --                  accommodate negative constraint checks.
+    --
+    --                  The amount of delay is of type TIME and is a constant.
+    --
+    -- Arguments:         
+    --
+    --  IN                Type            Description         
+    --   InSig             std_ulogic      The signal to be delayed.
+    --   dly               TIME            The amount of time the signal is
+    --                                     delayed.
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   OutSig            std_ulogic      The delayed signal
+    --
+    --  Returns              
+    --   none
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalSignalDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT dly        : IN   TIME
+    );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:  VitalSetupHoldCheck
+    --
+    -- Description:    The VitalSetupHoldCheck procedure detects a setup or a 
+    --                 hold violation on the input test signal with respect
+    --                 to the corresponding input reference signal.  The timing 
+    --                 constraints are specified through parameters 
+    --                 representing the high and low values for the setup and
+    --                 hold values for the setup and hold times.  This 
+    --                 procedure assumes non-negative values for setup and hold 
+    --                 timing constraints. 
+    --
+    --                 It is assumed that negative timing constraints
+    --                 are handled by internally delaying the test or
+    --                 reference signals.  Negative setup times result in
+    --                 a delayed reference signal.  Negative hold times
+    --                 result in a delayed test signal.  Furthermore, the
+    --                 delays and constraints associated with these and
+    --                 other signals may need to be appropriately
+    --                 adjusted so that all constraint intervals overlap
+    --                 the delayed reference signals and all constraint
+    --                 values (with respect to the delayed signals) are
+    --                 non-negative.
+    --
+    --                 This function is overloaded based on the input
+    --                 TestSignal.  A vector and scalar form are provided.
+    --                  
+    -- TestSignal XXXXXXXXXXXX____________________________XXXXXXXXXXXXXXXXXXXXXX
+    --            :
+    --            :        -->|       error region       |<--
+    --            :
+    --            _______________________________
+    -- RefSignal                                 \______________________________
+    --            :           |                  |       |
+    --            :           |               -->|       |<-- thold
+    --            :        -->|     tsetup       |<--
+    --
+    -- Arguments:         
+    --
+    --  IN                 Type           Description    
+    --   TestSignal         std_ulogic     Value of test signal
+    --                      std_logic_vector
+    --   TestSignalName     STRING         Name of test signal
+    --   TestDelay          TIME           Model's internal delay associated
+    --                                     with TestSignal
+    --   RefSignal          std_ulogic     Value of reference signal
+    --   RefSignalName      STRING         Name of reference signal
+    --   RefDelay           TIME           Model's internal delay associated
+    --                                     with RefSignal
+    --   SetupHigh          TIME           Absolute minimum time duration before
+    --                                     the transition of RefSignal for which
+    --                                     transitions of TestSignal are allowed
+    --                                     to proceed to the "1" state without
+    --                                     causing a setup violation.      
+    --   SetupLow           TIME           Absolute minimum time duration before 
+    --                                     the transition of RefSignal for which
+    --                                     transitions of TestSignal are allowed
+    --                                     to proceed to the "0" state without
+    --                                     causing a setup violation.      
+    --   HoldHigh           TIME           Absolute minimum time duration after
+    --                                     the transition of RefSignal for which
+    --                                     transitions of TestSignal are allowed
+    --                                     to proceed to the "1" state without
+    --                                     causing a hold violation.      
+    --   HoldLow            TIME           Absolute minimum time duration after 
+    --                                     the transition of RefSignal for which
+    --                                     transitions of TestSignal are allowed
+    --                                     to proceed to the "0" state without
+    --                                     causing a hold violation.      
+    --   CheckEnabled       BOOLEAN        Check performed if TRUE.
+    --   RefTransition      VitalEdgeSymbolType
+    --                                     Reference edge specified. Events on
+    --                                     the RefSignal which match the edge
+    --                                     spec. are used as reference edges.      
+    --   HeaderMsg          STRING         String that will accompany any
+    --                                     assertion messages produced.
+    --   XOn                BOOLEAN         If TRUE, Violation output parameter
+    --                                     is set to "X". Otherwise, Violation
+    --                                     is always set to "0".
+    --   MsgOn              BOOLEAN        If TRUE, set and hold violation 
+    --                                     message will be generated.
+    --                                     Otherwise, no messages are generated,
+    --                                     even upon violations.
+    --   MsgSeverity        SEVERITY_LEVEL Severity level for the assertion.      
+    --   EnableSetupOnTest  BOOLEAN        If FALSE at the time that the 
+    --                                     TestSignal signal changes, 
+    --                                     no setup check will be performed.
+    --   EnableSetupOnRef   BOOLEAN        If FALSE at the time that the 
+    --                                     RefSignal signal changes, 
+    --                                     no setup check will be performed.
+    --   EnableHoldOnRef    BOOLEAN        If FALSE at the time that the 
+    --                                     RefSignal signal changes, 
+    --                                     no hold check will be performed.
+    --   EnableHoldOnTest   BOOLEAN        If FALSE at the time that the 
+    --                                     TestSignal signal changes, 
+    --                                     no hold check will be performed.
+    --              
+    --  INOUT
+    --   TimingData         VitalTimingDataType  
+    --                                     VitalSetupHoldCheck information
+    --                                     storage area.  This is used
+    --                                     internally to detect reference edges
+    --                                     and record the time of the last edge.
+    --
+    --  OUT
+    --   Violation   X01                   This is the violation flag returned. 
+    --
+    --  Returns              
+    --   none    
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalSetupHoldCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_ulogic;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+            CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableSetupOnRef  : IN BOOLEAN := TRUE;	--IR252 3/23/98
+    	    CONSTANT EnableHoldOnRef   : IN BOOLEAN := TRUE;    --IR252 3/23/98
+	        CONSTANT EnableHoldOnTest  : IN BOOLEAN := TRUE	    --IR252 3/23/98
+      );
+
+    PROCEDURE VitalSetupHoldCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_logic_vector;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+            CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableSetupOnRef  : IN BOOLEAN := TRUE;	--IR252 3/23/98
+    	    CONSTANT EnableHoldOnRef   : IN BOOLEAN := TRUE;    --IR252 3/23/98
+	        CONSTANT EnableHoldOnTest  : IN BOOLEAN := TRUE	    --IR252 3/23/98
+    );
+
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalRecoveryRemovalCheck
+    --
+    -- Description:     The VitalRecoveryRemovalCheck detects the presence of
+    --                  a recovery or removal violation on the input test 
+    --                  signal with respect to the corresponding input reference
+    --                  signal.  It assumes non-negative values of setup and
+    --                  hold timing constraints.  The timing constraint is 
+    --                  specified through parameters representing the recovery
+    --                  and removal times associated with a reference edge of 
+    --                  the reference signal.  A flag indicates whether a test
+    --                  signal is asserted when it is high or when it is low.
+    --                  
+    --                  It is assumed that negative timing constraints 
+    --                  are handled by internally delaying the test or 
+    --                  reference signals.  Negative recovery times result in 
+    --                  a delayed reference signal.  Negative removal times 
+    --                  result in a delayed test signal.  Furthermore, the 
+    --                  delays and constraints associated with these and
+    --                  other signals may need to be appropriately
+    --                  adjusted so that all constraint intervals overlap 
+    --                  the delayed reference signals and all constraint
+    --                  values (with respect to the delayed signals) are
+    --                  non-negative.
+    --                  
+    -- Arguments:         
+    --
+    --  IN               Type             Description
+    --   TestSignal       std_ulogic       Value of TestSignal.  The routine is
+    --   TestSignalName   STRING           Name of TestSignal 
+    --   TestDelay        TIME             Model internal delay associated with
+    --                                     the TestSignal
+    --   RefSignal        std_ulogic       Value of RefSignal
+    --   RefSignalName    STRING           Name of RefSignal
+    --   RefDelay         TIME             Model internal delay associated with
+    --                                     the RefSignal
+    --   Recovery         TIME             A change to an unasserted value on
+    --                                     the asynchronous TestSignal must
+    --                                     precede reference edge (on RefSignal)
+    --                                     by at least this time.
+    --   Removal          TIME             An asserted condition must be present
+    --                                     on the asynchronous TestSignal for at
+    --                                     least the removal time following a
+    --                                     reference edge on RefSignal.
+    --   ActiveLow        BOOLEAN          A flag which indicates if TestSignal
+    --                                     is asserted when it is low - "0."
+    --                                     FALSE indicate that TestSignal is
+    --                                     asserted when it has a value "1."
+    --   CheckEnabled     BOOLEAN          The check in enabled when the value
+    --                                     is TRUE, otherwise the constraints 
+    --                                     are not checked.
+    --   RefTransition    VitalEdgeSymbolType  
+    --                                     Reference edge specifier.  Events on
+    --                                     RefSignal will match the edge
+    --                                     specified.
+    --   HeaderMsg         STRING          A header message that will accompany
+    --                                     any assertion message.
+    --   XOn               BOOLEAN         When TRUE, the output Violation is
+    --                                     set to "X."  When FALSE, it is always 
+    --                                     "0."
+    --   MsgOn             BOOLEAN         When TRUE, violation messages are
+    --                                     output.  When FALSE, no messages are
+    --                                     generated.
+    --   MsgSeverity       SEVERITY_LEVEL  Severity level of the asserted
+    --                                     message.
+    --   EnableRecOnTest   BOOLEAN         If FALSE at the time that the 
+    --                                     TestSignal signal changes, 
+    --                                     no recovery check will be performed.
+    --   EnableRecOnRef    BOOLEAN         If FALSE at the time that the 
+    --                                     RefSignal signal changes, 
+    --                                     no recovery check will be performed.
+    --   EnableRemOnRef    BOOLEAN         If FALSE at the time that the 
+    --                                     RefSignal signal changes, 
+    --                                     no removal check will be performed.
+    --   EnableRemOnTest   BOOLEAN         If FALSE at the time that the 
+    --                                     TestSignal signal changes, 
+    --                                     no removal check will be performed.
+    --                             
+    --   INOUT
+    --    TimingData       VitalTimingDataType 
+    --                                     VitalRecoveryRemovalCheck information
+    --                                     storage area.  This is used
+    --                                     internally to detect reference edges
+    --                                     and record the time of the last edge.
+    --   OUT
+    --    Violation        X01             This is the violation flag returned.
+    --
+    --   Returns              
+    --           none
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalRecoveryRemovalCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_ulogic;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT Recovery      : IN     TIME := 0 ns;
+            CONSTANT Removal       : IN     TIME := 0 ns;
+            CONSTANT ActiveLow     : IN     BOOLEAN := TRUE;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING;
+    	    CONSTANT EnableRecOnTest : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableRecOnRef  : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableRemOnRef  : IN   BOOLEAN := TRUE;	--IR252 3/23/98
+	        CONSTANT EnableRemOnTest : IN   BOOLEAN := TRUE		--IR252 3/23/98
+    );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:  VitalPeriodPulseCheck
+    --
+    -- Description:    VitalPeriodPulseCheck checks for minimum
+    --                 periodicity and pulse width for "1" and "0" values of
+    --                 the input test signal.  The timing constraint is 
+    --                 specified through parameters representing the minimal
+    --                 period between successive rising and falling edges of
+    --                 the input test signal and the minimum pulse widths 
+    --                 associated with high and low values.  
+    --                 
+    --                 VitalPeriodCheck's accepts rising and falling edges
+    --                 from 1 and 0 as well as transitions to and from 'X.'
+    --                 
+    --                    _______________         __________
+    --       ____________|               |_______|
+    --
+    --                   |<--- pw_hi --->|
+    --                   |<-------- period ----->|
+    --                                -->| pw_lo |<--
+    --                 
+    -- Arguments:
+    --  IN                 Type           Description
+    --    TestSignal        std_ulogic     Value of test signal  
+    --    TestSignalName    STRING         Name of the test signal
+    --    TestDelay         TIME           Model's internal delay associated
+    --                                     with TestSignal
+    --    Period            TIME           Minimum period allowed between
+    --                                     consecutive rising ('P') or 
+    --                                     falling ('F') transitions.
+    --    PulseWidthHigh    TIME           Minimum time allowed for a high
+    --                                     pulse ('1' or 'H')
+    --    PulseWidthLow     TIME           Minimum time allowed for a low
+    --                                     pulse ('0' or 'L')
+    --    CheckEnabled      BOOLEAN        Check performed if TRUE.
+    --    HeaderMsg         STRING         String that will accompany any
+    --                                     assertion messages produced.   
+    --    XOn               BOOLEAN        If TRUE, Violation output parameter
+    --                                     is set to "X". Otherwise, Violation
+    --                                     is always set to "0".
+    --                                     XOnChecks is a global that allows for
+    --                                     only timing checks to be turned on. 
+    --    MsgOn             BOOLEAN        If TRUE, period/pulse violation
+    --                                     message will be generated.
+    --                                     Otherwise, no messages are generated,
+    --                                     even though a violation is detected.
+    --                                     MsgOnChecks allows for only timing
+    --                                     check messages to be turned on. 
+    --    MsgSeverity       SEVERITY_LEVEL Severity level for the assertion.
+    --         
+    --   INOUT
+    --    PeriodData        VitalPeriodDataType 
+    --                                     VitalPeriodPulseCheck information
+    --                                     storage area.  This is used
+    --                                     internally to detect reference edges
+    --                                     and record the pulse and period
+    --                                     times.
+    --   OUT
+    --    Violation         X01            This is the violation flag returned. 
+    --
+    --   Returns              
+    --    none
+    --
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalPeriodPulseCheck  (
+            VARIABLE Violation      : OUT    X01;
+            VARIABLE PeriodData     : INOUT  VitalPeriodDataType;
+            SIGNAL   TestSignal     : IN     std_ulogic;
+            CONSTANT TestSignalName : IN     STRING := "";
+            CONSTANT TestDelay      : IN     TIME := 0 ns;
+            CONSTANT Period         : IN     TIME := 0 ns;
+            CONSTANT PulseWidthHigh : IN     TIME := 0 ns;
+            CONSTANT PulseWidthLow  : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled   : IN     BOOLEAN := TRUE;
+            CONSTANT HeaderMsg      : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING
+        );
+ 
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:  VitalInPhaseSkewCheck
+    --
+    -- Description:    The VitalInPhaseSkewCheck procedure detects an in-phase
+    --                 skew violation between input signals Signal1 and Signal2.
+    --                 This is a timer based skew check in which a
+    --                 violation is detected if Signal1 and Signal2 are in
+    --                 different logic states longer than the specified skew 
+    --                 interval.
+    --
+    --                 The timing constraints are specified through parameters
+    --                 representing the skew values for the different states
+    --                 of Signal1 and Signal2.
+    --
+    --
+    -- Signal2    XXXXXXXXXXXX___________________________XXXXXXXXXXXXXXXXXXXXXX
+    --            :
+    --            :        -->|                         |<--
+    --            :      Signal2 should go low in this region
+    --            :
+    --
+    --            ____________
+    -- Signal1                \_________________________________________________
+    --            :           |                         |
+    --            :           |<-------- tskew -------->|
+    --
+    -- Arguments:
+    --
+    --  IN                 Type           Description
+    --   Signal1            std_ulogic     Value of first signal
+    --   Signal1Name        STRING         Name of first signal
+    --   Signal1Delay       TIME           Model's internal delay associated
+    --                                     with Signal1
+    --   Signal2            std_ulogic     Value of second signal
+    --   Signal2Name        STRING         Name of second signal
+    --   Signal2Delay       TIME           Model's internal delay associated
+    --                                     with Signal2
+    --   SkewS1S2RiseRise   TIME           Absolute maximum time duration for
+    --                                     which Signal2 can remain at "0"
+    --                                     after Signal1 goes to the "1" state,
+    --                                     without causing a skew violation.
+    --   SkewS2S1RiseRise   TIME           Absolute maximum time duration for
+    --                                     which Signal1 can remain at "0"
+    --                                     after Signal2 goes to the "1" state,
+    --                                     without causing a skew violation.
+    --   SkewS1S2FallFall   TIME           Absolute maximum time duration for
+    --                                     which Signal2 can remain at "1"
+    --                                     after Signal1 goes to the "0" state,
+    --                                     without causing a skew violation.
+    --   SkewS2S1FallFall   TIME           Absolute maximum time duration for
+    --                                     which Signal1 can remain at "1"
+    --                                     after Signal2 goes to the "0" state,
+    --                                     without causing a skew violation.
+    --   CheckEnabled       BOOLEAN        Check performed if TRUE.
+    --   HeaderMsg          STRING         String that will accompany any
+    --                                     assertion messages produced.
+    --   XOn                BOOLEAN        If TRUE, Violation output parameter
+    --                                     is set to "X". Otherwise, Violation
+    --                                     is always set to "0."      
+    --   MsgOn              BOOLEAN        If TRUE, skew timing violation 
+    --                                     messages will be generated.
+    --                                     Otherwise, no messages are generated,
+    --                                     even upon violations.      
+    --   MsgSeverity        SEVERITY_LEVEL Severity level for the assertion.
+    --
+    --  INOUT
+    --   SkewData           VitalSkewDataType
+    --                                     VitalInPhaseSkewCheck information
+    --                                     storage area.  This is used
+    --                                     internally to detect signal edges
+    --                                     and record the time of the last edge.
+    -- 
+    --
+    --   Trigger            std_ulogic     This signal is used to trigger the
+    --                                     process in which the timing check
+    --                                     occurs upon expiry of the skew
+    --                                     interval.
+    --
+    --  OUT
+    --   Violation   X01                   This is the violation flag returned.
+    --
+    --  Returns
+    --   none
+    --
+    -- -------------------------------------------------------------------------
+
+    PROCEDURE VitalInPhaseSkewCheck (
+        VARIABLE Violation         : OUT    X01;
+        VARIABLE SkewData          : INOUT  VitalSkewDataType;
+        SIGNAL   Signal1           : IN     std_ulogic;
+        CONSTANT Signal1Name       : IN     STRING := "";
+        CONSTANT Signal1Delay      : IN     TIME := 0 ns;
+        SIGNAL   Signal2           : IN     std_ulogic;
+        CONSTANT Signal2Name       : IN     STRING := "";
+        CONSTANT Signal2Delay      : IN     TIME := 0 ns;
+        CONSTANT SkewS1S2RiseRise  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS2S1RiseRise  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS1S2FallFall  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS2S1FallFall  : IN     TIME := TIME'HIGH;
+        CONSTANT CheckEnabled      : IN     BOOLEAN := TRUE;
+        CONSTANT XOn               : IN     BOOLEAN := TRUE;
+        CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+        CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+        CONSTANT HeaderMsg         : IN     STRING  := "";
+        SIGNAL   Trigger           : INOUT  std_ulogic
+    );
+
+
+  -- ------------------------------------------------------------------------
+    --
+    -- Function Name:  VitalOutPhaseSkewCheck
+    --
+    -- Description:    The VitalOutPhaseSkewCheck procedure detects an 
+    --                 out-of-phase skew violation between input signals Signal1
+    --                 and Signal2. This is a timer based skew check in
+    --                 which a violation is detected if Signal1 and Signal2 are
+    --                 in the same logic state longer than the specified skew
+    --                 interval.  
+    --
+    --                 The timing constraints are specified through parameters
+    --                 representing the skew values for the different states
+    --                 of Signal1 and Signal2.
+    --
+    --
+    -- Signal2    XXXXXXXXXXXX___________________________XXXXXXXXXXXXXXXXXXXXXX
+    --            :
+    --            :        -->|                         |<--
+    --            :     Signal2 should go high in this region
+    --            :
+    --
+    --            ____________
+    -- Signal1                \_________________________________________________  
+    --            :           |                         |
+    --            :           |<-------- tskew -------->|
+    --
+    -- Arguments:
+    --
+    --  IN                 Type           Description
+    --   Signal1            std_ulogic     Value of first signal
+    --   Signal1Name        STRING         Name of first signal
+    --   Signal1Delay       TIME           Model's internal delay associated
+    --                                     with Signal1
+    --   Signal2            std_ulogic     Value of second signal
+    --   Signal2Name        STRING         Name of second signal
+    --   Signal2Delay       TIME           Model's internal delay associated
+    --                                     with Signal2
+    --   SkewS1S2RiseFall   TIME           Absolute maximum time duration for
+    --                                     which Signal2 can remain at "1"
+    --                                     after Signal1 goes to the "1" state,
+    --                                     without causing a skew violation.
+    --   SkewS2S1RiseFall   TIME           Absolute maximum time duration for
+    --                                     which Signal1 can remain at "1"
+    --                                     after Signal2 goes to the "1" state,
+    --                                     without causing a skew violation.
+    --   SkewS1S2FallRise   TIME           Absolute maximum time duration for
+    --                                     which Signal2 can remain at "0"
+    --                                     after Signal1 goes to the "0" state,
+    --                                     without causing a skew violation.
+    --   SkewS2S1FallRise   TIME           Absolute maximum time duration for
+    --                                     which Signal1 can remain at "0"
+    --                                     after Signal2 goes to the "0" state,
+    --                                     without causing a skew violation.
+    --   CheckEnabled       BOOLEAN        Check performed if TRUE.
+    --   HeaderMsg          STRING         String that will accompany any
+    --                                     assertion messages produced.
+    --   XOn                BOOLEAN        If TRUE, Violation output parameter
+    --                                     is set to "X". Otherwise, Violation
+    --                                     is always set to "0."
+    --   MsgOn              BOOLEAN        If TRUE, skew timing violation
+    --                                     messages will be generated.
+    --                                     Otherwise, no messages are generated,
+    --                                     even upon violations.
+    --   MsgSeverity        SEVERITY_LEVEL Severity level for the assertion.
+    --
+    --  INOUT
+    --   SkewData           VitalSkewDataType
+    --                                     VitalInPhaseSkewCheck information
+    --                                     storage area.  This is used
+    --                                     internally to detect signal edges
+    --                                     and record the time of the last edge.
+    --
+    --   Trigger            std_ulogic     This signal is used to trigger the
+    --                                     process in which the timing check
+    --                                     occurs upon expiry of the skew
+    --                                     interval.
+    --
+    --  OUT
+    --   Violation   X01                   This is the violation flag returned.
+    --
+    --  Returns
+    --   none
+    --
+    -- ------------------------------------------------------------------------- 
+    PROCEDURE VitalOutPhaseSkewCheck (
+        VARIABLE Violation         : OUT    X01;
+        VARIABLE SkewData          : INOUT  VitalSkewDataType;
+        SIGNAL   Signal1           : IN     std_ulogic;
+        CONSTANT Signal1Name       : IN     STRING := "";
+        CONSTANT Signal1Delay      : IN     TIME := 0 ns;
+        SIGNAL   Signal2           : IN     std_ulogic;
+        CONSTANT Signal2Name       : IN     STRING := "";
+        CONSTANT Signal2Delay      : IN     TIME := 0 ns;
+        CONSTANT SkewS1S2RiseFall  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS2S1RiseFall  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS1S2FallRise  : IN     TIME := TIME'HIGH;
+        CONSTANT SkewS2S1FallRise  : IN     TIME := TIME'HIGH;
+        CONSTANT CheckEnabled      : IN     BOOLEAN := TRUE;
+        CONSTANT XOn               : IN     BOOLEAN := TRUE;
+        CONSTANT MsgOn             : IN     BOOLEAN := TRUE;
+        CONSTANT MsgSeverity       : IN     SEVERITY_LEVEL := WARNING;
+        CONSTANT HeaderMsg         : IN     STRING  := "";
+        SIGNAL   Trigger           : INOUT  std_ulogic
+    );
+
+
+END VITAL_Timing;
diff --git a/libraries/vital95/vital_primitives.vhdl b/libraries/vital95/vital_primitives.vhdl
new file mode 100644
index 000000000..d0da36ba0
--- /dev/null
+++ b/libraries/vital95/vital_primitives.vhdl
@@ -0,0 +1,1410 @@
+-- -----------------------------------------------------------------------------
+-- Title        : Standard VITAL_Primitives Package
+--              : $Revision: 597 $
+--              :
+-- Library      : This package shall be compiled into a library
+--              : symbolically named IEEE.
+--              :
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              :
+-- Purpose      : This packages defines standard types, constants, functions
+--              : and procedures for use in developing ASIC models.
+--              : Specifically a set of logic primitives are defined.
+--              :
+-- Known Errors :
+--              :
+-- Note         : No declarations or definitions shall be included in,
+--              : or excluded from this package. The "package declaration"
+--              : defines the objects (types, subtypes, constants, functions,
+--              : procedures ... etc.) that can be used by a user.  The package
+--              : body shall be considered the formal definition of the
+--              : semantics of this package.  Tool developers may choose to
+--              : implement the package body in the most efficient manner
+--              : available to them.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Acknowledgments:
+--   This code was originally developed under the "VHDL Initiative Toward ASIC
+--   Libraries" (VITAL), an industry sponsored initiative.  Technical
+--   Director: William Billowitch, VHDL Technology Group; U.S. Coordinator:
+--   Steve Schultz;  Steering Committee Members: Victor Berman, Cadence Design
+--   Systems; Oz Levia, Synopsys Inc.; Ray Ryan, Ryan & Ryan; Herman van Beek,
+--   Texas Instruments; Victor Martin, Hewlett-Packard Company.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History :
+-- ----------------------------------------------------------------------------
+-- Version No:|Auth:| Mod.Date:| Changes Made:
+--   v95.0 A  |     | 06/02/95 | Initial ballot draft 1995
+-- ----------------------------------------------------------------------------
+--
+LIBRARY IEEE;
+USE     IEEE.Std_Logic_1164.ALL;
+USE     IEEE.VITAL_Timing.ALL;
+
+PACKAGE VITAL_Primitives IS
+    -- ------------------------------------------------------------------------
+    -- Type and Subtype Declarations
+    -- ------------------------------------------------------------------------
+
+    -- For Truth and State Tables
+    SUBTYPE VitalTruthSymbolType IS VitalTableSymbolType RANGE 'X' TO 'Z';
+    SUBTYPE VitalStateSymbolType IS VitalTableSymbolType RANGE '/' TO 'S';
+
+    TYPE VitalTruthTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> )
+         OF VitalTruthSymbolType;
+    TYPE VitalStateTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> )
+         OF VitalStateSymbolType;
+
+    -- ---------------------------------
+    -- Default values used by primitives
+    -- ---------------------------------
+    CONSTANT VitalDefDelay01  : VitalDelayType01;       -- Propagation delays
+    CONSTANT VitalDefDelay01Z : VitalDelayType01Z;
+
+    -- ------------------------------------------------------------------------
+    -- VITAL Primitives
+    -- 
+    --   The primitives packages contains a collections of common gates, 
+    -- including AND, OR, XOR, NAND, NOR, XNOR, BUF, INV, MUX and DECODER 
+    -- functions.  In addition, for sequential devices, a STATE TABLE construct
+    -- is provided.  For complex functions a modeler may wish to use either
+    -- a collection of connected VITAL primitives, or a TRUTH TABLE construct.
+    --
+    --   For each primitive a Function and Procedure is provided.  The primitive
+    -- functions are provided to support behavioral modeling styles.  The 
+    -- primitive procedures are provided to support structural modeling styles.
+    --
+    --   The procedures wait internally for an event on an input signal, compute
+    -- the new result, perform glitch handling, schedule transaction on the
+    -- output signals, and wait for future input events.  All of the functional 
+    -- (logic) input or output parameters of the primitive procedures are
+    -- signals.  All the other parameters are constants.
+    --
+    --   The procedure primitives are parameterized for separate path delays 
+    -- from each input signal.  All path delays default to 0 ns.
+    -- 
+    --   The sequential primitive functions compute the defined function and 
+    -- return a value of type std_ulogic or std_logic_vector.  All parameters
+    -- of the primitive functions are constants of mode IN.
+    --
+    --   The primitives are based on 1164 operators. The user may also elect to
+    --   express functions using the 1164 operators as well.  These styles are
+    --   all equally acceptable methods for device modeling.
+    --
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   N-input logic device function calls:
+    --                    VitalAND  VitalOR  VitalXOR 
+    --                    VitalNAND VitalNOR VitalXNOR             
+    --
+    -- Description:     The function calls return the evaluated logic function
+    --                  corresponding to the function name.
+    --
+    -- Arguments:         
+    --
+    --  IN                Type                  Description
+    --   Data              std_logic_vector      The input signals for the n-bit
+    --                                           wide logic functions.
+    --   ResultMap         VitalResultMapType    The output signal strength
+    --                                           result map to modify default
+    --                                           result mapping.  
+    --                    
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                      std_ulogic           The evaluated logic function of
+    --                                           the n-bit wide primitives.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalAND    (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalOR     (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXOR    (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNAND   (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNOR    (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXNOR   (
+            CONSTANT      Data : IN std_logic_vector;
+            CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  N-input logic device concurrent procedure calls.
+    --                         VitalAND  VitalOR  VitalXOR 
+    --                         VitalNAND VitalNOR VitalXNOR             
+    --
+    -- Description:     The procedure calls return the evaluated logic function
+    --                  corresponding to the function name as a parameter to the
+    --                  procedure.  Propagation delay form data to q is a
+    --                  a parameter to the procedure.  A vector of delay values
+    --                  for inputs to output are provided.  It is noted that
+    --                  limitations in SDF make the back annotation of the delay
+    --                  array difficult.
+    --
+    -- Arguments:         
+    --
+    --  IN                  Type                  Description
+    --   Data               std_logic_vector       The input signals for the n-
+    --                                             bit wide logic functions.
+    --   tpd_data_q         VitalDelayArrayType01  The propagation delay from
+    --                                             the data inputs to the output
+    --                                             q.
+    --
+    --  INOUT
+    --   none 
+    --
+    --  OUT
+    --   q                  std_ulogic             The output signal of the 
+    --                                             evaluated logic function.
+    --
+    --  Returns  
+    --   none            
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalAND   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalOR    (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXOR   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNAND  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNOR   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXNOR  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   2,3 and 4 input logic device function calls.
+    -- 
+    --                    VitalAND2    VitalOR2    VitalXOR2 
+    --                    VitalAND3    VitalOR3    VitalXOR3             
+    --                    VitalAND4    VitalOR4    VitalXOR4
+    -- 
+    --                    VitalNAND2   VitalNOR2   VitalXNOR2             
+    --                    VitalNAND3   VitalNOR3   VitalXNOR3 
+    --                    VitalNAND4   VitalNOR4   VitalXNOR4             
+    --
+    -- Description:     The function calls return the evaluated 2, 3 or 4 input
+    --                  logic function corresponding to the function name.
+    --
+    -- Arguments:         
+    --
+    --  IN             Type               Description
+    --   a, b, c, d     std_ulogic         2 input devices have a and b as 
+    --                                     inputs.  3 input devices have a, b
+    --                                     and c as inputs.  4 input devices 
+    --                                     have a, b, c and d as inputs.
+    --   ResultMap      VitalResultMapType The output signal strength result map
+    --                                     to modify default result mapping.   
+    --                    
+    --  INOUT
+    --   none  
+    --
+    --  OUT
+    --   none 
+    --
+    --  Returns              
+    --                   std_ulogic        The result of the evaluated logic
+    --                                     function.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalAND2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalOR2    (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXOR2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNAND2  (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNOR2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXNOR2  (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalAND3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalOR3    (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXOR3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNAND3  (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNOR3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXNOR3  (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalAND4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalOR4    (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXOR4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNAND4  (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalNOR4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalXNOR4  (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  2, 3 and 4 input logic device concurrent procedure
+    --                  calls.
+    --
+    --                    VitalAND2    VitalOR2    VitalXOR2 
+    --                    VitalAND3    VitalOR3    VitalXOR3             
+    --                    VitalAND4    VitalOR4    VitalXOR4
+    -- 
+    --                    VitalNAND2   VitalNOR2   VitalXNOR2             
+    --                    VitalNAND3   VitalNOR3   VitalXNOR3 
+    --                    VitalNAND4   VitalNOR4   VitalXNOR4             
+    --
+    -- Description:     The procedure calls return the evaluated logic function
+    --                  corresponding to the function name as a parameter to the
+    --                  procedure.  Propagation delays from a and b to q are 
+    --                  a parameter to the procedure.  The default propagation
+    --                  delay is 0 ns.  
+    --
+    -- Arguments:         
+    --
+    --  IN             Type               Description
+    --   a, b, c, d     std_ulogic         2 input devices have a and b as 
+    --                                     inputs.  3 input devices have a, b
+    --                                     and c as inputs.  4 input devices 
+    --                                     have a, b, c and d as inputs.
+    --   tpd_a_q        VitalDelayType01   The propagation delay from the a
+    --                                     input to output q for 2, 3 and 4 
+    --                                     input devices.
+    --   tpd_b_q        VitalDelayType01   The propagation delay from the b
+    --                                     input to output q for 2, 3 and 4 
+    --                                     input devices.
+    --   tpd_c_q        VitalDelayType01   The propagation delay from the c
+    --                                     input to output q for 3 and 4 input 
+    --                                     devices.
+    --   tpd_d_q        VitalDelayType01   The propagation delay from the d
+    --                                     input to output q for 4 input 
+    --                                     devices.
+    --   ResultMap      VitalResultMapType The output signal strength result map
+    --                                     to modify default result mapping.  
+    --
+    --  INOUT
+    --   none 
+    --
+    --  OUT
+    --   q              std_ulogic         The output signal of the evaluated
+    --                                     logic function.
+    --
+    --  Returns              
+    --   none
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalAND2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalOR2   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXOR2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNAND2 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNOR2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXNOR2 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalAND3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalOR3   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXOR3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNAND3 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNOR3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXNOR3 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalAND4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalOR4   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXOR4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNAND4 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalNOR4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    PROCEDURE VitalXNOR4 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   Buffer logic device concurrent procedure calls.
+    --
+    -- Description:     Four buffer sequential primitive function calls are
+    --                  provided.  One is a simple buffer and the others 
+    --                  offer high and low enables and the four permits
+    --                  propagation of Z as shown below:
+    -- 
+    --                     VitalBUF     Standard non-inverting buffer
+    --                     VitalBUFIF0  Non-inverting buffer with Enable low
+    --                     VitalBUFIF1  Non-inverting buffer with Enable high
+    --                     VitalIDENT   Pass buffer capable of propagating Z
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   Data          std_ulogic          Input to the buffers
+    --   Enable        std_ulogic          Enable for the enable high and low
+    --                                     buffers.
+    --   ResultMap     VitalResultMapType  The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     simple buffer.  
+    --                 VitalResultZMapType The output signal strength result map
+    --                                     to modify default result mapping
+    --                                     which has high impedance capability
+    --                                     for the enable high, enable low and
+    --                                     identity buffers.
+    --                    
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                  std_ulogic        The output signal of the evaluated 
+    --                                    buffer function.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalBUF    (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+    FUNCTION VitalBUFIF0 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+    FUNCTION VitalBUFIF1 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+    FUNCTION VitalIDENT  (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  Buffer device procedure calls. 
+    --
+    -- Description:     Four buffer concurrent primitive procedure calls are
+    --                  provided.  One is a simple buffer and the others 
+    --                  offer high and low enables and the fourth permits
+    --                  propagation of Z as shown below:
+    -- 
+    --                     VitalBUF     Standard non-inverting buffer
+    --                     VitalBUFIF0  Non-inverting buffer with Enable low
+    --                     VitalBUFIF1  Non-inverting buffer with Enable high
+    --                     VitalIDENT   Pass buffer capable of propagating Z
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   a             std_ulogic          Input signal to the buffers
+    --   Enable        std_ulogic          Enable signal for the enable high and 
+    --                                     low buffers.
+    --   tpd_a_q       VitalDelayType01    Propagation delay from input to 
+    --                                     output for the simple buffer.
+    --                 VitalDelayType01Z   Propagation delay from input to 
+    --                                     to output for the enable high and low
+    --                                     and identity buffers.
+    --   tpd_enable_q  VitalDelayType01Z   Propagation delay from enable to
+    --                                     output for the enable high and low
+    --                                     buffers.
+    --   ResultMap     VitalResultMapType  The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     simple buffer.  
+    --                 VitalResultZMapType The output signal strength result map
+    --                                     to modify default result mapping
+    --                                     which has high impedance capability
+    --                                     for the enable high, enable low and
+    --                                     identity buffers.
+    --                    
+    -- INOUT
+    --  none   
+    --
+    -- OUT
+    --  q              std_ulogic          Output of the buffers.   
+    --
+    -- Returns 
+    --  none             
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalBUF   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalBUFIF0 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap);
+
+
+    PROCEDURE VitalBUFIF1 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap);
+
+    PROCEDURE VitalIDENT (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT  ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   VitalINV, VitalINVIF0, VitalINVIF1
+    --
+    -- Description:     Inverter functions which return the inverted signal
+    --                  value.  Inverters with enable low and high are provided
+    --                  which can drive high impedance when inactive.
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   Data          std_ulogic          Input to the inverter
+    --   Enable        std_ulogic          Enable to the enable high and low
+    --                                     inverters.
+    --   ResultMap     VitalResultMap      The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     simple inverter.
+    --                 VitalResultZMapType The output signal strength result map
+    --                                     to modify default result mapping
+    --                                     which has high impedance capability
+    --                                     for the enable high, enable low
+    --                                     inverters.
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                 std_ulogic          Output of the inverter
+    --
+    -- -------------------------------------------------------------------------
+
+    FUNCTION VitalINV    (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalINVIF0 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalINVIF1 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  VitalINV, VitalINVIF0, VitalINVIF1
+    --
+    -- Description:     The concurrent primitive procedure calls implement a 
+    --                  signal inversion function.  The output is a parameter to
+    --                  the procedure.  The path delay information is passed as
+    --                  a parameter to the call.
+    --                  
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   a             std_ulogic          Input signal for the simple inverter
+    --   Data          std_ulogic          Input signal for the enable high and
+    --                                     low inverters.
+    --   Enable        std_ulogic          Enable signal for the enable high and 
+    --                                     low inverters.
+    --   tpd_a_q       VitalDelayType01    Propagation delay from input a to
+    --                                     output q for the simple inverter.
+    --   tpd_data_q    VitalDelayType01    Propagation delay from input data to
+    --                                     output q for the enable high and low
+    --                                     inverters.
+    --   tpd_enable_q  VitalDelayType01Z   Propagation delay from input enable
+    --                                     to output q for the enable high and 
+    --                                     low inverters.
+    --   ResultMap     VitalResultMapType  The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     simple inverter. 
+    --                 VitalResultZMapType The output signal strength result map
+    --                                     to modify default result mapping
+    --                                     which has high impedance capability
+    --                                     for the enable high, enable low
+    --                                     inverters.
+    --                
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   q               std_ulogic        Output signal of the inverter.
+    --
+    --  Returns              
+    --   none
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalINV   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+    PROCEDURE VitalINVIF0 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap);
+
+    PROCEDURE VitalINVIF1 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap);
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   VitalMUX, VitalMUX2, VitalMUX4, VitalMUX8
+    --
+    -- Description:     The VitalMUX functions return the selected data bit 
+    --                  based on the value of dSelect.  For MUX2, the function
+    --                  returns data0 when dselect is 0 and returns data1 when
+    --                  dselect is 1.  When dselect is X, result is X for MUX2
+    --                  when data0 /= data1.  X propagation is reduced when the
+    --                  dselect signal is X and both data signals are identical.
+    --                  When this is the case, the result returned is the value
+    --                  of the data signals.
+    --
+    --                  For the N input device:
+    -- 
+    --                       N must equal 2**(bits of dSelect)  
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   Data           std_logic_vector   Input signal for the N-bit, 4-bit and 
+    --                                     8-bit mux.
+    --   Data1,Data0    std_ulogic         Input signals for the 2-bit mux.
+    --   dSelect        std_ulogic         Select signal for 2-bit mux
+    --                  std_logic_vector2  Select signal for 4-bit mux
+    --                  std_logic_vector3  Select signal for 8-bit mux
+    --                  std_logic_vector   Select signal for N-Bit mux
+    --   ResultMap      VitalResultMapType The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     all muxes. 
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                  std_ulogic         The value of the selected bit is 
+    --                                     returned.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalMUX   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT    dSelect :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalMUX2  (
+            CONSTANT Data1, Data0 :  IN std_ulogic;
+            CONSTANT      dSelect :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalMUX4  (
+            CONSTANT       Data :  IN std_logic_vector4;
+            CONSTANT    dSelect :  IN std_logic_vector2;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    FUNCTION VitalMUX8  (
+            CONSTANT       Data :  IN std_logic_vector8;
+            CONSTANT    dSelect :  IN std_logic_vector3;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  VitalMUX, VitalMUX2, VitalMUX4, VitalMUX8
+    --
+    -- Description:     The VitalMUX concurrent primitive procedures calls
+    --                  return in the output q the value of the selected data
+    --                  bit based on the value of dsel.  For the two bit mux,
+    --                  the data returned is either d0 or d1, the data input.
+    --                  For 4, 8 and N-bit functions, data is the input and is
+    --                  of type std_logic_vector.  For the 2-bit mux, if d0 or
+    --                  d1 are X, the output is X only when d0 do not equal d1.
+    --                  When d0 and d1 are equal, the return value is this value
+    --                  to reduce X propagation.
+    --
+    --                  Propagation delay information is passed as a parameter
+    --                  to the procedure call for delays from data to output and
+    --                  select to output.  For 2-bit muxes, the propagation
+    --                  delays from data are provided for d0 and d1 to output.
+    --                  
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                   Description
+    --   d1,d0          std_ulogic            Input signals for the 2-bit mux.
+    --   Data           std_logic_vector4     Input signals for the 4-bit mux.
+    --                  std_logic_vector8     Input signals for the 8-bit mux.
+    --                  std_logic_vector      Input signals for the N-bit mux.
+    --   dsel           std_ulogic            Select signal for the 2-bit mux.
+    --                  std_logic_vector2     Select signals for the 4-bit mux.
+    --                  std_logic_vector3     Select signals for the 8-bit mux.
+    --                  std_logic_vector      Select signals for the N-bit mux.
+    --   tpd_d1_q       VitalDelayType01      Propagation delay from input d1 to
+    --                                        output q for 2-bit mux.
+    --   tpd_d0_q       VitalDelayType01      Propagation delay from input d0 to
+    --                                        output q for 2-bit mux.
+    --   tpd_data_q     VitalDelayArrayType01 Propagation delay from input data
+    --                                        to output q for 4-bit, 8-bit and
+    --                                        N-bit muxes.
+    --   tpd_dsel_q     VitalDelayType01      Propagation delay from input dsel
+    --                                        to output q for 2-bit mux.
+    --                  VitalDelayArrayType01 Propagation delay from input dsel
+    --                                        to output q for 4-bit, 8-bit and
+    --                                        N-bit muxes.
+    --   ResultMap      VitalResultMapType    The output signal strength result
+    --                                        map to modify default result
+    --                                        mapping for all muxes.
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   q              std_ulogic            The value of the selected signal.
+    --
+    --  Returns              
+    --   none
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalMUX   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            SIGNAL         dSel :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalMUX2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL       d1, d0 :  IN std_ulogic;
+            SIGNAL         dSel :  IN std_ulogic;
+            CONSTANT   tpd_d1_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT   tpd_d0_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalMUX4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector4;
+            SIGNAL         dSel :  IN std_logic_vector2;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalMUX8  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector8;
+            SIGNAL         dSel :  IN std_logic_vector3;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Sequential 
+    -- Primitive
+    -- Function Name:   VitalDECODER, VitalDECODER2, VitalDECODER4,
+    --                  VitalDECODER8
+    --
+    -- Description:     The VitalDECODER functions are the sequential primitive
+    --                  calls for decoder logic.  The functions are provided
+    --                  for N, 2, 4 and 8-bit outputs.  
+    --
+    --                  The N-bit decoder is (2**(bits of data)) wide.
+    --
+    --                  The VitalDECODER returns 0 if enable is 0.
+    --                  The VitalDECODER returns the result bit set to 1 if 
+    --                  enable is 1.  All other bits of returned result are 
+    --                  set to 0.
+    --
+    --                  The returned array is in descending order: 
+    --                  (n-1 downto 0).
+    --   
+    -- Arguments:         
+    --
+    --  IN            Type                Description
+    --   Data          std_ulogic          Input signal for 2-bit decoder.
+    --                 std_logic_vector2   Input signals for 4-bit decoder.
+    --                 std_logic_vector3   Input signals for 8-bit decoder.
+    --                 std_logic_vector    Input signals for N-bit decoder.
+    --   Enable        std_ulogic          Enable input signal.  The result is
+    --                                     output when enable is high.
+    --   ResultMap     VitalResultMapType  The output signal strength result map
+    --                                     to modify default result mapping for
+    --                                     all output signals of the decoders. 
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --                 std_logic_vector2  The output of the 2-bit decoder.
+    --                 std_logic_vector4  The output of the 4-bit decoder.
+    --                 std_logic_vector8  The output of the 8-bit decoder.   
+    --                 std_logic_vector   The output of the n-bit decoder.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalDECODER   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector;
+
+    FUNCTION VitalDECODER2  (
+            CONSTANT       Data :  IN std_ulogic;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector2;
+
+    FUNCTION VitalDECODER4  (
+            CONSTANT       Data :  IN std_logic_vector2;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector4;
+
+    FUNCTION VitalDECODER8  (
+            CONSTANT       Data :  IN std_logic_vector3;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector8;
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Concurrent
+    -- Primitive
+    -- Procedure Name:  VitalDECODER, VitalDECODER2, VitalDECODER4,
+    --                  VitalDECODER8
+    --
+    -- Description:     The VitalDECODER procedures are the concurrent primitive 
+    --                  procedure calls for decoder functions.  The procedures 
+    --                  are provided for N, 2, 4 and 8 outputs.  
+    --
+    --                  The N-bit decoder is (2**(bits of data)) wide.
+    --
+    --                  The procedural form of the decoder is used for
+    --                  distributed delay modeling.  The delay information for
+    --                  each path is passed as an argument to the procedure.
+    --
+    --                  Result is set to 0 if enable is 0.
+    --                  The result bit represented by data is set to 1 if 
+    --                  enable is 1.  All other bits of result are set to 0.
+    --
+    --                  The result array is in descending order: (n-1 downto 0).
+    --   
+    --                  For the N-bit decoder, the delay path is a vector of
+    --                  delays from inputs to outputs.  
+    --
+    -- Arguments:         
+    --
+    --  IN            Type                  Description
+    --   Data          std_ulogic            Input signal for 2-bit decoder.
+    --                 std_logic_vector2     Input signals for 4-bit decoder.
+    --                 std_logic_vector3     Input signals for 8-bit decoder.
+    --                 std_logic_vector      Input signals for N-bit decoder.
+    --   enable        std_ulogic            Enable input signal.  The result is
+    --                                       output when enable is high. 
+    --   tpd_data_q    VitalDelayType01      Propagation delay from input data
+    --                                       to output q for 2-bit decoder.
+    --                 VitalDelayArrayType01 Propagation delay from input data
+    --                                       to output q for 4, 8 and n-bit
+    --                                       decoders.
+    --   tpd_enable_q  VitalDelayType01      Propagation delay from input enable
+    --                                       to output q for 2, 4, 8 and n-bit
+    --                                       decoders.
+    --
+    -- INOUT
+    --  none
+    --
+    -- OUT
+    --  q              std_logic_vector2     Output signals for 2-bit decoder. 
+    --                 std_logic_vector4     Output signals for 4-bit decoder.
+    --                 std_logic_vector8     Output signals for 8-bit decoder.
+    --                 std_logic_vector      Output signals for n-bit decoder.
+    --                        
+    -- Returns              
+    --  none
+    --
+    -- -------------------------------------------------------------------------    
+    PROCEDURE VitalDECODER   (
+            SIGNAL              q : OUT std_logic_vector;
+            SIGNAL           Data :  IN std_logic_vector;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+    PROCEDURE VitalDECODER2  (
+            SIGNAL              q : OUT std_logic_vector2;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    PROCEDURE VitalDECODER4  (
+            SIGNAL              q : OUT std_logic_vector4;
+            SIGNAL           Data :  IN std_logic_vector2;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+    PROCEDURE VitalDECODER8  (
+            SIGNAL              q : OUT std_logic_vector8;
+            SIGNAL           Data :  IN std_logic_vector3;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap );
+
+    -- -------------------------------------------------------------------------
+    -- Function Name:   VitalTruthTable
+    --
+    -- Description:     VitalTruthTable implements a truth table.  Given
+    --                  a set of inputs, a sequential search is performed
+    --                  to match the input.  If a match is found, the output
+    --                  is set based on the contents of the CONSTANT TruthTable.
+    --                  If there is no match, all X's are returned.  There is
+    --                  no limit to the size of the table.
+    --
+    --                  There is a procedure and function for VitalTruthTable.
+    --                  For each of these, a single value output (std_logic) and
+    --                  a multi-value output (std_logic_vector) are provided.
+    --
+    --                  The first dimension of the table is for number of
+    --                  entries in the truth table and second dimension is for
+    --                  the number of elements in a row. The number of inputs
+    --                  in the row should be Data'LENGTH plus result'LENGTH.
+    --
+    --                  Elements is a row will be interpreted as
+    --                  Input(NumInputs - 1),.., Input(0),
+    --                    Result(NumOutputs - 1),.., Result(0)
+    --
+    --                  All inputs will be mapped to the X01 subtype
+    --
+    --                  If the value of Result is not in the range 'X' to 'Z'
+    --                  then an error will be reported. Also, the Result is
+    --                  always given either as a 0, 1, X or Z value.
+    --
+    -- Arguments:         
+    --
+    --  IN            Type               Description
+    --                 TruthTable         The input constant which defines the
+    --                                    behavior in truth table form.
+    --                 DataIn             The inputs to the truth table used to
+    --                                    perform input match to select
+    --                                    output(s) to value(s) to drive.
+    --
+    --  INOUT
+    --   none                 
+    --
+    --  OUT
+    --   Result         std_logic         Concurrent procedure version scalar
+    --                                    output.
+    --                  std_logic_vector  Concurrent procedure version vector
+    --                                    output.
+    --
+    --  Returns              
+    --   Result         std_logic         Function version scalar output.
+    --                  std_logic_vector  Function version vector output.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalTruthTable  (
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+          ) RETURN std_logic_vector;
+
+    FUNCTION VitalTruthTable  (
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+          ) RETURN std_logic;
+
+    PROCEDURE VitalTruthTable (
+            SIGNAL   Result       : OUT std_logic_vector;
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+                              );
+    PROCEDURE VitalTruthTable (
+            SIGNAL   Result       : OUT std_logic;
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+                              );
+    -- -------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalStateTable
+    --
+    -- Description:     VitalStateTable is a non-concurrent implementation of a
+    --                  state machine (Moore Machine).  It is used to model
+    --                  sequential devices and devices with internal states.
+    --
+    --                  The procedure takes the value of the state table
+    --                  data set and performs a sequential search of the 
+    --                  CONSTANT StateTable until a match is found.  Once a 
+    --                  match is found, the result of that match is applied
+    --                  to Result.  If there is no match, all X's are returned.
+    --                  The resultant output becomes the input for the next 
+    --                  state.
+    --
+    --                  The first dimension of the table is the number of
+    --                  entries in the state table and second dimension is the
+    --                  number of elements in a row of the table. The number of
+    --                  inputs in the row should be DataIn'LENGTH. Result should
+    --                  contain the current state (which will become the next
+    --                  state) as well as the outputs
+    --
+    --                  Elements is a row of the table will be interpreted as
+    --                  Input(NumInputs-1),.., Input(0), State(NumStates-1),
+    --                   ..., State(0),Output(NumOutputs-1),.., Output(0)
+    -- 
+    --                  where State(numStates-1) DOWNTO State(0) represent the
+    --                  present state and Output(NumOutputs - 1) DOWNTO
+    --                  Outputs(NumOutputs - NumStates) represent the new
+    --                  values of the state variables (i.e. the next state).
+    --                  Also, Output(NumOutputs - NumStates - 1)
+    --
+    --                  This procedure returns the next state and the new
+    --                  outputs when a match is made between the present state
+    --                  and present inputs and the state table.  A search is
+    --                  made starting at the top of the state table and
+    --                  terminates with the first match.  If no match is found
+    --                  then the next state and new outputs are set to all 'X's.
+    --
+    --                  (Asynchronous inputs (i.e. resets and clears) must be
+    --                  handled by placing the corresponding entries at the top
+    --                  of the table. )
+    --
+    --                  All inputs will be mapped to the X01 subtype.
+    --
+    --                  NOTE:  Edge transitions should not be used as values
+    --                         for the state variables in the present state
+    --                         portion of the state table.  The only valid
+    --                         values that can be used for the present state
+    --                         portion of the state table are:
+    --                         'X', '0', '1', 'B', '-'
+    --
+    -- Arguments:         
+    --
+    --  IN             Type                 Description      
+    --   StateTable     VitalStateTableType  The input constant which defines
+    --                                       the behavior in state table form.
+    --   DataIn         std_logic_vector     The current state inputs to the
+    --                                       state table used to perform input
+    --                                       matches and transition
+    --                                       calculations.
+    --   NumStates      NATURAL              Number of state variables
+    --                    
+    --  INOUT
+    --   Result         std_logic            Output signal for scalar version of
+    --                                       the concurrent procedure call.
+    --                  std_logic_vector     Output signals for vector version
+    --                                       of the concurrent procedure call.
+    --   PreviousDataIn std_logic_vector     The previous inputs and states used
+    --                                       in transition calculations and to 
+    --                                       set outputs for steady state cases. 
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns  
+    --   none            
+    --
+    -- -------------------------------------------------------------------------
+   PROCEDURE VitalStateTable (
+            VARIABLE Result         : INOUT std_logic_vector;
+            VARIABLE PreviousDataIn : INOUT std_logic_vector;
+            CONSTANT StateTable     : IN VitalStateTableType;
+            CONSTANT DataIn         : IN  std_logic_vector;
+            CONSTANT NumStates      : IN NATURAL
+   );
+
+   PROCEDURE VitalStateTable (
+            VARIABLE Result         : INOUT std_logic;
+            VARIABLE PreviousDataIn : INOUT std_logic_vector;
+            CONSTANT StateTable     : IN VitalStateTableType;
+            CONSTANT DataIn         : IN  std_logic_vector
+   );
+
+   PROCEDURE VitalStateTable (
+            SIGNAL   Result     : INOUT std_logic_vector;
+            CONSTANT StateTable : IN VitalStateTableType;
+            SIGNAL   DataIn     : IN std_logic_vector;
+            CONSTANT NumStates  : IN NATURAL
+   );
+
+   PROCEDURE VitalStateTable (
+            SIGNAL   Result     : INOUT std_logic;
+            CONSTANT StateTable : IN VitalStateTableType;
+            SIGNAL   DataIn     : IN std_logic_vector
+   );
+
+    -- -------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalResolve
+    --
+    -- Description:     VitalResolve takes a vector of signals and resolves
+    --                  them to a std_ulogic value.  This procedure can be used
+    --                  to resolve multiple drivers in a single model.  
+    --                  
+    -- Arguments:         
+    --
+    --  IN           Type               Description
+    --   Data         std_logic_vector   Set of input signals which drive a
+    --                                   common signal.
+    --                    
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   q            std_ulogic         Output signal which is the resolved 
+    --                                   value being driven by the collection of
+    --                                   input signals.
+    --
+    --  Returns              
+    --   none
+    --                    
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalResolve (
+            SIGNAL              q : OUT std_ulogic;
+            CONSTANT         Data :  IN std_logic_vector);
+
+END VITAL_Primitives;
diff --git a/libraries/vital95/vital_primitives_body.vhdl b/libraries/vital95/vital_primitives_body.vhdl
new file mode 100644
index 000000000..25e834189
--- /dev/null
+++ b/libraries/vital95/vital_primitives_body.vhdl
@@ -0,0 +1,5614 @@
+-------------------------------------------------------------------------------
+-- Title        : Standard VITAL_Primitives Package
+--              : $Revision: 597 $
+--              :
+-- Library      : VITAL
+--              :
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              :
+-- Purpose      : This packages defines standard types, constants, functions
+--              : and procedures for use in developing ASIC models.
+--              : Specifically a set of logic primitives are defined.
+--              :  
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History : 
+-- ----------------------------------------------------------------------------
+-- Version No:|Auth:| Mod.Date:| Changes Made:
+--   v95.0 A  |     | 06/02/95 | Initial ballot draft 1995
+--   v95.1    |     | 08/31/95 | #204 - glitch detection prior to OutputMap
+-- ----------------------------------------------------------------------------
+
+LIBRARY STD;
+USE STD.TEXTIO.ALL;
+
+PACKAGE BODY VITAL_Primitives IS
+    -- ------------------------------------------------------------------------
+    --  Default values for Primitives
+    -- ------------------------------------------------------------------------
+    --  default values for delay parameters
+    CONSTANT VitalDefDelay01  : VitalDelayType01  := VitalZeroDelay01;
+    CONSTANT VitalDefDelay01Z : VitalDelayType01Z := VitalZeroDelay01Z;
+
+    TYPE VitalTimeArray IS ARRAY (NATURAL RANGE <>) OF TIME;    
+
+    --  default primitive model operation parameters
+    --  Glitch detection/reporting
+    TYPE VitalGlitchModeType IS ( MessagePlusX, MessageOnly, XOnly, NoGlitch);
+    CONSTANT PrimGlitchMode : VitalGlitchModeType   := XOnly;
+
+    -- ------------------------------------------------------------------------
+    -- Local Type and Subtype Declarations
+    -- ------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    -- enumeration value representing the transition or level of the signal.
+    --  See function 'GetEdge'
+    ---------------------------------------------------------------------------
+    TYPE EdgeType IS ( 'U',   -- Uninitialized level
+                       'X',   -- Unknown level
+                       '0',   -- low level
+                       '1',   -- high level
+                       '\',   -- 1 to 0 falling edge
+                       '/',   -- 0 to 1 rising  edge
+                       'F',   -- * to 0 falling edge
+                       'R',   -- * to 1 rising  edge
+                       'f',   -- rising  to X edge
+                       'r',   -- falling to X edge
+                       'x',   -- Unknown edge (ie U->X)
+                       'V'    -- Timing violation edge
+                     );
+    TYPE EdgeArray  IS ARRAY ( NATURAL RANGE <> ) OF EdgeType;
+
+    TYPE EdgeX1Table IS ARRAY ( EdgeType                          ) OF EdgeType;
+    TYPE EdgeX2Table IS ARRAY ( EdgeType, EdgeType                ) OF EdgeType;
+    TYPE EdgeX3Table IS ARRAY ( EdgeType, EdgeType, EdgeType      ) OF EdgeType;
+    TYPE EdgeX4Table IS ARRAY (EdgeType,EdgeType,EdgeType,EdgeType) OF EdgeType;
+
+    TYPE LogicToEdgeT  IS ARRAY(std_ulogic, std_ulogic) OF EdgeType;
+    TYPE LogicToLevelT IS ARRAY(std_ulogic ) OF EdgeType;
+
+    TYPE GlitchDataType IS 
+      RECORD 
+        SchedTime    : TIME; 
+        GlitchTime   : TIME; 
+        SchedValue   : std_ulogic;
+        CurrentValue    : std_ulogic; 
+      END RECORD; 
+    TYPE GlitchDataArrayType IS ARRAY (NATURAL RANGE <>) 
+         OF GlitchDataType;
+ 
+    -- Enumerated type used in selection of output path delays
+    TYPE SchedType  IS
+      RECORD
+        inp0  : TIME;   -- time (abs) of output change due to input change to 0
+        inp1  : TIME;   -- time (abs) of output change due to input change to 1
+        InpX  : TIME;   -- time (abs) of output change due to input change to X
+        Glch0 : TIME;   -- time (abs) of output glitch due to input change to 0
+        Glch1 : TIME;   -- time (abs) of output glitch due to input change to 0
+      END RECORD;
+
+    TYPE SchedArray  IS ARRAY ( NATURAL RANGE <> ) OF SchedType;
+    CONSTANT DefSchedType : SchedType := (TIME'HIGH, TIME'HIGH, 0 ns,0 ns,0 ns);
+    CONSTANT DefSchedAnd  : SchedType := (TIME'HIGH, 0 ns,0 ns, TIME'HIGH,0 ns);
+
+    -- Constrained array declarations (common sizes used by primitives)
+    SUBTYPE SchedArray2 IS SchedArray(1 DOWNTO 0);
+    SUBTYPE SchedArray3 IS SchedArray(2 DOWNTO 0);
+    SUBTYPE SchedArray4 IS SchedArray(3 DOWNTO 0);
+    SUBTYPE SchedArray8 IS SchedArray(7 DOWNTO 0);
+
+    SUBTYPE TimeArray2 IS VitalTimeArray(1 DOWNTO 0);
+    SUBTYPE TimeArray3 IS VitalTimeArray(2 DOWNTO 0);
+    SUBTYPE TimeArray4 IS VitalTimeArray(3 DOWNTO 0);
+    SUBTYPE TimeArray8 IS VitalTimeArray(7 DOWNTO 0);
+
+    SUBTYPE GlitchArray2 IS GlitchDataArrayType(1 DOWNTO 0);
+    SUBTYPE GlitchArray3 IS GlitchDataArrayType(2 DOWNTO 0);
+    SUBTYPE GlitchArray4 IS GlitchDataArrayType(3 DOWNTO 0);
+    SUBTYPE GlitchArray8 IS GlitchDataArrayType(7 DOWNTO 0);
+
+    SUBTYPE EdgeArray2 IS EdgeArray(1 DOWNTO 0);
+    SUBTYPE EdgeArray3 IS EdgeArray(2 DOWNTO 0);
+    SUBTYPE EdgeArray4 IS EdgeArray(3 DOWNTO 0);
+    SUBTYPE EdgeArray8 IS EdgeArray(7 DOWNTO 0);
+
+    CONSTANT DefSchedArray2 : SchedArray2 :=
+                             (OTHERS=> (0 ns, 0 ns, 0 ns, 0 ns, 0 ns));
+
+    TYPE stdlogic_table IS ARRAY(std_ulogic, std_ulogic) OF std_ulogic;
+
+    CONSTANT InitialEdge : LogicToLevelT := (
+            '1'|'H' => 'R',
+            '0'|'L' => 'F',
+            OTHERS  => 'x'
+     );
+
+    CONSTANT LogicToEdge  : LogicToEdgeT  := (  -- previous, current
+    --  old \ new: U    X    0    1    Z    W    L    H    -
+        'U' =>  ( 'U', 'x', 'F', 'R', 'x', 'x', 'F', 'R', 'x' ),
+        'X' =>  ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ),
+        '0' =>  ( 'r', 'r', '0', '/', 'r', 'r', '0', '/', 'r' ),
+        '1' =>  ( 'f', 'f', '\', '1', 'f', 'f', '\', '1', 'f' ),
+        'Z' =>  ( 'x', 'X', 'F', 'R', 'X', 'x', 'F', 'R', 'x' ),
+        'W' =>  ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ),
+        'L' =>  ( 'r', 'r', '0', '/', 'r', 'r', '0', '/', 'r' ),
+        'H' =>  ( 'f', 'f', '\', '1', 'f', 'f', '\', '1', 'f' ),
+        '-' =>  ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' )
+    );
+    CONSTANT LogicToLevel : LogicToLevelT := (
+            '1'|'H' => '1',
+            '0'|'L' => '0',
+            'U'     => 'U',
+            OTHERS  => 'X'
+     );
+
+    -- -----------------------------------
+    -- 3-state logic tables
+    -- -----------------------------------
+    CONSTANT BufIf0_Table : stdlogic_table :=
+        -- enable        data       value
+        ( '1'|'H'   => ( OTHERS  => 'Z' ),
+          '0'|'L'   => ( '1'|'H' => '1',
+                         '0'|'L' => '0',
+                         'U'     => 'U',
+                         OTHERS  => 'X' ),
+          'U'       => ( OTHERS  => 'U' ),
+          OTHERS    => ( OTHERS  => 'X' ) );
+    CONSTANT BufIf1_Table : stdlogic_table :=
+        -- enable        data       value
+        ( '0'|'L'   => ( OTHERS  => 'Z' ),
+          '1'|'H'   => ( '1'|'H' => '1',
+                         '0'|'L' => '0',
+                         'U'     => 'U',
+                         OTHERS  => 'X' ),
+          'U'       => ( OTHERS  => 'U' ),
+          OTHERS    => ( OTHERS  => 'X' ) );
+    CONSTANT InvIf0_Table : stdlogic_table :=
+        -- enable        data       value
+        ( '1'|'H'   => ( OTHERS  => 'Z' ),
+          '0'|'L'   => ( '1'|'H' => '0',
+                         '0'|'L' => '1',
+                         'U'     => 'U',
+                         OTHERS  => 'X' ),
+          'U'       => ( OTHERS  => 'U' ),
+          OTHERS    => ( OTHERS  => 'X' ) );
+    CONSTANT InvIf1_Table : stdlogic_table :=
+        -- enable        data       value
+        ( '0'|'L'   => ( OTHERS  => 'Z' ),
+          '1'|'H'   => ( '1'|'H' => '0',
+                         '0'|'L' => '1',
+                         'U'     => 'U',
+                         OTHERS  => 'X' ),
+          'U'       => ( OTHERS  => 'U' ),
+          OTHERS    => ( OTHERS  => 'X' ) );
+
+
+    TYPE To_StateCharType IS ARRAY (VitalStateSymbolType) OF CHARACTER;
+    CONSTANT To_StateChar : To_StateCharType :=
+     ( '/', '\', 'P', 'N', 'r', 'f', 'p', 'n', 'R', 'F', '^', 'v',
+       'E', 'A', 'D', '*', 'X', '0', '1', '-', 'B', 'Z', 'S' );
+    TYPE To_TruthCharType IS ARRAY (VitalTruthSymbolType) OF CHARACTER;
+    CONSTANT To_TruthChar : To_TruthCharType :=
+     ( 'X', '0', '1', '-', 'B', 'Z' );
+
+    TYPE TruthTableOutMapType IS ARRAY (VitalTruthSymbolType) OF std_ulogic;
+    CONSTANT TruthTableOutMap : TruthTableOutMapType :=
+       --  'X', '0', '1', '-', 'B', 'Z'
+         ( 'X', '0', '1', 'X', '-', 'Z' );
+
+    TYPE StateTableOutMapType IS ARRAY (VitalStateSymbolType) OF std_ulogic;
+    -- does conversion to X01Z or '-' if invalid
+    CONSTANT StateTableOutMap : StateTableOutMapType :=
+     -- '/' '\' 'P' 'N' 'r' 'f' 'p' 'n' 'R' 'F' '^' 'v'
+     -- 'E' 'A' 'D' '*' 'X' '0' '1' '-' 'B' 'Z' 'S'
+      ( '-','-','-','-','-','-','-','-','-','-','-','-',
+        '-','-','-','-','X','0','1','X','-','Z','W');
+
+    -- ------------------------------------------------------------------------
+    TYPE ValidTruthTableInputType IS ARRAY (VitalTruthSymbolType) OF BOOLEAN;
+    -- checks if a symbol IS valid for the stimulus portion of a truth table
+    CONSTANT ValidTruthTableInput : ValidTruthTableInputType :=
+       -- 'X'    '0'    '1'    '-'    'B'    'Z'
+       (  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  FALSE );
+
+    TYPE TruthTableMatchType IS ARRAY (X01, VitalTruthSymbolType) OF BOOLEAN;
+    -- checks if an input matches th corresponding truth table symbol
+    -- use: TruthTableMatch(input_converted_to_X01, truth_table_stimulus_symbol)
+    CONSTANT TruthTableMatch : TruthTableMatchType  :=  (
+       -- X,     0,     1,     -      B      Z
+       (  TRUE,  FALSE, FALSE, TRUE,  FALSE, FALSE  ),  -- X
+       (  FALSE, TRUE,  FALSE, TRUE,  TRUE,  FALSE  ),  -- 0
+       (  FALSE, FALSE, TRUE,  TRUE,  TRUE,  FALSE  )   -- 1
+    );
+
+    -- ------------------------------------------------------------------------
+    TYPE ValidStateTableInputType IS ARRAY (VitalStateSymbolType) OF BOOLEAN;
+    CONSTANT ValidStateTableInput : ValidStateTableInputType :=
+       -- '/',   '\',   'P',   'N',   'r',   'f',
+      (   TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,
+       -- 'p',   'n',   'R',   'F',   '^',   'v',
+          TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,
+       -- 'E',   'A',    'D',  '*',
+          TRUE,  TRUE,  TRUE,  TRUE,
+       -- 'X',   '0',   '1',   '-',   'B',   'Z',
+          TRUE,  TRUE,  TRUE,  TRUE,  TRUE, FALSE,
+       -- 'S'
+          TRUE );
+
+    CONSTANT ValidStateTableState : ValidStateTableInputType :=
+       -- '/',   '\',   'P',   'N',   'r',   'f',
+      (   FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+       -- 'p',   'n',   'R',   'F',   '^',   'v',
+          FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+       -- 'E',   'A',    'D',  '*',
+          FALSE, FALSE, FALSE, FALSE,
+       -- 'X',   '0',   '1',   '-',   'B',   'Z',
+          TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  FALSE,
+       -- 'S'
+          FALSE );
+
+    TYPE StateTableMatchType IS ARRAY (X01,X01,VitalStateSymbolType) OF BOOLEAN;
+    -- last value, present value, table symbol
+    CONSTANT StateTableMatch : StateTableMatchType :=  (
+      ( -- X (lastvalue)
+     -- /     \     P     N     r     f
+     -- p     n     R     F     ^     v
+     -- E     A     D     *
+     -- X     0     1     -     B     Z     S
+      (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,
+       TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE),
+      (FALSE,FALSE,FALSE,TRUE, FALSE,FALSE,
+       FALSE,FALSE,FALSE,TRUE, FALSE,TRUE,
+       TRUE, FALSE,TRUE, TRUE,
+       FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE),
+      (FALSE,FALSE,TRUE, FALSE,FALSE,FALSE,
+       FALSE,FALSE,TRUE, FALSE,TRUE, FALSE,
+       TRUE, TRUE, FALSE,TRUE,
+       FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE)
+      ),
+
+      (-- 0 (lastvalue)
+     -- /     \     P     N     r     f
+     -- p     n     R     F     ^     v
+     -- E     A     D     *
+     -- X     0     1     -     B     Z     S
+      (FALSE,FALSE,FALSE,FALSE,TRUE, FALSE,
+       TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+       FALSE,TRUE, FALSE,TRUE,
+       TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE),
+      (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,
+       FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,TRUE ),
+      (TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+       TRUE, FALSE,TRUE, FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,TRUE,
+       FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE)
+      ),
+
+      (-- 1 (lastvalue)
+     -- /     \     P     N     r     f
+     -- p     n     R     F     ^     v
+     -- E     A     D     *
+     -- X     0     1     -     B     Z     S
+      (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE ,
+       FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+       FALSE,FALSE,TRUE, TRUE,
+       TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE),
+      (FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+       FALSE,TRUE, FALSE,TRUE, FALSE,FALSE,
+       FALSE,FALSE,FALSE,TRUE,
+       FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE),
+      (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,FALSE,FALSE,
+       FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,TRUE )
+      )
+      );
+
+    TYPE Logic_UX01Z_Table IS ARRAY (std_ulogic) OF UX01Z;
+    ----------------------------------------------------------
+    -- table name : cvt_to_x01z
+    -- parameters :  std_ulogic  -- some logic value
+    -- returns    :  UX01Z       -- state value of logic value
+    -- purpose    :  to convert state-strength to state only
+    ----------------------------------------------------------
+    CONSTANT cvt_to_ux01z : Logic_UX01Z_Table :=
+                                ('U','X','0','1','Z','X','0','1','X' );
+
+    TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; 
+    CONSTANT LogicCvtTable : LogicCvtTableType 
+                     := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); 
+
+    --------------------------------------------------------------------
+    -- LOCAL Utilities
+    --------------------------------------------------------------------
+    -- ------------------------------------------------------------------------
+    --  FUNCTION  NAME  :  MINIMUM
+    --
+    --  PARAMETERS      :  in1, in2  - integer, time
+    --
+    --  DESCRIPTION     :  return smaller of in1 and in2
+    -- ------------------------------------------------------------------------
+    FUNCTION Minimum (
+            CONSTANT in1, in2 : INTEGER
+          ) RETURN INTEGER IS
+    BEGIN
+       IF (in1 < in2) THEN
+          RETURN in1;
+       END IF;
+       RETURN in2;
+    END;
+    -- ------------------------------------------------------------------------
+    FUNCTION Minimum (
+            CONSTANT t1,t2 : IN TIME
+          ) RETURN TIME IS
+    BEGIN
+        IF ( t1 < t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+    END Minimum;
+
+    -- ------------------------------------------------------------------------
+    --  FUNCTION  NAME  :  MAXIMUM
+    --
+    --  PARAMETERS      :  in1, in2  - integer, time
+    --
+    --  DESCRIPTION     :  return larger of in1 and in2
+    -- ------------------------------------------------------------------------
+    FUNCTION Maximum (
+            CONSTANT in1, in2 : INTEGER
+          ) RETURN INTEGER IS
+    BEGIN
+       IF (in1 > in2) THEN
+          RETURN in1;
+       END IF;
+       RETURN in2;
+    END;
+    -----------------------------------------------------------------------
+    FUNCTION Maximum (
+            CONSTANT t1,t2 : IN TIME
+          ) RETURN TIME IS
+    BEGIN
+        IF ( t1 > t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+    END Maximum;
+
+    -----------------------------------------------------------------------
+    FUNCTION GlitchMinTime (
+            CONSTANT Time1, Time2 : IN TIME
+          ) RETURN TIME IS
+    BEGIN
+        IF ( Time1 >= NOW ) THEN
+                IF ( Time2 >= NOW ) THEN
+                  RETURN Minimum ( Time1, Time2);
+                ELSE
+                  RETURN Time1;
+                END IF;
+        ELSE
+                IF ( Time2 >= NOW ) THEN
+                   RETURN Time2;
+                ELSE
+                   RETURN 0 ns;
+                END IF;
+        END IF;
+    END;
+
+    --------------------------------------------------------------------
+    -- Error Message Types and Tables
+    --------------------------------------------------------------------
+    TYPE VitalErrorType IS (
+        ErrNegDel,
+        ErrInpSym,
+        ErrOutSym,
+        ErrStaSym,
+        ErrVctLng,
+        ErrTabWidSml,
+        ErrTabWidLrg,
+        ErrTabResSml,
+        ErrTabResLrg
+    );
+
+    TYPE VitalErrorSeverityType IS ARRAY (VitalErrorType) OF SEVERITY_LEVEL;
+    CONSTANT VitalErrorSeverity : VitalErrorSeverityType := (
+        ErrNegDel    => WARNING,
+        ErrInpSym    => ERROR,
+        ErrOutSym    => ERROR,
+        ErrStaSym    => ERROR,
+        ErrVctLng    => ERROR,
+        ErrTabWidSml => ERROR,
+        ErrTabWidLrg => WARNING,
+        ErrTabResSml => WARNING,
+        ErrTabResLrg => WARNING
+    );
+
+    CONSTANT MsgNegDel : STRING :=
+      "Negative delay. New output value not scheduled. Output signal is: ";
+    CONSTANT MsgInpSym : STRING :=
+      "Illegal symbol in the input portion of a Truth/State table.";
+    CONSTANT MsgOutSym : STRING :=
+      "Illegal symbol in the output portion of a Truth/State table.";
+    CONSTANT MsgStaSym : STRING :=
+      "Illegal symbol in the state portion of a State table.";
+    CONSTANT MsgVctLng : STRING :=
+      "Vector (array) lengths not equal. ";
+    CONSTANT MsgTabWidSml : STRING :=
+      "Width of the Truth/State table is too small.";
+    CONSTANT MsgTabWidLrg : STRING :=
+      "Width of Truth/State table is too large. Extra elements are ignored.";
+    CONSTANT MsgTabResSml : STRING :=
+      "Result of Truth/State table has too many elements.";
+    CONSTANT MsgTabResLrg : STRING :=
+      "Result of Truth/State table has too few elements.";
+
+    CONSTANT MsgUnknown : STRING :=
+      "Unknown error message.";
+
+    --------------------------------------------------------------------
+    -- LOCAL Utilities
+    --------------------------------------------------------------------
+    FUNCTION VitalMessage (
+            CONSTANT ErrorId : IN VitalErrorType
+          ) RETURN STRING IS
+    BEGIN
+        CASE ErrorId IS
+            WHEN ErrNegDel    => RETURN MsgNegDel;
+            WHEN ErrInpSym    => RETURN MsgInpSym;
+            WHEN ErrOutSym    => RETURN MsgOutSym;
+            WHEN ErrStaSym    => RETURN MsgStaSym;
+            WHEN ErrVctLng    => RETURN MsgVctLng;
+            WHEN ErrTabWidSml => RETURN MsgTabWidSml;
+            WHEN ErrTabWidLrg => RETURN MsgTabWidLrg;
+            WHEN ErrTabResSml => RETURN MsgTabResSml;
+            WHEN ErrTabResLrg => RETURN MsgTabResLrg;
+            WHEN OTHERS       => RETURN MsgUnknown;
+        END CASE;
+    END;
+
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId)
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType;
+            CONSTANT Info    : IN STRING
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId) & Info
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType;
+            CONSTANT Info    : IN CHARACTER
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId) & Info
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE ReportGlitch ( 
+            CONSTANT GlitchRoutine  : IN  STRING;
+            CONSTANT OutSignalName  : IN  STRING;
+            CONSTANT PreemptedTime  : IN  TIME;
+            CONSTANT PreemptedValue : IN  std_ulogic;
+            CONSTANT NewTime        : IN  TIME;
+            CONSTANT NewValue       : IN  std_ulogic;
+            CONSTANT Index          : IN  INTEGER := 0;
+            CONSTANT IsArraySignal  : IN  BOOLEAN := FALSE;
+            CONSTANT MsgSeverity    : IN  SEVERITY_LEVEL := WARNING
+    ) IS
+
+        VARIABLE StrPtr1, StrPtr2, StrPtr3, StrPtr4, StrPtr5 : LINE;
+    BEGIN
+
+        Write (StrPtr1, PreemptedTime );
+        Write (StrPtr2, NewTime);
+        Write (StrPtr3, LogicCvtTable(PreemptedValue));
+        Write (StrPtr4, LogicCvtTable(NewValue));
+        IF IsArraySignal THEN
+            Write (StrPtr5, STRING'( "(" ) );
+            Write (StrPtr5, Index);
+            Write (StrPtr5, STRING'( ")" ) );
+        ELSE
+            Write (StrPtr5, STRING'( " " ) );
+        END IF;
+
+        -- Issue Report only if Preemted value has not been
+        --  removed from event queue
+        ASSERT PreemptedTime >  NewTime
+          REPORT GlitchRoutine & ": GLITCH Detected on port " & 
+                 OutSignalName & StrPtr5.ALL &
+                 "; Preempted Future Value := " & StrPtr3.ALL &
+                 " @ " & StrPtr1.ALL &
+                 "; Newly Scheduled Value := " & StrPtr4.ALL &
+                 " @ " & StrPtr2.ALL &
+                 ";"
+          SEVERITY MsgSeverity;
+
+        DEALLOCATE(StrPtr1);
+        DEALLOCATE(StrPtr2);
+        DEALLOCATE(StrPtr3);
+        DEALLOCATE(StrPtr4); 
+        DEALLOCATE(StrPtr5); 
+        RETURN;
+    END ReportGlitch;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : VitalGlitchOnEvent
+    --            :
+    -- Parameters : OutSignal ........ signal being driven
+    --            : OutSignalName..... name of the driven signal
+    --            : GlitchData........ internal data required by the procedure
+    --            : NewValue.......... new value being assigned
+    --            : NewDelay.......... Delay accompanying the assignment
+    --            :                    (Note: for vectors, this is an array)
+    --            : GlitchMode........ Glitch generation mode
+    --            :                     MessagePlusX, MessageOnly, 
+    --            :                     XOnly, NoGlitch )
+    --            : GlitchDelay....... if <= 0 ns , then there will be no Glitch
+    --            :                    if >  NewDelay, then there is no Glitch,
+    --            :                    otherwise, this is the time when a FORCED
+    --            :                    generation of a glitch will occur. 
+    ----------------------------------------------------------------------------
+    PROCEDURE VitalGlitchOnEvent (
+            SIGNAL   OutSignal        : OUT   std_logic;
+            CONSTANT OutSignalName    : IN    STRING;
+            VARIABLE GlitchData       : INOUT GlitchDataType;
+            CONSTANT NewValue         : IN    std_logic;
+            CONSTANT NewDelay         : IN    TIME := 0 ns;
+            CONSTANT GlitchMode       : IN    VitalGlitchModeType := MessagePlusX;
+            CONSTANT GlitchDelay      : IN    TIME := 0 ns;
+            CONSTANT MsgSeverity      : IN    SEVERITY_LEVEL := WARNING
+    ) IS
+    -- ------------------------------------------------------------------------
+        VARIABLE NoGlitchDet  : BOOLEAN := FALSE;
+        VARIABLE OldGlitch    : BOOLEAN := FALSE;
+        VARIABLE Dly          : TIME    := NewDelay;
+
+    BEGIN
+        -- If nothing to schedule, just return
+        IF NewDelay < 0 ns THEN
+            IF (NewValue /= GlitchData.SchedValue) THEN
+                VitalError ( "VitalGlitchOnEvent", ErrNegDel, OutSignalName );
+            END IF;
+
+        ELSE 
+            -- If nothing currently scheduled
+            IF GlitchData.SchedTime <= NOW THEN
+                GlitchData.CurrentValue := GlitchData.SchedValue;
+                IF (GlitchDelay <= 0 ns) THEN
+                    IF (NewValue = GlitchData.SchedValue) THEN RETURN; END IF;
+                    NoGlitchDet := TRUE;
+                END IF;
+     
+            -- Transaction currently scheduled - if glitch already happened
+            ELSIF GlitchData.GlitchTime <= NOW THEN
+                GlitchData.CurrentValue := 'X';
+                OldGlitch := TRUE;
+                IF (GlitchData.SchedValue = NewValue) THEN
+                    dly := Minimum( GlitchData.SchedTime-NOW, NewDelay );
+                END IF;
+     
+            -- Transaction currently scheduled (no glitch if same value)
+            ELSIF (GlitchData.SchedValue = NewValue) AND
+                  (GlitchData.SchedTime = GlitchData.GlitchTime) AND
+                  (GlitchDelay <= 0 ns) THEN
+                NoGlitchDet := TRUE;
+                Dly := Minimum( GlitchData.SchedTime-NOW, NewDelay );
+
+            END IF;
+     
+            GlitchData.SchedTime := NOW+Dly;
+            IF OldGlitch THEN
+                OutSignal <= NewValue AFTER Dly;
+
+            ELSIF NoGlitchDet THEN
+                GlitchData.GlitchTime := NOW+Dly;
+                OutSignal <= NewValue AFTER Dly;
+
+            ELSE -- new glitch
+                GlitchData.GlitchTime := GlitchMinTime ( GlitchData.GlitchTime, 
+                                                         NOW+GlitchDelay );
+
+                IF (GlitchMode = MessagePlusX) OR
+                   (GlitchMode = MessageOnly) THEN
+                    ReportGlitch ( "VitalGlitchOnEvent", OutSignalName,
+                                   GlitchData.GlitchTime, GlitchData.SchedValue,
+                                   (Dly + NOW), NewValue,
+                                   MsgSeverity=>MsgSeverity );
+                END IF;
+
+                IF (GlitchMode = MessagePlusX) OR (GlitchMode = XOnly) THEN
+                    OutSignal <= 'X' AFTER GlitchData.GlitchTime-NOW;
+                    OutSignal <=  TRANSPORT NewValue AFTER Dly;
+                ELSE
+                    OutSignal <= NewValue AFTER Dly;
+                END IF;
+            END IF;
+
+            GlitchData.SchedValue := NewValue;
+        END IF;
+
+        RETURN;
+    END;
+ 
+    ----------------------------------------------------------------------------
+    PROCEDURE VitalGlitchOnEvent (
+            SIGNAL   OutSignal        : OUT   std_logic_vector;
+            CONSTANT OutSignalName    : IN    STRING;
+            VARIABLE GlitchData       : INOUT GlitchDataArrayType;
+            CONSTANT NewValue         : IN    std_logic_vector;
+            CONSTANT NewDelay         : IN    VitalTimeArray;
+            CONSTANT GlitchMode       : IN    VitalGlitchModeType := MessagePlusX;
+            CONSTANT GlitchDelay      : IN    VitalTimeArray;
+            CONSTANT MsgSeverity      : IN    SEVERITY_LEVEL := WARNING
+    ) IS
+
+        ALIAS GlDataAlias  : GlitchDataArrayType(1 TO GlitchData'LENGTH) 
+                                 IS GlitchData;
+        ALIAS NewValAlias  : std_logic_vector(1 TO NewValue'LENGTH) IS NewValue;
+        ALIAS GlDelayAlias : VitalTimeArray(1 TO GlitchDelay'LENGTH)
+              IS GlitchDelay;
+        ALIAS NewDelAlias  : VitalTimeArray(1 TO NewDelay'LENGTH) IS NewDelay;
+ 
+        VARIABLE Index       : INTEGER := OutSignal'LEFT;
+        VARIABLE Direction   : INTEGER;
+        VARIABLE NoGlitchDet : BOOLEAN;
+        VARIABLE OldGlitch   : BOOLEAN;
+        VARIABLE Dly, GlDly  : TIME;
+
+    BEGIN
+        IF (OutSignal'LEFT > OutSignal'RIGHT) THEN
+            Direction := -1;
+        ELSE
+            Direction := 1;
+        END IF;
+
+        IF ( (OutSignal'LENGTH /=  GlitchData'LENGTH) OR
+             (OutSignal'LENGTH /=    NewValue'LENGTH) OR
+             (OutSignal'LENGTH /=    NewDelay'LENGTH) OR
+             (OutSignal'LENGTH /= GlitchDelay'LENGTH) ) THEN
+          VitalError ( "VitalGlitchOnEvent", ErrVctLng, OutSignalName );
+          RETURN;
+        END IF;
+
+        -- a call to the scalar function cannot be made since the actual 
+        -- name associated with a signal parameter must be locally static
+      FOR n IN 1 TO OutSignal'LENGTH LOOP
+
+        NoGlitchDet := FALSE;
+        OldGlitch   := FALSE;
+        Dly := NewDelAlias(n);
+
+        -- If nothing to schedule, just skip to next loop iteration
+        IF NewDelAlias(n) < 0 ns THEN
+            IF (NewValAlias(n) /=  GlDataAlias(n).SchedValue) THEN
+                VitalError ( "VitalGlitchOnEvent", ErrNegDel, OutSignalName );
+            END IF;
+        ELSE
+            -- If nothing currently scheduled (i.e. last scheduled 
+            -- transaction already occurred)
+            IF GlDataAlias(n).SchedTime <= NOW THEN
+                GlDataAlias(n).CurrentValue := GlDataAlias(n).SchedValue;
+                IF (GlDelayAlias(n) <= 0 ns) THEN
+                    -- Next iteration if no change in value
+                    IF (NewValAlias(n) = GlDataAlias(n).SchedValue) THEN 
+                        Index := Index + Direction;
+                        NEXT; 
+                    END IF; 
+                    -- since last transaction already occurred there is no glitch
+                    NoGlitchDet := TRUE;
+                END IF;
+
+            -- Transaction currently scheduled - if glitch already happened
+            ELSIF GlDataAlias(n).GlitchTime <= NOW THEN
+                GlDataAlias(n).CurrentValue := 'X';
+                OldGlitch := TRUE;
+                IF (GlDataAlias(n).SchedValue = NewValAlias(n)) THEN
+                    dly := Minimum( GlDataAlias(n).SchedTime-NOW,
+                                    NewDelAlias(n) );
+                END IF;
+
+            -- Transaction currently scheduled
+            ELSIF (GlDataAlias(n).SchedValue = NewValAlias(n)) AND
+                  (GlDataAlias(n).SchedTime = GlDataAlias(n).GlitchTime) AND
+                  (GlDelayAlias(n) <= 0 ns) THEN
+                  NoGlitchDet := TRUE;
+                  Dly := Minimum( GlDataAlias(n).SchedTime-NOW, 
+                                  NewDelAlias(n) );
+            END IF;
+
+            -- update last scheduled transaction
+            GlDataAlias(n).SchedTime := NOW+Dly;
+
+            IF OldGlitch THEN
+                OutSignal(Index) <= NewValAlias(n) AFTER Dly;
+            ELSIF NoGlitchDet THEN
+                -- if no glitch then update last glitch time 
+                -- and OutSignal(actual_index)
+                GlDataAlias(n).GlitchTime := NOW+Dly;
+                OutSignal(Index) <= NewValAlias(n) AFTER Dly;
+            ELSE   -- new glitch
+                GlDataAlias(n).GlitchTime := GlitchMinTime ( 
+                                                  GlDataAlias(n).GlitchTime,
+                                                  NOW+GlDelayAlias(n) );
+
+                IF (GlitchMode = MessagePlusX) OR
+                   (GlitchMode = MessageOnly) THEN
+                    ReportGlitch ( "VitalGlitchOnEvent", OutSignalName,
+                                   GlDataAlias(n).GlitchTime, 
+                                   GlDataAlias(n).SchedValue,
+                                   (Dly + NOW), NewValAlias(n), 
+                                   Index, TRUE, MsgSeverity );
+                END IF;
+
+                IF (GlitchMode = MessagePlusX) OR (GlitchMode = XOnly) THEN
+                    GlDly := GlDataAlias(n).GlitchTime - NOW;
+                    OutSignal(Index) <= 'X' AFTER GlDly;
+                    OutSignal(Index) <= TRANSPORT NewValAlias(n) AFTER Dly;
+                ELSE
+                    OutSignal(Index) <= NewValAlias(n) AFTER Dly;
+                END IF;
+
+            END IF; -- glitch / no-glitch
+            GlDataAlias(n).SchedValue := NewValAlias(n);
+
+        END IF; -- NewDelAlias(n) < 0 ns
+        Index := Index + Direction;
+      END LOOP;
+
+        RETURN;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- ------------------------------------------------------------------------
+    --  PROCEDURE NAME  :  TruthOutputX01Z
+    --
+    --  PARAMETERS      :  table_out - output of table
+    --                     X01Zout   - output converted to X01Z
+    --                     err       - true if illegal character is encountered
+    --
+    --
+    --  DESCRIPTION     :  converts the output of a truth table to a valid
+    --                     std_ulogic
+    -- ------------------------------------------------------------------------
+    PROCEDURE TruthOutputX01Z (
+            CONSTANT TableOut : IN VitalTruthSymbolType;
+            VARIABLE X01Zout   : OUT std_ulogic;
+            VARIABLE Err       : OUT BOOLEAN
+    ) IS
+        VARIABLE TempOut : std_ulogic;
+    BEGIN
+        Err := FALSE;
+        TempOut := TruthTableOutMap(TableOut);
+        IF (TempOut = '-') THEN
+            Err := TRUE;
+            TempOut := 'X';
+            VitalError ( "VitalTruthTable", ErrOutSym, To_TruthChar(TableOut));
+        END IF;
+        X01Zout := TempOut;
+    END;
+
+    -- ------------------------------------------------------------------------
+    --  PROCEDURE NAME  :  StateOutputX01Z
+    --
+    --  PARAMETERS      :  table_out - output of table
+    --                     prev_out  - previous output value
+    --                     X01Zout   - output cojnverted to X01Z
+    --                     err       - true if illegal character is encountered
+    --
+    --  DESCRIPTION     :  converts the output of a state table to a
+    --                     valid std_ulogic
+    -- ------------------------------------------------------------------------
+    PROCEDURE StateOutputX01Z (
+            CONSTANT TableOut : IN VitalStateSymbolType;
+            CONSTANT PrevOut  : IN std_ulogic;
+            VARIABLE X01Zout   : OUT std_ulogic;
+            VARIABLE Err       : OUT BOOLEAN
+    ) IS
+        VARIABLE TempOut : std_ulogic;
+    BEGIN
+        Err := FALSE;
+        TempOut := StateTableOutMap(TableOut);
+        IF (TempOut = '-') THEN
+            Err := TRUE;
+            TempOut := 'X';
+            VitalError ( "VitalStateTable", ErrOutSym, To_StateChar(TableOut));
+        ELSIF (TempOut = 'W') THEN
+            TempOut := To_X01Z(PrevOut);
+        END IF;
+        X01Zout := TempOut;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- PROCEDURE NAME:  StateMatch
+    --
+    -- PARAMETERS    :  symbol       - symbol from state table
+    --                  in2          - input from VitalStateTble procedure
+    --                                 to state table
+    --                  in2LastValue - previous value of input
+    --                  state        - false if the symbol is from the input
+    --                                  portion of the table,
+    --                                 true if the symbol is from the state
+    --                                  portion of the table
+    --                  Err          - true if symbol is not a valid input symbol
+    --                  ReturnValue  - true if match occurred
+    --
+    -- DESCRIPTION   :  This procedure sets ReturnValue to true if in2 matches
+    --                  symbol (from the state table).  If symbol is an edge
+    --                  value edge is set to true and in2 and in2LastValue are
+    --                  checked against symbol.  Err is set to true if symbol
+    --                  is an invalid value for the input portion of the state
+    --                  table.
+    --
+    -- ------------------------------------------------------------------------
+    PROCEDURE StateMatch (
+            CONSTANT Symbol       : IN VitalStateSymbolType;
+            CONSTANT in2          : IN std_ulogic;
+            CONSTANT in2LastValue : IN std_ulogic;
+            CONSTANT State        : IN BOOLEAN;
+            VARIABLE Err          : OUT BOOLEAN;
+            VARIABLE ReturnValue  : OUT BOOLEAN
+    ) IS
+    BEGIN
+        IF (State) THEN
+            IF (NOT ValidStateTableState(Symbol)) THEN
+                VitalError ( "VitalStateTable", ErrStaSym, To_StateChar(Symbol));
+                Err := TRUE;
+                ReturnValue := FALSE;
+            ELSE
+                Err := FALSE;
+                ReturnValue := StateTableMatch(in2LastValue, in2, Symbol);
+            END IF;
+        ELSE
+            IF (NOT ValidStateTableInput(Symbol) ) THEN
+                VitalError ( "VitalStateTable", ErrInpSym, To_StateChar(Symbol));
+                Err := TRUE;
+                ReturnValue := FALSE;
+            ELSE
+                ReturnValue := StateTableMatch(in2LastValue, in2, Symbol);
+                Err := FALSE;
+            END IF;
+        END IF;
+    END;
+
+    -- -----------------------------------------------------------------------
+    -- FUNCTION NAME:  StateTableLookUp
+    --
+    -- PARAMETERS   :  StateTable     - state table
+    --                 PresentDataIn  - current inputs
+    --                 PreviousDataIn - previous inputs and states
+    --                 NumStates      - number of state variables
+    --                 PresentOutputs - current state and current outputs
+    --
+    -- DESCRIPTION  :  This function is used to find the output of the
+    --                 StateTable corresponding to a given set of inputs.
+    --
+    -- ------------------------------------------------------------------------
+    FUNCTION StateTableLookUp (
+            CONSTANT StateTable     : VitalStateTableType;
+            CONSTANT PresentDataIn  : std_logic_vector;
+            CONSTANT PreviousDataIn : std_logic_vector;
+            CONSTANT NumStates      : NATURAL;
+            CONSTANT PresentOutputs : std_logic_vector
+          ) RETURN std_logic_vector IS
+
+        CONSTANT InputSize    : INTEGER := PresentDataIn'LENGTH;
+        CONSTANT NumInputs    : INTEGER := InputSize + NumStates - 1;
+        CONSTANT TableEntries : INTEGER := StateTable'LENGTH(1);
+        CONSTANT TableWidth   : INTEGER := StateTable'LENGTH(2);
+        CONSTANT OutSize      : INTEGER := TableWidth - InputSize - NumStates;
+        VARIABLE Inputs       : std_logic_vector(0 TO NumInputs);
+        VARIABLE PrevInputs   : std_logic_vector(0 TO NumInputs)
+                                := (OTHERS => 'X');
+        VARIABLE ReturnValue  : std_logic_vector(0 TO (OutSize-1))
+                                := (OTHERS => 'X');
+        VARIABLE Temp   : std_ulogic;
+        VARIABLE Match  : BOOLEAN;
+        VARIABLE Err    : BOOLEAN := FALSE;
+
+        -- This needs to be done since the TableLookup arrays must be
+        -- ascending starting with 0
+        VARIABLE TableAlias   : VitalStateTableType(0 TO TableEntries - 1,
+                                                    0 TO TableWidth - 1)
+                                := StateTable;
+
+    BEGIN
+        Inputs(0 TO InputSize-1) := PresentDataIn;
+        Inputs(InputSize TO NumInputs) := PresentOutputs(0 TO NumStates - 1);
+        PrevInputs(0 TO InputSize - 1) := PreviousDataIn(0 TO InputSize - 1);
+
+      ColLoop: -- Compare each entry in the table
+        FOR i IN TableAlias'RANGE(1) LOOP
+
+        RowLoop: -- Check each element of the entry
+          FOR j IN 0 TO InputSize + NumStates  LOOP
+
+            IF (j = InputSize + NumStates) THEN        -- a match occurred
+                FOR k IN 0 TO Minimum(OutSize, PresentOutputs'LENGTH)-1  LOOP
+                    StateOutputX01Z (
+                            TableAlias(i, TableWidth - k - 1),
+                            PresentOutputs(PresentOutputs'LENGTH - k - 1),
+                            Temp, Err);
+                    ReturnValue(OutSize - k - 1) := Temp;
+                    IF (Err) THEN
+                        ReturnValue := (OTHERS => 'X');
+                        RETURN ReturnValue;
+                    END IF;
+                END LOOP;
+                RETURN ReturnValue;
+            END IF;
+
+            StateMatch ( TableAlias(i,j),
+                         Inputs(j), PrevInputs(j),
+                         j >= InputSize, Err, Match);
+            EXIT RowLoop WHEN NOT(Match);
+            EXIT ColLoop WHEN Err;
+          END LOOP RowLoop;
+        END LOOP ColLoop;
+
+        ReturnValue := (OTHERS => 'X');
+        RETURN ReturnValue;
+    END;
+
+    --------------------------------------------------------------------
+    -- to_ux01z
+    -------------------------------------------------------------------
+    FUNCTION To_UX01Z  ( s : std_ulogic
+          ) RETURN  UX01Z IS
+    BEGIN
+        RETURN cvt_to_ux01z (s);
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Function  : GetEdge
+    -- Purpose   : Converts transitions on a given input signal into a
+    --             enumeration value representing the transition or level
+    --             of the signal.
+    --
+    --    previous "value"   current "value"     :=   "edge"
+    --   ---------------------------------------------------------
+    --     '1' | 'H'          '1' | 'H'                 '1'    level, no edge
+    --     '0' | 'L'          '1' | 'H'                 '/'    rising edge
+    --      others            '1' | 'H'                 'R'    rising from X
+    --
+    --     '1' | 'H'          '0' | 'L'                 '\'    falling egde
+    --     '0' | 'L'          '0' | 'L'                 '0'    level, no edge
+    --      others            '0' | 'L'                 'F'    falling from X
+    --
+    --     'X' | 'W' | '-'    'X' | 'W' | '-'           'X'    unknown (X) level
+    --     'Z'                'Z'                       'X'    unknown (X) level
+    --     'U'                'U'                       'U'    'U' level
+    --
+    --     '1' | 'H'           others                   'f'    falling to X
+    --     '0' | 'L'           others                   'r'    rising to X
+    --     'X' | 'W' | '-'    'U' | 'Z'                 'x'    unknown (X) edge
+    --     'Z'                'X' | 'W' | '-' | 'U'     'x'    unknown (X) edge
+    --     'U'                'X' | 'W' | '-' | 'Z'     'x'    unknown (X) edge
+    --
+    ---------------------------------------------------------------------------
+    FUNCTION GetEdge (
+            SIGNAL      s : IN    std_logic
+          ) RETURN EdgeType IS
+    BEGIN
+        IF (s'EVENT)
+            THEN RETURN LogicToEdge  ( s'LAST_VALUE, s );
+            ELSE RETURN LogicToLevel ( s );
+        END IF;
+    END;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE GetEdge (
+            SIGNAL       s : IN    std_logic_vector;
+            VARIABLE LastS : INOUT std_logic_vector;
+            VARIABLE  Edge :   OUT EdgeArray ) IS
+
+        ALIAS     sAlias : std_logic_vector ( 1 TO     s'LENGTH ) IS s;
+        ALIAS LastSAlias : std_logic_vector ( 1 TO LastS'LENGTH ) IS LastS;
+        ALIAS  EdgeAlias : EdgeArray ( 1 TO  Edge'LENGTH ) IS Edge;
+    BEGIN
+        IF s'LENGTH /= LastS'LENGTH OR
+           s'LENGTH /=  Edge'LENGTH THEN
+            VitalError ( "GetEdge", ErrVctLng, "s, LastS, Edge" );
+        END IF;
+
+        FOR n IN 1 TO s'LENGTH LOOP
+            EdgeAlias(n)  := LogicToEdge( LastSAlias(n), sAlias(n) );
+            LastSAlias(n) := sAlias(n);
+        END LOOP;
+    END;
+
+    ---------------------------------------------------------------------------
+    FUNCTION  ToEdge     ( Value         : IN std_logic
+          ) RETURN EdgeType IS
+    BEGIN
+        RETURN LogicToLevel( Value );
+    END;
+
+    -- Note: This function will likely be replaced by S'DRIVING_VALUE in VHDL'92
+    ----------------------------------------------------------------------------
+    FUNCTION CurValue (
+            CONSTANT GlitchData : IN  GlitchDataType
+          ) RETURN std_logic IS
+    BEGIN
+        IF NOW >= GlitchData.SchedTime THEN
+            RETURN GlitchData.SchedValue;
+        ELSIF NOW >= GlitchData.GlitchTime THEN
+            RETURN 'X';
+        ELSE
+            RETURN GlitchData.CurrentValue;
+        END IF;
+    END;
+    ---------------------------------------------------------------------------
+    FUNCTION CurValue (
+            CONSTANT GlitchData : IN  GlitchDataArrayType
+          ) RETURN std_logic_vector IS
+        VARIABLE Result : std_logic_vector(GlitchData'RANGE);
+    BEGIN
+        FOR n IN GlitchData'RANGE LOOP
+            IF NOW >= GlitchData(n).SchedTime THEN
+                Result(n) := GlitchData(n).SchedValue;
+            ELSIF NOW >= GlitchData(n).GlitchTime THEN
+                Result(n) := 'X';
+            ELSE
+                Result(n) := GlitchData(n).CurrentValue;
+            END IF;
+        END LOOP;
+        RETURN Result;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- function calculation utilities
+    ---------------------------------------------------------------------------
+
+    ---------------------------------------------------------------------------
+    -- Function   : VitalSame
+    -- Returns    : VitalSame compares the state (UX01) of two logic value. A
+    --              value of 'X' is returned if the values are different.  The
+    --              common value is returned if the values are equal.
+    -- Purpose    : When the result of a logic model may be either of two
+    --              separate input values (eg. when the select on a MUX is 'X'),
+    --              VitalSame may be used to determine if the result needs to
+    --              be 'X'.
+    -- Arguments  : See the declarations below...
+    ---------------------------------------------------------------------------
+    FUNCTION VitalSame (
+            CONSTANT a, b : IN std_ulogic
+          ) RETURN std_ulogic IS
+    BEGIN
+        IF To_UX01(a) = To_UX01(b)
+            THEN RETURN To_UX01(a);
+            ELSE RETURN 'X';
+        END IF;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- delay selection utilities
+    ---------------------------------------------------------------------------
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : BufPath, InvPath
+    --
+    -- Purpose    : BufPath and InvPath compute output change times, based on
+    --              a change on an input port. The computed output change times
+    --              returned in the composite parameter 'schd'.
+    --
+    --              BufPath and InpPath are used together with the delay path
+    --              selection functions (GetSchedDelay, VitalAND, VitalOR... )
+    --              The 'schd' value from each of the input ports of a model are
+    --              combined by the delay selection functions (VitalAND,
+    --              VitalOR, ...). The GetSchedDelay procedure converts the
+    --              combined output changes times to the single delay (delta
+    --              time) value for scheduling the output change (passed to
+    --              VitalGlitchOnEvent).
+    --
+    --              The values in 'schd' are: (absolute times)
+    --                inp0  :  time of output change due to input change to 0
+    --                inp1  :  time of output change due to input change to 1
+    --                inpX  :  time of output change due to input change to X
+    --                glch0 :  time of output glitch due to input change to 0
+    --                glch1 :  time of output glitch due to input change to 1
+    --
+    --              The output times are computed from the model INPUT value
+    --              and not the final value.  For this reason, 'BufPath' should
+    --              be used to compute the output times for a non-inverting
+    --              delay paths and 'InvPath' should be used to compute the
+    --              ouput times for inverting delay paths. Delay paths which
+    --              include both non-inverting and paths require usage of both
+    --              'BufPath' and 'InvPath'. (IE this is needed for the
+    --              select->output path of a MUX -- See the VitalMUX model).
+    --
+    --
+    -- Parameters : schd....... Computed output result times. (INOUT parameter
+    --                          modified only on input edges)
+    --              Iedg....... Input port edge/level value.
+    --               tpd....... Propagation delays from this input
+    --
+    ---------------------------------------------------------------------------
+
+    PROCEDURE BufPath (
+            VARIABLE Schd : INOUT SchedType;
+            CONSTANT Iedg : IN    EdgeType;
+            CONSTANT  tpd : IN    VitalDelayType01
+    ) IS
+    BEGIN
+      CASE Iedg IS
+        WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+        WHEN '/'|'R' => Schd.inp0 := TIME'HIGH;
+                        Schd.inp1 := NOW + tpd(tr01);  Schd.Glch1 := Schd.inp1;
+                        Schd.InpX := Schd.inp1;
+        WHEN '\'|'F' => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := NOW + tpd(tr10);  Schd.Glch0 := Schd.inp0;
+                        Schd.InpX := Schd.inp0;
+        WHEN 'r'     => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := TIME'HIGH;
+                        Schd.InpX := NOW + tpd(tr01);
+        WHEN 'f'     => Schd.inp0 := TIME'HIGH;
+                        Schd.inp1 := TIME'HIGH;
+                        Schd.InpX := NOW + tpd(tr10);
+        WHEN 'x'     => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := TIME'HIGH;
+                        -- update for X->X change
+                        Schd.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+        WHEN OTHERS  => NULL;                   -- no timing change
+      END CASE;
+    END;
+
+    PROCEDURE BufPath (
+            VARIABLE Schd : INOUT SchedArray;
+            CONSTANT Iedg : IN    EdgeArray;
+            CONSTANT  tpd : IN    VitalDelayArrayType01
+    ) IS
+    BEGIN
+      FOR n IN Schd'RANGE LOOP
+        CASE Iedg(n) IS
+          WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+          WHEN '/'|'R' => Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).inp1 := NOW + tpd(n)(tr01);
+                          Schd(n).Glch1 := Schd(n).inp1;
+                          Schd(n).InpX := Schd(n).inp1;
+          WHEN '\'|'F' => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := NOW + tpd(n)(tr10);
+                          Schd(n).Glch0 := Schd(n).inp0;
+                          Schd(n).InpX := Schd(n).inp0;
+          WHEN 'r'     => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).InpX := NOW + tpd(n)(tr01);
+          WHEN 'f'     => Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).InpX := NOW + tpd(n)(tr10);
+          WHEN 'x'     => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := TIME'HIGH;
+                          -- update for X->X change
+                          Schd(n).InpX := NOW + Minimum ( tpd(n)(tr10),
+                                                          tpd(n)(tr01) );
+          WHEN OTHERS  => NULL;                   -- no timing change
+        END CASE;
+      END LOOP;
+    END;
+
+    PROCEDURE InvPath (
+            VARIABLE Schd : INOUT SchedType;
+            CONSTANT Iedg : IN    EdgeType;
+            CONSTANT  tpd : IN    VitalDelayType01
+    ) IS
+    BEGIN
+      CASE Iedg IS
+        WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+        WHEN '/'|'R' => Schd.inp0 := TIME'HIGH;
+                        Schd.inp1 := NOW + tpd(tr10);  Schd.Glch1 := Schd.inp1;
+                        Schd.InpX := Schd.inp1;
+        WHEN '\'|'F' => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := NOW + tpd(tr01);  Schd.Glch0 := Schd.inp0;
+                        Schd.InpX := Schd.inp0;
+        WHEN 'r'     => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := TIME'HIGH;
+                        Schd.InpX := NOW + tpd(tr10);
+        WHEN 'f'     => Schd.inp0 := TIME'HIGH;
+                        Schd.inp1 := TIME'HIGH;
+                        Schd.InpX := NOW + tpd(tr01);
+        WHEN 'x'     => Schd.inp1 := TIME'HIGH;
+                        Schd.inp0 := TIME'HIGH;
+                        -- update for X->X change
+                        Schd.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+        WHEN OTHERS  => NULL;                   -- no timing change
+      END CASE;
+    END;
+
+    PROCEDURE InvPath (
+            VARIABLE Schd : INOUT SchedArray;
+            CONSTANT Iedg : IN    EdgeArray;
+            CONSTANT  tpd : IN    VitalDelayArrayType01
+    ) IS
+    BEGIN
+      FOR n IN Schd'RANGE LOOP
+        CASE Iedg(n) IS
+          WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+          WHEN '/'|'R' => Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).inp1 := NOW + tpd(n)(tr10);
+                          Schd(n).Glch1 := Schd(n).inp1;
+                          Schd(n).InpX := Schd(n).inp1;
+          WHEN '\'|'F' => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := NOW + tpd(n)(tr01);
+                          Schd(n).Glch0 := Schd(n).inp0;
+                          Schd(n).InpX := Schd(n).inp0;
+          WHEN 'r'     => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).InpX := NOW + tpd(n)(tr10);
+          WHEN 'f'     => Schd(n).inp0 := TIME'HIGH;
+                          Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).InpX := NOW + tpd(n)(tr01);
+          WHEN 'x'     => Schd(n).inp1 := TIME'HIGH;
+                          Schd(n).inp0 := TIME'HIGH;
+                          -- update for X->X change
+                          Schd(n).InpX := NOW + Minimum ( tpd(n)(tr10),
+                                                          tpd(n)(tr01) );
+          WHEN OTHERS  => NULL;                   -- no timing change
+        END CASE;
+      END LOOP;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : BufEnab, InvEnab
+    --
+    -- Purpose    : BufEnab and InvEnab compute output change times, from a
+    --              change on an input enable port for a 3-state driver. The
+    --              computed output change times are returned in the composite
+    --              parameters 'schd1', 'schd0'.
+    --
+    --              BufEnab and InpEnab are used together with the delay path
+    --              selection functions (GetSchedDelay, VitalAND, VitalOR... )
+    --              The 'schd' value from each of the non-enable input ports of
+    --              a model (See BufPath, InvPath) are combined using the delay
+    --              selection functions (VitalAND,  VitalOR, ...). The
+    --              GetSchedDelay procedure combines the output times on the
+    --              enable path with the output times from the data path(s) and
+    --              computes the single delay (delta time) value for scheduling
+    --              the output change (passed to VitalGlitchOnEvent)
+    --
+    --              The values in 'schd*' are: (absolute times)
+    --                inp0  :  time of output change due to input change to 0
+    --                inp1  :  time of output change due to input change to 1
+    --                inpX  :  time of output change due to input change to X
+    --                glch0 :  time of output glitch due to input change to 0
+    --                glch1 :  time of output glitch due to input change to 1
+    --
+    --              'schd1' contains output times for 1->Z, Z->1 transitions.
+    --              'schd0' contains output times for 0->Z, Z->0 transitions.
+    --
+    --              'BufEnab' is used for computing the output times for an
+    --              high asserted enable (output 'Z' for enable='0').
+    --              'InvEnab' is used for computing the output times for an
+    --              low asserted enable (output 'Z' for enable='1').
+    --
+    --              Note: separate 'schd1', 'schd0' parameters are generated
+    --                    so that the combination of the delay paths from
+    --                    multiple enable signals may be combined using the
+    --                    same functions/operators used in combining separate
+    --                    data paths. (See exampe 2 below)
+    --
+    --
+    -- Parameters : schd1...... Computed output result times for 1->Z, Z->1
+    --                          transitions. This parameter is modified only on
+    --                          input edge values (events).
+    --              schd0...... Computed output result times for 0->Z, 0->1
+    --                          transitions. This parameter is modified only on
+    --                          input edge values (events).
+    --              Iedg....... Input port edge/level value.
+    --               tpd....... Propagation delays for the enable -> output path.
+    --
+    ---------------------------------------------------------------------------
+    PROCEDURE BufEnab (
+            VARIABLE Schd1 : INOUT SchedType;
+            VARIABLE Schd0 : INOUT SchedType;
+            CONSTANT  Iedg : IN    EdgeType;
+            CONSTANT   tpd : IN    VitalDelayType01Z
+    ) IS
+    BEGIN
+      CASE Iedg IS
+        WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+        WHEN '/'|'R' => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := NOW + tpd(trz1);
+                        Schd1.Glch1 := Schd1.inp1;
+                        Schd1.InpX := Schd1.inp1;
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := NOW + tpd(trz0);
+                        Schd0.Glch1 := Schd0.inp1;
+                        Schd0.InpX := Schd0.inp1;
+        WHEN '\'|'F' => Schd1.inp1 := TIME'HIGH;
+                        Schd1.inp0 := NOW + tpd(tr1z);
+                        Schd1.Glch0 := Schd1.inp0;
+                        Schd1.InpX := Schd1.inp0;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.inp0 := NOW + tpd(tr0z);
+                        Schd0.Glch0 := Schd0.inp0;
+                        Schd0.InpX := Schd0.inp0;
+        WHEN 'r'     => Schd1.inp1 := TIME'HIGH;
+                        Schd1.inp0 := TIME'HIGH;
+                        Schd1.InpX := NOW + tpd(trz1);
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.InpX := NOW + tpd(trz0);
+        WHEN 'f'     => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := TIME'HIGH;
+                        Schd1.InpX := NOW + tpd(tr1z);
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.InpX := NOW + tpd(tr0z);
+        WHEN 'x'     => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := TIME'HIGH;
+                        Schd1.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+        WHEN OTHERS  => NULL;                   -- no timing change
+      END CASE;
+    END;
+
+    PROCEDURE InvEnab (
+            VARIABLE Schd1 : INOUT SchedType;
+            VARIABLE Schd0 : INOUT SchedType;
+            CONSTANT  Iedg : IN    EdgeType;
+            CONSTANT   tpd : IN    VitalDelayType01Z
+    ) IS
+    BEGIN
+      CASE Iedg IS
+        WHEN '0'|'1' => NULL;                   -- no edge: no timing update
+        WHEN '/'|'R' => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := NOW + tpd(tr1z);
+                        Schd1.Glch1 := Schd1.inp1;
+                        Schd1.InpX := Schd1.inp1;
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := NOW + tpd(tr0z);
+                        Schd0.Glch1 := Schd0.inp1;
+                        Schd0.InpX := Schd0.inp1;
+        WHEN '\'|'F' => Schd1.inp1 := TIME'HIGH;
+                        Schd1.inp0 := NOW + tpd(trz1);
+                        Schd1.Glch0 := Schd1.inp0;
+                        Schd1.InpX := Schd1.inp0;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.inp0 := NOW + tpd(trz0);
+                        Schd0.Glch0 := Schd0.inp0;
+                        Schd0.InpX := Schd0.inp0;
+        WHEN 'r'     => Schd1.inp1 := TIME'HIGH;
+                        Schd1.inp0 := TIME'HIGH;
+                        Schd1.InpX := NOW + tpd(tr1z);
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.InpX := NOW + tpd(tr0z);
+        WHEN 'f'     => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := TIME'HIGH;
+                        Schd1.InpX := NOW + tpd(trz1);
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.InpX := NOW + tpd(trz0);
+        WHEN 'x'     => Schd1.inp0 := TIME'HIGH;
+                        Schd1.inp1 := TIME'HIGH;
+                        Schd1.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+                        Schd0.inp0 := TIME'HIGH;
+                        Schd0.inp1 := TIME'HIGH;
+                        Schd0.InpX := NOW + Minimum(tpd(tr10),tpd(tr01));
+        WHEN OTHERS  => NULL;                   -- no timing change
+      END CASE;
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : GetSchedDelay
+    --
+    -- Purpose    : GetSchedDelay computes the final delay (incremental) for
+    --              for scheduling an output signal.  The delay is computed
+    --              from the absolute output times in the 'NewSched' parameter.
+    --              (See BufPath, InvPath).
+    --
+    --              Computation of the output delay for non-3_state outputs
+    --              consists of selection the appropriate output time based
+    --              on the new output value 'NewValue' and subtracting 'NOW'
+    --              to convert to an incremental delay value.
+    --
+    --              The Computation of the output delay for 3_state output
+    --              also includes combination of the enable path delay with
+    --              the date path delay.
+    --
+    -- Parameters : NewDelay... Returned output delay value.
+    --              GlchDelay.. Returned output delay for the start of a glitch.
+    --              NewValue... New output value.
+    --              CurValue... Current value of the output.
+    --              NewSched... Composite containing the combined absolute
+    --                          output times from the data inputs.
+    --              EnSched1... Composite containing the combined absolute
+    --                          output times from the enable input(s).
+    --                          (for a 3_state output transitions 1->Z, Z->1)
+    --              EnSched0... Composite containing the combined absolute
+    --                          output times from the enable input(s).
+    --                          (for a 3_state output transitions 0->Z, Z->0)
+    --
+    ---------------------------------------------------------------------------
+    PROCEDURE GetSchedDelay (
+            VARIABLE   NewDelay : OUT TIME;
+            VARIABLE  GlchDelay : OUT TIME;
+            CONSTANT   NewValue : IN  std_ulogic;
+            CONSTANT   CurValue : IN  std_ulogic;
+            CONSTANT   NewSched : IN  SchedType
+    ) IS
+        VARIABLE Tim, Glch : TIME;
+    BEGIN
+
+        CASE To_UX01(NewValue) IS
+          WHEN '0'    => Tim  := NewSched.inp0;
+                         Glch := NewSched.Glch1;
+          WHEN '1'    => Tim  := NewSched.inp1;
+                         Glch := NewSched.Glch0;
+          WHEN OTHERS => Tim  := NewSched.InpX;
+                         Glch := -1 ns;
+        END CASE;
+        IF (CurValue /= NewValue)
+          THEN Glch := -1 ns;
+        END IF;
+
+        NewDelay  := Tim  - NOW;
+        IF Glch < 0 ns
+            THEN GlchDelay := Glch;
+            ELSE GlchDelay := Glch - NOW;
+        END IF; -- glch < 0 ns
+    END;
+
+    PROCEDURE GetSchedDelay (
+            VARIABLE   NewDelay : OUT VitalTimeArray;
+            VARIABLE  GlchDelay : OUT VitalTimeArray;
+            CONSTANT   NewValue : IN  std_logic_vector;
+            CONSTANT   CurValue : IN  std_logic_vector;
+            CONSTANT   NewSched : IN  SchedArray
+    ) IS
+        VARIABLE Tim, Glch : TIME;
+        ALIAS  NewDelayAlias : VitalTimeArray( NewDelay'LENGTH DOWNTO 1)
+               IS NewDelay;
+        ALIAS GlchDelayAlias : VitalTimeArray(GlchDelay'LENGTH DOWNTO 1)
+               IS GlchDelay;
+        ALIAS  NewSchedAlias : SchedArray( NewSched'LENGTH DOWNTO 1)
+               IS NewSched;
+        ALIAS  NewValueAlias : std_logic_vector (  NewValue'LENGTH DOWNTO 1 )
+                                IS  NewValue;
+        ALIAS  CurValueAlias : std_logic_vector (  CurValue'LENGTH DOWNTO 1 )
+                                IS  CurValue;
+    BEGIN
+      FOR n IN NewDelay'LENGTH DOWNTO 1 LOOP
+        CASE To_UX01(NewValueAlias(n)) IS
+          WHEN '0'    => Tim  := NewSchedAlias(n).inp0;
+                         Glch := NewSchedAlias(n).Glch1;
+          WHEN '1'    => Tim  := NewSchedAlias(n).inp1;
+                         Glch := NewSchedAlias(n).Glch0;
+          WHEN OTHERS => Tim  := NewSchedAlias(n).InpX;
+                         Glch := -1 ns;
+        END CASE;
+        IF (CurValueAlias(n) /= NewValueAlias(n))
+          THEN Glch := -1 ns;
+        END IF;
+
+        NewDelayAlias(n) := Tim  - NOW;
+        IF Glch < 0 ns
+            THEN GlchDelayAlias(n) := Glch;
+            ELSE GlchDelayAlias(n) := Glch - NOW;
+        END IF; -- glch < 0 ns
+      END LOOP;
+      RETURN;
+    END;
+
+    PROCEDURE GetSchedDelay (
+            VARIABLE   NewDelay : OUT TIME;
+            VARIABLE  GlchDelay : OUT TIME;
+            CONSTANT   NewValue : IN  std_ulogic;
+            CONSTANT   CurValue : IN  std_ulogic;
+            CONSTANT   NewSched : IN  SchedType;
+            CONSTANT   EnSched1 : IN  SchedType;
+            CONSTANT   EnSched0 : IN  SchedType
+    ) IS
+        SUBTYPE v2 IS std_logic_vector(0 TO 1);
+        VARIABLE Tim, Glch : TIME;
+    BEGIN
+
+        CASE v2'(To_X01Z(CurValue) & To_X01Z(NewValue)) IS
+          WHEN "00"    => Tim  := Maximum (NewSched.inp0, EnSched0.inp1);
+                          Glch := GlitchMinTime(NewSched.Glch1,EnSched0.Glch0);
+          WHEN "01"    => Tim  := Maximum (NewSched.inp1, EnSched1.inp1);
+                          Glch := EnSched1.Glch0;
+          WHEN "0Z"    => Tim  := EnSched0.inp0;
+                          Glch := NewSched.Glch1;
+          WHEN "0X"    => Tim  := Maximum (NewSched.InpX, EnSched1.InpX);
+                          Glch := 0 ns;
+          WHEN "10"    => Tim  := Maximum (NewSched.inp0, EnSched0.inp1);
+                          Glch := EnSched0.Glch0;
+          WHEN "11"    => Tim  := Maximum (NewSched.inp1, EnSched1.inp1);
+                          Glch := GlitchMinTime(NewSched.Glch0,EnSched1.Glch0);
+          WHEN "1Z"    => Tim  := EnSched1.inp0;
+                          Glch := NewSched.Glch0;
+          WHEN "1X"    => Tim  := Maximum (NewSched.InpX, EnSched0.InpX);
+                          Glch := 0 ns;
+          WHEN "Z0"    => Tim  := Maximum (NewSched.inp0, EnSched0.inp1);
+                          IF NewSched.Glch0 > NOW
+                            THEN Glch := Maximum(NewSched.Glch1,EnSched1.inp1);
+                            ELSE Glch := 0 ns;
+                          END IF;
+          WHEN "Z1"    => Tim  := Maximum (NewSched.inp1, EnSched1.inp1);
+                          IF NewSched.Glch1 > NOW
+                            THEN Glch := Maximum(NewSched.Glch0,EnSched0.inp1);
+                            ELSE Glch := 0 ns;
+                          END IF;
+          WHEN "ZX"    => Tim  := Maximum (NewSched.InpX, EnSched1.InpX);
+                          Glch := 0 ns;
+          WHEN "ZZ"    => Tim  := Maximum (EnSched1.InpX, EnSched0.InpX);
+                          Glch := 0 ns;
+          WHEN "X0"    => Tim  := Maximum (NewSched.inp0, EnSched0.inp1);
+                          Glch := 0 ns;
+          WHEN "X1"    => Tim  := Maximum (NewSched.inp1, EnSched1.inp1);
+                          Glch := 0 ns;
+          WHEN "XZ"    => Tim  := Maximum (EnSched1.InpX, EnSched0.InpX);
+                          Glch := 0 ns;
+          WHEN OTHERS  => Tim  := Maximum (NewSched.InpX, EnSched1.InpX);
+                          Glch := 0 ns;
+
+        END CASE;
+        NewDelay  := Tim  - NOW;
+        IF Glch < 0 ns
+            THEN GlchDelay := Glch;
+            ELSE GlchDelay := Glch - NOW;
+        END IF; -- glch < 0 ns
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Operators and Functions for combination (selection) of path delays
+    -- > These functions support selection of the "appripriate" path delay
+    --   dependent on the logic function.
+    -- > These functions only "select" from the possable output times. No
+    --   calculation (addition) of delays is performed.
+    -- > See description of 'BufPath', 'InvPath' and 'GetSchedDelay'
+    -- > See primitive PROCEDURE models for examples.
+    ---------------------------------------------------------------------------
+
+    FUNCTION "not"  (
+            CONSTANT a : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp1  := a.inp0 ;
+        z.inp0  := a.inp1 ;
+        z.InpX  := a.InpX ;
+        z.Glch1 := a.Glch0;
+        z.Glch0 := a.Glch1;
+        RETURN (z);
+    END;
+
+    FUNCTION "and"  (
+            CONSTANT a, b : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp1  := Maximum   ( a.inp1 , b.inp1  );
+        z.inp0  := Minimum   ( a.inp0 , b.inp0  );
+        z.InpX  := GlitchMinTime ( a.InpX , b.InpX  );
+        z.Glch1 := Maximum   ( a.Glch1, b.Glch1 );
+        z.Glch0 := GlitchMinTime ( a.Glch0, b.Glch0 );
+        RETURN (z);
+    END;
+
+    FUNCTION "or"   (
+            CONSTANT a, b : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp0  := Maximum   ( a.inp0 , b.inp0  );
+        z.inp1  := Minimum   ( a.inp1 , b.inp1  );
+        z.InpX  := GlitchMinTime ( a.InpX , b.InpX  );
+        z.Glch0 := Maximum   ( a.Glch0, b.Glch0 );
+        z.Glch1 := GlitchMinTime ( a.Glch1, b.Glch1 );
+        RETURN (z);
+    END;
+
+    FUNCTION "nand" (
+            CONSTANT a, b : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp0  := Maximum   ( a.inp1 , b.inp1  );
+        z.inp1  := Minimum   ( a.inp0 , b.inp0  );
+        z.InpX  := GlitchMinTime ( a.InpX , b.InpX  );
+        z.Glch0 := Maximum   ( a.Glch1, b.Glch1 );
+        z.Glch1 := GlitchMinTime ( a.Glch0, b.Glch0 );
+        RETURN (z);
+    END;
+
+    FUNCTION "nor"  (
+            CONSTANT a, b : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        z.inp1  := Maximum   ( a.inp0 , b.inp0  );
+        z.inp0  := Minimum   ( a.inp1 , b.inp1  );
+        z.InpX  := GlitchMinTime ( a.InpX , b.InpX  );
+        z.Glch1 := Maximum   ( a.Glch0, b.Glch0 );
+        z.Glch0 := GlitchMinTime ( a.Glch1, b.Glch1 );
+        RETURN (z);
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Delay Calculation for 2-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalXOR2   (
+            CONSTANT ab,ai, bb,bi : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        -- z = (a AND b) NOR (a NOR b)
+        z.inp1  :=   Maximum (  Minimum (ai.inp0 , bi.inp0 ),
+                                Minimum (ab.inp1 , bb.inp1 ) );
+        z.inp0  :=   Minimum (  Maximum (ai.inp1 , bi.inp1 ),
+                                Maximum (ab.inp0 , bb.inp0 ) );
+        z.InpX  :=   Maximum (  Maximum (ai.InpX , bi.InpX ),
+                                Maximum (ab.InpX , bb.InpX ) );
+        z.Glch1 :=   Maximum (GlitchMinTime (ai.Glch0, bi.Glch0),
+                              GlitchMinTime (ab.Glch1, bb.Glch1) );
+        z.Glch0 := GlitchMinTime (  Maximum (ai.Glch1, bi.Glch1),
+                                Maximum (ab.Glch0, bb.Glch0) );
+        RETURN (z);
+    END;
+
+    FUNCTION VitalXNOR2  (
+            CONSTANT ab,ai, bb,bi : IN SchedType
+          ) RETURN SchedType IS
+        VARIABLE z : SchedType;
+    BEGIN
+        -- z = (a AND b) OR (a NOR b)
+        z.inp0  :=   Maximum (  Minimum (ab.inp0 , bb.inp0 ),
+                                Minimum (ai.inp1 , bi.inp1 ) );
+        z.inp1  :=   Minimum (  Maximum (ab.inp1 , bb.inp1 ),
+                                Maximum (ai.inp0 , bi.inp0 ) );
+        z.InpX  :=   Maximum (  Maximum (ab.InpX , bb.InpX ),
+                                Maximum (ai.InpX , bi.InpX ) );
+        z.Glch0 :=   Maximum (GlitchMinTime (ab.Glch0, bb.Glch0),
+                              GlitchMinTime (ai.Glch1, bi.Glch1) );
+        z.Glch1 := GlitchMinTime (  Maximum (ab.Glch1, bb.Glch1),
+                                Maximum (ai.Glch0, bi.Glch0) );
+        RETURN (z);
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Delay Calculation for 3-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalXOR3   (
+            CONSTANT ab,ai, bb,bi, cb,ci : IN SchedType )
+      RETURN SchedType IS
+    BEGIN
+        RETURN VitalXOR2 ( VitalXOR2 (ab,ai, bb,bi),
+                           VitalXOR2 (ai,ab, bi,bb),
+                           cb, ci );
+    END;
+
+    FUNCTION VitalXNOR3  (
+            CONSTANT ab,ai, bb,bi, cb,ci : IN SchedType )
+      RETURN SchedType IS
+    BEGIN
+        RETURN VitalXNOR2 ( VitalXOR2 ( ab,ai, bb,bi ),
+                            VitalXOR2 ( ai,ab, bi,bb ),
+                            cb, ci );
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Delay Calculation for 4-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalXOR4   (
+            CONSTANT ab,ai, bb,bi, cb,ci, db,di : IN SchedType )
+      RETURN SchedType IS
+    BEGIN
+        RETURN VitalXOR2 ( VitalXOR2 ( ab,ai, bb,bi ),
+                           VitalXOR2 ( ai,ab, bi,bb ),
+                           VitalXOR2 ( cb,ci, db,di ),
+                           VitalXOR2 ( ci,cb, di,db ) );
+    END;
+
+    FUNCTION VitalXNOR4  (
+            CONSTANT ab,ai, bb,bi, cb,ci, db,di : IN SchedType )
+      RETURN SchedType IS
+    BEGIN
+        RETURN VitalXNOR2 ( VitalXOR2 ( ab,ai, bb,bi ),
+                            VitalXOR2 ( ai,ab, bi,bb ),
+                            VitalXOR2 ( cb,ci, db,di ),
+                            VitalXOR2 ( ci,cb, di,db ) );
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Delay Calculation for N-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    -- Note: index range on datab,datai assumed to be 1 TO length.
+    --       This is enforced by internal only usage of this Function
+    FUNCTION VitalXOR   (
+            CONSTANT DataB, DataI : IN SchedArray
+          ) RETURN SchedType IS
+            CONSTANT Leng : INTEGER := DataB'LENGTH;
+    BEGIN
+        IF Leng = 2 THEN
+            RETURN VitalXOR2 ( DataB(1),DataI(1), DataB(2),DataI(2) );
+        ELSE
+            RETURN VitalXOR2 ( VitalXOR ( DataB(1 TO Leng-1),
+                                          DataI(1 TO Leng-1) ),
+                               VitalXOR ( DataI(1 TO Leng-1),
+                                          DataB(1 TO Leng-1) ),
+                               DataB(Leng),DataI(Leng) );
+        END IF;
+    END;
+
+    -- Note: index range on datab,datai assumed to be 1 TO length.
+    --       This is enforced by internal only usage of this Function
+    FUNCTION VitalXNOR  (
+            CONSTANT DataB, DataI : IN SchedArray
+          ) RETURN SchedType IS
+            CONSTANT Leng : INTEGER := DataB'LENGTH;
+    BEGIN
+        IF Leng = 2 THEN
+            RETURN VitalXNOR2 ( DataB(1),DataI(1), DataB(2),DataI(2) );
+        ELSE
+            RETURN VitalXNOR2 ( VitalXOR ( DataB(1 TO Leng-1),
+                                           DataI(1 TO Leng-1) ),
+                                VitalXOR ( DataI(1 TO Leng-1),
+                                           DataB(1 TO Leng-1) ),
+                                DataB(Leng),DataI(Leng) );
+        END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Multiplexor
+    --   MUX   .......... result := data(dselect)
+    --   MUX2  .......... 2-input mux; result := data0 when (dselect = '0'),
+    --                                           data1 when (dselect = '1'),
+    --                        'X' when (dselect = 'X') and (data0 /= data1)
+    --   MUX4  .......... 4-input mux; result := data(dselect)
+    --   MUX8  .......... 8-input mux; result := data(dselect)
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalMUX2  (
+            CONSTANT d1, d0 : IN SchedType;
+            CONSTANT sb, SI : IN SchedType
+          ) RETURN SchedType IS
+    BEGIN
+        RETURN (d1 AND sb) OR (d0 AND (NOT SI) );
+    END;
+--
+    FUNCTION VitalMUX4  (
+            CONSTANT Data : IN SchedArray4;
+            CONSTANT sb   : IN SchedArray2;
+            CONSTANT SI   : IN SchedArray2
+          ) RETURN SchedType IS
+    BEGIN
+        RETURN    (      sb(1)  AND VitalMUX2(Data(3),Data(2), sb(0), SI(0)) )
+               OR ( (NOT SI(1)) AND VitalMUX2(Data(1),Data(0), sb(0), SI(0)) );
+    END;
+
+    FUNCTION VitalMUX8  (
+            CONSTANT Data : IN SchedArray8;
+            CONSTANT sb   : IN SchedArray3;
+            CONSTANT SI   : IN SchedArray3
+          ) RETURN SchedType IS
+    BEGIN
+        RETURN    ( (    sb(2)) AND VitalMUX4 (Data(7 DOWNTO 4),
+                                           sb(1 DOWNTO 0), SI(1 DOWNTO 0) ) )
+               OR ( (NOT SI(2)) AND VitalMUX4 (Data(3 DOWNTO 0),
+                                           sb(1 DOWNTO 0), SI(1 DOWNTO 0) ) );
+    END;
+--
+    FUNCTION VInterMux   (
+            CONSTANT Data : IN SchedArray;
+            CONSTANT sb   : IN SchedArray;
+            CONSTANT SI   : IN SchedArray
+          ) RETURN SchedType IS
+        CONSTANT sMsb : INTEGER := sb'LENGTH;
+        CONSTANT dMsbHigh : INTEGER := Data'LENGTH;
+        CONSTANT dMsbLow  : INTEGER := Data'LENGTH/2;
+    BEGIN
+        IF sb'LENGTH = 1 THEN
+          RETURN VitalMUX2( Data(2), Data(1), sb(1), SI(1) );
+        ELSIF sb'LENGTH = 2 THEN
+          RETURN VitalMUX4( Data, sb, SI );
+        ELSIF sb'LENGTH = 3 THEN
+          RETURN VitalMUX8( Data, sb, SI );
+        ELSIF sb'LENGTH > 3 THEN
+          RETURN ((    sb(sMsb)) AND VInterMux( Data(dMsbLow  DOWNTO  1),
+                                                  sb(sMsb-1 DOWNTO 1),
+                                                  SI(sMsb-1 DOWNTO 1) ))
+              OR ((NOT SI(sMsb)) AND VInterMux( Data(dMsbHigh DOWNTO dMsbLow+1),
+                                                  sb(sMsb-1 DOWNTO 1),
+                                                  SI(sMsb-1 DOWNTO 1) ));
+        ELSE
+          RETURN (0 ns, 0 ns, 0 ns, 0 ns, 0 ns); -- dselect'LENGTH < 1
+        END IF;
+    END;
+--
+    FUNCTION VitalMUX   (
+            CONSTANT Data : IN SchedArray;
+            CONSTANT sb   : IN SchedArray;
+            CONSTANT SI   : IN SchedArray
+          ) RETURN SchedType IS
+        CONSTANT msb : INTEGER := 2**sb'LENGTH;
+        VARIABLE    lDat : SchedArray(msb DOWNTO 1);
+        ALIAS DataAlias : SchedArray ( Data'LENGTH DOWNTO 1 ) IS Data;
+        ALIAS   sbAlias : SchedArray (   sb'LENGTH DOWNTO 1 ) IS sb;
+        ALIAS   siAlias : SchedArray (   SI'LENGTH DOWNTO 1 ) IS SI;
+    BEGIN
+        IF Data'LENGTH <= msb THEN
+            FOR i IN Data'LENGTH DOWNTO 1 LOOP
+                lDat(i) := DataAlias(i);
+            END LOOP;
+            FOR i IN msb DOWNTO Data'LENGTH+1 LOOP
+                lDat(i) := DefSchedAnd;
+            END LOOP;
+        ELSE
+            FOR i IN msb DOWNTO 1 LOOP
+                lDat(i) := DataAlias(i);
+            END LOOP;
+        END IF;
+        RETURN VInterMux( lDat, sbAlias, siAlias );
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Decoder
+    --          General Algorithm :
+    --              (a) Result(...) := '0' when (enable = '0')
+    --              (b) Result(data) := '1'; all other subelements = '0'
+    --              ... Result array is decending (n-1 downto 0)
+    --
+    --          DECODERn  .......... n:2**n decoder
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalDECODER2  (
+            CONSTANT DataB  : IN SchedType;
+            CONSTANT DataI  : IN SchedType;
+            CONSTANT Enable : IN SchedType
+          ) RETURN SchedArray IS
+        VARIABLE Result : SchedArray2;
+    BEGIN
+        Result(1) := Enable AND (    DataB);
+        Result(0) := Enable AND (NOT DataI);
+        RETURN Result;
+    END;
+
+    FUNCTION VitalDECODER4  (
+            CONSTANT DataB  : IN SchedArray2;
+            CONSTANT DataI  : IN SchedArray2;
+            CONSTANT Enable : IN SchedType
+          ) RETURN SchedArray IS
+        VARIABLE Result : SchedArray4;
+    BEGIN
+        Result(3) := Enable AND (    DataB(1)) AND (    DataB(0));
+        Result(2) := Enable AND (    DataB(1)) AND (NOT DataI(0));
+        Result(1) := Enable AND (NOT DataI(1)) AND (    DataB(0));
+        Result(0) := Enable AND (NOT DataI(1)) AND (NOT DataI(0));
+        RETURN Result;
+    END;
+
+    FUNCTION VitalDECODER8  (
+            CONSTANT DataB  : IN SchedArray3;
+            CONSTANT DataI  : IN SchedArray3;
+            CONSTANT Enable : IN SchedType
+          ) RETURN SchedArray IS
+        VARIABLE Result : SchedArray8;
+    BEGIN
+        Result(7):= Enable AND (    DataB(2))AND(    DataB(1))AND(    DataB(0));
+        Result(6):= Enable AND (    DataB(2))AND(    DataB(1))AND(NOT DataI(0));
+        Result(5):= Enable AND (    DataB(2))AND(NOT DataI(1))AND(    DataB(0));
+        Result(4):= Enable AND (    DataB(2))AND(NOT DataI(1))AND(NOT DataI(0));
+        Result(3):= Enable AND (NOT DataI(2))AND(    DataB(1))AND(    DataB(0));
+        Result(2):= Enable AND (NOT DataI(2))AND(    DataB(1))AND(NOT DataI(0));
+        Result(1):= Enable AND (NOT DataI(2))AND(NOT DataI(1))AND(    DataB(0));
+        Result(0):= Enable AND (NOT DataI(2))AND(NOT DataI(1))AND(NOT DataI(0));
+        RETURN Result;
+    END;
+
+
+    FUNCTION VitalDECODER   (
+            CONSTANT DataB  : IN SchedArray;
+            CONSTANT DataI  : IN SchedArray;
+            CONSTANT Enable : IN SchedType
+          ) RETURN SchedArray IS
+        CONSTANT DMsb : INTEGER := DataB'LENGTH - 1;
+        ALIAS DataBAlias : SchedArray ( DMsb DOWNTO 0 ) IS DataB;
+        ALIAS DataIAlias : SchedArray ( DMsb DOWNTO 0 ) IS DataI;
+    BEGIN
+        IF DataB'LENGTH = 1 THEN
+            RETURN  VitalDECODER2 ( DataBAlias(    0     ),
+                                    DataIAlias(    0     ), Enable );
+        ELSIF DataB'LENGTH = 2 THEN
+            RETURN  VitalDECODER4 ( DataBAlias(1 DOWNTO 0),
+                                    DataIAlias(1 DOWNTO 0), Enable );
+        ELSIF DataB'LENGTH = 3 THEN
+            RETURN  VitalDECODER8 ( DataBAlias(2 DOWNTO 0),
+                                    DataIAlias(2 DOWNTO 0), Enable );
+        ELSIF DataB'LENGTH > 3 THEN
+            RETURN  VitalDECODER  ( DataBAlias(DMsb-1 DOWNTO 0),
+                                    DataIAlias(DMsb-1 DOWNTO 0),
+                                    Enable AND (    DataBAlias(DMsb)) )
+                  & VitalDECODER  ( DataBAlias(DMsb-1 DOWNTO 0),
+                                    DataIAlias(DMsb-1 DOWNTO 0),
+                                    Enable AND (NOT DataIAlias(DMsb)) );
+        ELSE
+            RETURN DefSchedArray2;
+        END IF;
+    END;
+
+
+-------------------------------------------------------------------------------
+-- PRIMITIVES
+-------------------------------------------------------------------------------
+    -- ------------------------------------------------------------------------
+    -- N-bit wide Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalAND    (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '1';
+        FOR i IN Data'RANGE LOOP
+            Result := Result AND Data(i);
+        END LOOP;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalOR     (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '0';
+        FOR i IN Data'RANGE LOOP
+            Result := Result OR Data(i);
+        END LOOP;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalXOR    (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '0';
+        FOR i IN Data'RANGE LOOP
+            Result := Result XOR Data(i);
+        END LOOP;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalNAND   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '1';
+        FOR i IN Data'RANGE LOOP
+            Result := Result AND Data(i);
+        END LOOP;
+        RETURN ResultMap(NOT Result);
+    END;
+--
+    FUNCTION VitalNOR    (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '0';
+        FOR i IN Data'RANGE LOOP
+            Result := Result OR Data(i);
+        END LOOP;
+        RETURN ResultMap(NOT Result);
+    END;
+--
+    FUNCTION VitalXNOR   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        Result := '0';
+        FOR i IN Data'RANGE LOOP
+            Result := Result XOR Data(i);
+        END LOOP;
+        RETURN ResultMap(NOT Result);
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Commonly used 2-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalAND2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a AND b);
+    END;
+--
+    FUNCTION VitalOR2    (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a OR b);
+    END;
+--
+    FUNCTION VitalXOR2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a XOR b);
+    END;
+--
+    FUNCTION VitalNAND2  (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a NAND b);
+    END;
+--
+    FUNCTION VitalNOR2   (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a NOR b);
+    END;
+--
+    FUNCTION VitalXNOR2  (
+            CONSTANT       a, b :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a XOR b));
+    END;
+--
+    -- ------------------------------------------------------------------------
+    -- Commonly used 3-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalAND3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a AND b AND c);
+    END;
+--
+    FUNCTION VitalOR3    (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a OR b OR c);
+    END;
+--
+    FUNCTION VitalXOR3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a XOR b XOR c);
+    END;
+--
+    FUNCTION VitalNAND3  (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a AND b AND c));
+    END;
+--
+    FUNCTION VitalNOR3   (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a OR b OR c));
+    END;
+--
+    FUNCTION VitalXNOR3  (
+            CONSTANT    a, b, c :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a XOR b XOR c));
+    END;
+
+    -- ---------------------------------------------------------------------------
+    -- Commonly used 4-bit Logical gates.
+    -- ---------------------------------------------------------------------------
+    FUNCTION VitalAND4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a AND b AND c AND d);
+    END;
+--
+    FUNCTION VitalOR4    (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a OR b OR c OR d);
+    END;
+--
+    FUNCTION VitalXOR4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(a XOR b XOR c XOR d);
+    END;
+--
+    FUNCTION VitalNAND4  (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a AND b AND c AND d));
+    END;
+--
+    FUNCTION VitalNOR4   (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a OR b OR c OR d));
+    END;
+--
+    FUNCTION VitalXNOR4  (
+            CONSTANT a, b, c, d :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                      := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT (a XOR b XOR c XOR d));
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Buffers
+    --   BUF    ....... standard non-inverting buffer
+    --   BUFIF0 ....... non-inverting buffer Data passes thru if (Enable = '0')
+    --   BUFIF1 ....... non-inverting buffer Data passes thru if (Enable = '1')
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalBUF    (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(To_UX01(Data));
+    END;
+--
+    FUNCTION VitalBUFIF0 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(BufIf0_Table(Enable,Data));
+    END;
+--
+    FUNCTION VitalBUFIF1 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(BufIf1_Table(Enable,Data));
+    END;
+    FUNCTION VitalIDENT  (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(To_UX01Z(Data));
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Invertors
+    --   INV    ......... standard inverting buffer
+    --   INVIF0 ......... inverting buffer Data passes thru if (Enable = '0')
+    --   INVIF1 ......... inverting buffer Data passes thru if (Enable = '1')
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalINV    (
+            CONSTANT         Data :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(NOT Data);
+    END;
+--
+    FUNCTION VitalINVIF0 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(InvIf0_Table(Enable,Data));
+    END;
+--
+    FUNCTION VitalINVIF1 (
+            CONSTANT Data, Enable :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+          ) RETURN std_ulogic IS
+    BEGIN
+        RETURN ResultMap(InvIf1_Table(Enable,Data));
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Multiplexor
+    --   MUX   .......... result := data(dselect)
+    --   MUX2  .......... 2-input mux; result := data0 when (dselect = '0'),
+    --                                           data1 when (dselect = '1'),
+    --                        'X' when (dselect = 'X') and (data0 /= data1)
+    --   MUX4  .......... 4-input mux; result := data(dselect)
+    --   MUX8  .......... 8-input mux; result := data(dselect)
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalMUX2  (
+            CONSTANT Data1, Data0 :  IN std_ulogic;
+            CONSTANT      dSelect :  IN std_ulogic;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        CASE To_X01(dSelect) IS
+          WHEN '0'    => Result := To_UX01(Data0);
+          WHEN '1'    => Result := To_UX01(Data1);
+          WHEN OTHERS => Result := VitalSame( Data1, Data0 );
+        END CASE;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalMUX4  (
+            CONSTANT       Data :  IN std_logic_vector4;
+            CONSTANT    dSelect :  IN std_logic_vector2;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Slct : std_logic_vector2;
+        VARIABLE Result : UX01;
+    BEGIN
+        Slct := To_X01(dSelect);
+        CASE Slct IS
+          WHEN "00"   => Result := To_UX01(Data(0));
+          WHEN "01"   => Result := To_UX01(Data(1));
+          WHEN "10"   => Result := To_UX01(Data(2));
+          WHEN "11"   => Result := To_UX01(Data(3));
+          WHEN "0X"   => Result := VitalSame( Data(1), Data(0) );
+          WHEN "1X"   => Result := VitalSame( Data(2), Data(3) );
+          WHEN "X0"   => Result := VitalSame( Data(2), Data(0) );
+          WHEN "X1"   => Result := VitalSame( Data(3), Data(1) );
+          WHEN OTHERS => Result := VitalSame( VitalSame(Data(3),Data(2)),
+                                              VitalSame(Data(1),Data(0)));
+        END CASE;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VitalMUX8  (
+            CONSTANT       Data :  IN std_logic_vector8;
+            CONSTANT    dSelect :  IN std_logic_vector3;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        VARIABLE Result : UX01;
+    BEGIN
+        CASE To_X01(dSelect(2)) IS
+          WHEN '0'    => Result := VitalMUX4( Data(3 DOWNTO 0),
+                                              dSelect(1 DOWNTO 0));
+          WHEN '1'    => Result := VitalMUX4( Data(7 DOWNTO 4),
+                                              dSelect(1 DOWNTO 0));
+          WHEN OTHERS => Result := VitalSame( VitalMUX4( Data(3 DOWNTO 0),
+                                                         dSelect(1 DOWNTO 0)),
+                                              VitalMUX4( Data(7 DOWNTO 4),
+                                                         dSelect(1 DOWNTO 0)));
+        END CASE;
+        RETURN ResultMap(Result);
+    END;
+--
+    FUNCTION VInterMux    (
+            CONSTANT Data    : IN std_logic_vector;
+            CONSTANT dSelect : IN std_logic_vector
+          ) RETURN std_ulogic IS
+
+        CONSTANT sMsb     : INTEGER := dSelect'LENGTH;
+        CONSTANT dMsbHigh : INTEGER := Data'LENGTH;
+        CONSTANT dMsbLow  : INTEGER := Data'LENGTH/2;
+        ALIAS DataAlias : std_logic_vector (   Data'LENGTH DOWNTO 1) IS Data;
+        ALIAS dSelAlias : std_logic_vector (dSelect'LENGTH DOWNTO 1) IS dSelect;
+
+        VARIABLE Result : UX01;
+    BEGIN
+        IF dSelect'LENGTH = 1 THEN
+            Result := VitalMUX2( DataAlias(2), DataAlias(1), dSelAlias(1) );
+        ELSIF dSelect'LENGTH = 2 THEN
+            Result := VitalMUX4( DataAlias, dSelAlias );
+        ELSIF dSelect'LENGTH > 2 THEN
+          CASE To_X01(dSelect(sMsb)) IS
+            WHEN '0'    =>
+              Result := VInterMux( DataAlias(dMsbLow  DOWNTO          1),
+                                   dSelAlias(sMsb-1 DOWNTO 1) );
+            WHEN '1'    =>
+              Result := VInterMux( DataAlias(dMsbHigh DOWNTO dMsbLow+1),
+                                   dSelAlias(sMsb-1 DOWNTO 1) );
+            WHEN OTHERS =>
+              Result := VitalSame(
+                              VInterMux( DataAlias(dMsbLow  DOWNTO          1),
+                                         dSelAlias(sMsb-1 DOWNTO 1) ),
+                              VInterMux( DataAlias(dMsbHigh DOWNTO dMsbLow+1),
+                                         dSelAlias(sMsb-1 DOWNTO 1) )
+                              );
+          END CASE;
+        ELSE
+          Result := 'X'; -- dselect'LENGTH < 1
+        END IF;
+        RETURN Result;
+    END;
+--
+    FUNCTION VitalMUX   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT    dSelect :  IN std_logic_vector;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_ulogic IS
+        CONSTANT msb    : INTEGER := 2**dSelect'LENGTH;
+        ALIAS DataAlias : std_logic_vector (   Data'LENGTH DOWNTO 1) IS Data;
+        ALIAS dSelAlias : std_logic_vector (dSelect'LENGTH DOWNTO 1) IS dSelect;
+        VARIABLE lDat   : std_logic_vector(msb DOWNTO 1) := (OTHERS=>'X');
+        VARIABLE Result : UX01;
+    BEGIN
+        IF Data'LENGTH <= msb THEN
+            FOR i IN Data'LENGTH DOWNTO 1 LOOP
+                lDat(i) := DataAlias(i);
+            END LOOP;
+        ELSE
+            FOR i IN msb DOWNTO 1 LOOP
+                lDat(i) := DataAlias(i);
+            END LOOP;
+        END IF;
+        Result := VInterMux( lDat, dSelAlias );
+        RETURN ResultMap(Result);
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Decoder
+    --          General Algorithm :
+    --              (a) Result(...) := '0' when (enable = '0')
+    --              (b) Result(data) := '1'; all other subelements = '0'
+    --              ... Result array is decending (n-1 downto 0)
+    --
+    --          DECODERn  .......... n:2**n decoder
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalDECODER2  (
+            CONSTANT       Data :  IN std_ulogic;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector2 IS
+        VARIABLE Result : std_logic_vector2;
+    BEGIN
+        Result(1) := ResultMap(Enable AND (    Data));
+        Result(0) := ResultMap(Enable AND (NOT Data));
+        RETURN Result;
+    END;
+--
+    FUNCTION VitalDECODER4  (
+            CONSTANT       Data :  IN std_logic_vector2;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector4 IS
+        VARIABLE Result : std_logic_vector4;
+    BEGIN
+        Result(3) := ResultMap(Enable AND (    Data(1)) AND (    Data(0)));
+        Result(2) := ResultMap(Enable AND (    Data(1)) AND (NOT Data(0)));
+        Result(1) := ResultMap(Enable AND (NOT Data(1)) AND (    Data(0)));
+        Result(0) := ResultMap(Enable AND (NOT Data(1)) AND (NOT Data(0)));
+        RETURN Result;
+    END;
+--
+    FUNCTION VitalDECODER8  (
+            CONSTANT       Data :  IN std_logic_vector3;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector8 IS
+        VARIABLE Result : std_logic_vector8;
+    BEGIN
+        Result(7) := (    Data(2)) AND (    Data(1)) AND (    Data(0));
+        Result(6) := (    Data(2)) AND (    Data(1)) AND (NOT Data(0));
+        Result(5) := (    Data(2)) AND (NOT Data(1)) AND (    Data(0));
+        Result(4) := (    Data(2)) AND (NOT Data(1)) AND (NOT Data(0));
+        Result(3) := (NOT Data(2)) AND (    Data(1)) AND (    Data(0));
+        Result(2) := (NOT Data(2)) AND (    Data(1)) AND (NOT Data(0));
+        Result(1) := (NOT Data(2)) AND (NOT Data(1)) AND (    Data(0));
+        Result(0) := (NOT Data(2)) AND (NOT Data(1)) AND (NOT Data(0));
+
+        Result(0) := ResultMap ( Enable AND Result(0) );
+        Result(1) := ResultMap ( Enable AND Result(1) );
+        Result(2) := ResultMap ( Enable AND Result(2) );
+        Result(3) := ResultMap ( Enable AND Result(3) );
+        Result(4) := ResultMap ( Enable AND Result(4) );
+        Result(5) := ResultMap ( Enable AND Result(5) );
+        Result(6) := ResultMap ( Enable AND Result(6) );
+        Result(7) := ResultMap ( Enable AND Result(7) );
+
+        RETURN Result;
+    END;
+--
+    FUNCTION VitalDECODER   (
+            CONSTANT       Data :  IN std_logic_vector;
+            CONSTANT     Enable :  IN std_ulogic;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+          ) RETURN std_logic_vector IS
+
+        CONSTANT DMsb : INTEGER := Data'LENGTH - 1;
+        ALIAS DataAlias : std_logic_vector ( DMsb DOWNTO 0 ) IS Data;
+    BEGIN
+        IF    Data'LENGTH = 1 THEN
+            RETURN VitalDECODER2 (DataAlias(    0     ), Enable, ResultMap );
+        ELSIF Data'LENGTH = 2 THEN
+            RETURN VitalDECODER4 (DataAlias(1 DOWNTO 0), Enable, ResultMap );
+        ELSIF Data'LENGTH = 3 THEN
+            RETURN VitalDECODER8 (DataAlias(2 DOWNTO 0), Enable, ResultMap );
+        ELSIF Data'LENGTH > 3 THEN
+            RETURN VitalDECODER  (DataAlias(DMsb-1 DOWNTO 0),
+                                  Enable AND (    DataAlias(DMsb)), ResultMap )
+                 & VitalDECODER  (DataAlias(DMsb-1 DOWNTO 0),
+                                  Enable AND (NOT DataAlias(DMsb)), ResultMap );
+        ELSE RETURN "X";
+        END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- N-bit wide Logical gates.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalAND   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge :  EdgeArray(Data'RANGE);
+        VARIABLE Data_Schd : SchedArray(Data'RANGE);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalAND(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := '1';
+        new_schd := Data_Schd(Data_Schd'LEFT);
+        FOR i IN Data'RANGE LOOP
+            NewValue  := NewValue  AND Data(i);
+            new_schd := new_schd AND Data_Schd(i);
+        END LOOP;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalOR    (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge :  EdgeArray(Data'RANGE);
+        VARIABLE Data_Schd : SchedArray(Data'RANGE);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalOR(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := '0';
+        new_schd := Data_Schd(Data_Schd'LEFT);
+        FOR i IN Data'RANGE LOOP
+            NewValue  := NewValue  OR Data(i);
+            new_schd := new_schd OR Data_Schd(i);
+        END LOOP;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalXOR   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge   :  EdgeArray(Data'RANGE);
+        VARIABLE DataB_Schd  : SchedArray(1 TO Data'LENGTH);
+        VARIABLE DataI_Schd  : SchedArray(1 TO Data'LENGTH);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS ADataB_Schd : SchedArray(Data'RANGE) IS DataB_Schd;
+        ALIAS ADataI_Schd : SchedArray(Data'RANGE) IS DataI_Schd;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalXOR(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( ADataB_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( ADataI_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( DataB_Schd, Data_Edge, Atpd_data_q );
+        InvPath ( DataI_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := VitalXOR ( Data );
+        new_schd := VitalXOR ( DataB_Schd, DataI_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalNAND  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge :  EdgeArray(Data'RANGE);
+        VARIABLE Data_Schd : SchedArray(Data'RANGE);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalNAND(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            InvPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        InvPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := '1';
+        new_schd := Data_Schd(Data_Schd'LEFT);
+        FOR i IN Data'RANGE LOOP
+            NewValue  := NewValue  AND Data(i);
+            new_schd := new_schd AND Data_Schd(i);
+        END LOOP;
+        NewValue  := NOT NewValue;
+        new_schd := NOT new_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF;
+    END;
+--
+    PROCEDURE VitalNOR   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge :  EdgeArray(Data'RANGE);
+        VARIABLE Data_Schd : SchedArray(Data'RANGE);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalNOR(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            InvPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        InvPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := '0';
+        new_schd := Data_Schd(Data_Schd'LEFT);
+        FOR i IN Data'RANGE LOOP
+            NewValue  := NewValue  OR Data(i);
+            new_schd := new_schd OR Data_Schd(i);
+        END LOOP;
+        NewValue  := NOT NewValue;
+        new_schd := NOT new_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalXNOR  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData    : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE Data_Edge   :  EdgeArray(Data'RANGE);
+        VARIABLE DataB_Schd  : SchedArray(1 TO Data'LENGTH);
+        VARIABLE DataI_Schd  : SchedArray(1 TO Data'LENGTH);
+        VARIABLE NewValue     : UX01;
+        VARIABLE Glitch_Data : GlitchDataType;
+        VARIABLE new_schd    : SchedType;
+        VARIABLE Dly, Glch   : TIME;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS ADataB_Schd : SchedArray(Data'RANGE) IS DataB_Schd;
+        ALIAS ADataI_Schd : SchedArray(Data'RANGE) IS DataI_Schd;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalXNOR(Data, ResultMap);
+          WAIT ON Data;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( ADataB_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( ADataI_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( DataB_Schd, Data_Edge, Atpd_data_q );
+        InvPath ( DataI_Schd, Data_Edge, Atpd_data_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := VitalXNOR ( Data );
+        new_schd := VitalXNOR ( DataB_Schd, DataI_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+
+    -- ------------------------------------------------------------------------
+    -- Commonly used 2-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalAND2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalAND2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := a AND b;
+        new_schd := a_schd AND b_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalOR2   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalOR2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := a OR b;
+        new_schd := a_schd OR b_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNAND2 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNAND2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := a NAND b;
+        new_schd := a_schd NAND b_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNOR2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNOR2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := a NOR b;
+        new_schd := a_schd NOR b_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXOR2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd : SchedType;
+        VARIABLE ai_schd, bi_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXOR2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a XOR b;
+        new_schd := VitalXOR2 ( ab_schd,ai_schd, bb_schd,bi_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXNOR2 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         a, b :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd : SchedType;
+        VARIABLE ai_schd, bi_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXNOR2 ( a, b, ResultMap );
+        WAIT ON a, b;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := NOT (a XOR b);
+        new_schd := VitalXNOR2 ( ab_schd,ai_schd, bb_schd,bi_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Commonly used 3-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalAND3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+--
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalAND3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( c_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+        BufPath ( c_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a AND b AND c;
+        new_schd := a_schd AND b_schd AND c_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalOR3   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalOR3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( c_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+        BufPath ( c_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a OR b OR c;
+        new_schd := a_schd OR b_schd OR c_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNAND3 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNAND3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( c_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+        InvPath ( c_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := (a AND b) NAND c;
+        new_schd := (a_schd AND b_schd) NAND c_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNOR3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNOR3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( c_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+        InvPath ( c_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := (a OR b) NOR c;
+        new_schd := (a_schd OR b_schd) NOR c_schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXOR3  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd, cb_schd : SchedType;
+        VARIABLE ai_schd, bi_schd, ci_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXOR3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( cb_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( ci_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, GetEdge(c), tpd_c_q );
+        InvPath ( ci_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a XOR b XOR c;
+        new_schd := VitalXOR3 ( ab_schd,ai_schd,
+                                bb_schd,bi_schd,
+                                cb_schd,ci_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXNOR3 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL      a, b, c :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd, cb_schd : SchedType;
+        VARIABLE ai_schd, bi_schd, ci_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXNOR3 ( a, b, c, ResultMap );
+        WAIT ON a, b, c;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( cb_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( ci_schd, InitialEdge(c), tpd_c_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, GetEdge(c), tpd_c_q );
+        InvPath ( ci_schd, GetEdge(c), tpd_c_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := NOT (a XOR b XOR c);
+        new_schd := VitalXNOR3 ( ab_schd, ai_schd,
+                                 bb_schd, bi_schd,
+                                 cb_schd, ci_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Commonly used 4-bit Logical gates.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalAND4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalAND4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( c_schd, InitialEdge(c), tpd_c_q );
+        BufPath ( d_Schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+        BufPath ( c_schd, GetEdge(c), tpd_c_q );
+        BufPath ( d_Schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a AND b AND c AND d;
+        new_schd := a_schd AND b_schd AND c_schd AND d_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalOR4   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalOR4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( a_schd, InitialEdge(a), tpd_a_q );
+        BufPath ( b_schd, InitialEdge(b), tpd_b_q );
+        BufPath ( c_schd, InitialEdge(c), tpd_c_q );
+        BufPath ( d_Schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( a_schd, GetEdge(a), tpd_a_q );
+        BufPath ( b_schd, GetEdge(b), tpd_b_q );
+        BufPath ( c_schd, GetEdge(c), tpd_c_q );
+        BufPath ( d_Schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a OR b OR c OR d;
+        new_schd := a_schd OR b_schd OR c_schd OR d_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNAND4 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNAND4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( c_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( d_Schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+        InvPath ( c_schd, GetEdge(c), tpd_c_q );
+        InvPath ( d_Schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := (a AND b) NAND (c AND d);
+        new_schd := (a_schd AND b_schd) NAND (c_schd AND d_Schd);
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalNOR4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalNOR4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( a_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( b_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( c_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( d_Schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( a_schd, GetEdge(a), tpd_a_q );
+        InvPath ( b_schd, GetEdge(b), tpd_b_q );
+        InvPath ( c_schd, GetEdge(c), tpd_c_q );
+        InvPath ( d_Schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := (a OR b) NOR (c OR d);
+        new_schd := (a_schd OR b_schd) NOR (c_schd OR d_Schd);
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXOR4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd, cb_schd, DB_Schd : SchedType;
+        VARIABLE ai_schd, bi_schd, ci_schd, di_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXOR4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( ci_schd, InitialEdge(c), tpd_c_q );
+
+        BufPath ( DB_Schd, InitialEdge(d), tpd_d_q );
+        InvPath ( di_schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, GetEdge(c), tpd_c_q );
+        InvPath ( ci_schd, GetEdge(c), tpd_c_q );
+
+        BufPath ( DB_Schd, GetEdge(d), tpd_d_q );
+        InvPath ( di_schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := a XOR b XOR c XOR d;
+        new_schd := VitalXOR4 ( ab_schd,ai_schd, bb_schd,bi_schd,
+                                cb_schd,ci_schd, DB_Schd,di_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalXNOR4 (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL   a, b, c, d :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_b_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_c_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    tpd_d_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE ab_schd, bb_schd, cb_schd, DB_Schd : SchedType;
+        VARIABLE ai_schd, bi_schd, ci_schd, di_schd : SchedType;
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_a_q = VitalZeroDelay01)
+         AND (tpd_b_q = VitalZeroDelay01)
+         AND (tpd_c_q = VitalZeroDelay01)
+         AND (tpd_d_q = VitalZeroDelay01)) THEN
+      LOOP
+        q <= VitalXNOR4 ( a, b, c, d, ResultMap );
+        WAIT ON a, b, c, d;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, InitialEdge(a), tpd_a_q );
+        InvPath ( ai_schd, InitialEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, InitialEdge(b), tpd_b_q );
+        InvPath ( bi_schd, InitialEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, InitialEdge(c), tpd_c_q );
+        InvPath ( ci_schd, InitialEdge(c), tpd_c_q );
+
+        BufPath ( DB_Schd, InitialEdge(d), tpd_d_q );
+        InvPath ( di_schd, InitialEdge(d), tpd_d_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( ab_schd, GetEdge(a), tpd_a_q );
+        InvPath ( ai_schd, GetEdge(a), tpd_a_q );
+
+        BufPath ( bb_schd, GetEdge(b), tpd_b_q );
+        InvPath ( bi_schd, GetEdge(b), tpd_b_q );
+
+        BufPath ( cb_schd, GetEdge(c), tpd_c_q );
+        InvPath ( ci_schd, GetEdge(c), tpd_c_q );
+
+        BufPath ( DB_Schd, GetEdge(d), tpd_d_q );
+        InvPath ( di_schd, GetEdge(d), tpd_d_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := NOT (a XOR b XOR c XOR d);
+        new_schd := VitalXNOR4 ( ab_schd,ai_schd, bb_schd,bi_schd,
+                                 cb_schd,ci_schd, DB_Schd,di_schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON a, b, c, d;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Buffers
+    --   BUF    ....... standard non-inverting buffer
+    --   BUFIF0 ....... non-inverting buffer Data passes thru if (Enable = '0')
+    --   BUFIF1 ....... non-inverting buffer Data passes thru if (Enable = '1')
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalBUF   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE NewValue      : UX01;
+        VARIABLE Glitch_Data  : GlitchDataType;
+        VARIABLE Dly, Glch    : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (tpd_a_q = VitalZeroDelay01) THEN
+      LOOP
+        q <= ResultMap(To_UX01(a));
+        WAIT ON a;
+      END LOOP;
+
+    ELSE
+      LOOP
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := To_UX01(a);     -- convert to forcing strengths
+        CASE EdgeType'(GetEdge(a)) IS
+          WHEN '1'|'/'|'R'|'r' => Dly := tpd_a_q(tr01);
+          WHEN '0'|'\'|'F'|'f' => Dly := tpd_a_q(tr10);
+          WHEN OTHERS          => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10));
+        END CASE;
+
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode );
+
+        WAIT ON a;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalBUFIF1 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        VARIABLE NewValue        : UX01Z;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_data_q   = VitalZeroDelay01 )
+         AND (tpd_enable_q = VitalZeroDelay01Z)) THEN
+      LOOP
+        q <= VitalBUFIF1( Data, Enable, ResultMap );
+        WAIT ON Data, Enable;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( d_Schd, InitialEdge(Data), tpd_data_q );
+        BufEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( d_Schd, GetEdge(Data), tpd_data_q );
+        BufEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := VitalBUFIF1( Data, Enable );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data),
+                        d_Schd, e1_Schd, e0_Schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalBUFIF0 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        VARIABLE NewValue        : UX01Z;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType;
+        VARIABLE ne1_schd, ne0_schd : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+  BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_data_q   = VitalZeroDelay01 )
+         AND (tpd_enable_q = VitalZeroDelay01Z)) THEN
+      LOOP
+        q <= VitalBUFIF0( Data, Enable, ResultMap );
+        WAIT ON Data, Enable;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( d_Schd, InitialEdge(Data), tpd_data_q );
+        InvEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( d_Schd, GetEdge(Data), tpd_data_q );
+        InvEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := VitalBUFIF0( Data, Enable );
+        ne1_schd := NOT e1_Schd;
+        ne0_schd := NOT e0_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data),
+                        d_Schd, ne1_schd, ne0_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+    END IF;
+    END;
+
+    PROCEDURE VitalIDENT (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT  ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        SUBTYPE v2 IS std_logic_vector(0 TO 1);
+        VARIABLE NewValue      : UX01Z;
+        VARIABLE Glitch_Data  : GlitchDataType;
+        VARIABLE Dly, Glch    : TIME;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (tpd_a_q = VitalZeroDelay01Z) THEN
+      LOOP
+        q <= ResultMap(To_UX01Z(a));
+        WAIT ON a;
+      END LOOP;
+
+    ELSE
+      LOOP
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        CASE v2'(To_X01Z(NewValue) & To_X01Z(a)) IS
+          WHEN "00"   => Dly := tpd_a_q(tr10);
+          WHEN "01"   => Dly := tpd_a_q(tr01);
+          WHEN "0Z"   => Dly := tpd_a_q(tr0z);
+          WHEN "0X"   => Dly := tpd_a_q(tr01);
+          WHEN "10"   => Dly := tpd_a_q(tr10);
+          WHEN "11"   => Dly := tpd_a_q(tr01);
+          WHEN "1Z"   => Dly := tpd_a_q(tr1z);
+          WHEN "1X"   => Dly := tpd_a_q(tr10);
+          WHEN "Z0"   => Dly := tpd_a_q(trz0);
+          WHEN "Z1"   => Dly := tpd_a_q(trz1);
+          WHEN "ZZ"   => Dly := 0 ns;
+          WHEN "ZX"   => Dly := Minimum (tpd_a_q(trz1), tpd_a_q(trz0));
+          WHEN "X0"   => Dly := tpd_a_q(tr10);
+          WHEN "X1"   => Dly := tpd_a_q(tr01);
+          WHEN "XZ"   => Dly := Minimum (tpd_a_q(tr0z), tpd_a_q(tr1z));
+          WHEN OTHERS => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10));
+        END CASE;
+        NewValue  := To_UX01Z(a);
+
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode );
+
+        WAIT ON a;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Invertors
+    --   INV    ......... standard inverting buffer
+    --   INVIF0 ......... inverting buffer Data passes thru if (Enable = '0')
+    --   INVIF1 ......... inverting buffer Data passes thru if (Enable = '1')
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalINV   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL            a :  IN std_ulogic   ;
+            CONSTANT    tpd_a_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE NewValue      : UX01;
+        VARIABLE Glitch_Data  : GlitchDataType;
+        VARIABLE new_schd     : SchedType;
+        VARIABLE Dly, Glch    : TIME;
+    BEGIN
+    IF (tpd_a_q = VitalZeroDelay01) THEN
+      LOOP
+        q <= ResultMap(NOT a);
+        WAIT ON a;
+      END LOOP;
+
+    ELSE
+      LOOP
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue  := NOT a;
+        CASE EdgeType'(GetEdge(a)) IS
+          WHEN '1'|'/'|'R'|'r' => Dly := tpd_a_q(tr10);
+          WHEN '0'|'\'|'F'|'f' => Dly := tpd_a_q(tr01);
+          WHEN OTHERS          => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10));
+        END CASE;
+
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode );
+
+        WAIT ON a;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalINVIF1 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        VARIABLE NewValue        : UX01Z;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+  BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_data_q   = VitalZeroDelay01 )
+         AND (tpd_enable_q = VitalZeroDelay01Z)) THEN
+      LOOP
+        q <= VitalINVIF1( Data, Enable, ResultMap );
+        WAIT ON Data, Enable;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( d_Schd, InitialEdge(Data), tpd_data_q );
+        BufEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( d_Schd, GetEdge(Data), tpd_data_q );
+        BufEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := VitalINVIF1( Data, Enable );
+        new_schd := NOT d_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data),
+                        new_schd, e1_Schd, e0_Schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalINVIF0 (
+            SIGNAL              q : OUT std_ulogic;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01Z   := VitalDefDelay01Z;
+            CONSTANT    ResultMap :  IN VitalResultZMapType
+                                        := VitalDefaultResultZMap
+    ) IS
+        VARIABLE NewValue        : UX01Z;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType;
+        VARIABLE ne1_schd, ne0_schd : SchedType := DefSchedType;
+        VARIABLE Dly, Glch      : TIME;
+  BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_data_q   = VitalZeroDelay01 )
+         AND (tpd_enable_q = VitalZeroDelay01Z)) THEN
+      LOOP
+        q <= VitalINVIF0( Data, Enable, ResultMap );
+        WAIT ON Data, Enable;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        InvPath ( d_Schd, InitialEdge(Data), tpd_data_q );
+        InvEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        InvPath ( d_Schd, GetEdge(Data), tpd_data_q );
+        InvEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delay
+        -- ------------------------------------
+        NewValue := VitalINVIF0( Data, Enable );
+        ne1_schd := NOT e1_Schd;
+        ne0_schd := NOT e0_Schd;
+        new_schd := NOT d_Schd;
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data),
+                        new_schd, ne1_schd, ne0_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+    END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Multiplexor
+    --   MUX   .......... result := data(dselect)
+    --   MUX2  .......... 2-input mux; result := data0 when (dselect = '0'),
+    --                                           data1 when (dselect = '1'),
+    --                        'X' when (dselect = 'X') and (data0 /= data1)
+    --   MUX4  .......... 4-input mux; result := data(dselect)
+    --   MUX8  .......... 8-input mux; result := data(dselect)
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalMUX2  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL       d1, d0 :  IN std_ulogic;
+            SIGNAL         dSel :  IN std_ulogic;
+            CONSTANT   tpd_d1_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT   tpd_d0_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+        VARIABLE d1_Schd,  d0_Schd  : SchedType;
+        VARIABLE dSel_bSchd, dSel_iSchd : SchedType;
+        VARIABLE d1_Edge, d0_Edge, dSel_Edge : EdgeType;
+    BEGIN
+
+    -- ------------------------------------------------------------------------
+    --  For ALL zero delay paths, use simple model
+    --   ( No delay selection, glitch detection required )
+    -- ------------------------------------------------------------------------
+    IF (     (tpd_d1_q   = VitalZeroDelay01)
+         AND (tpd_d0_q   = VitalZeroDelay01)
+         AND (tpd_dsel_q = VitalZeroDelay01) ) THEN
+      LOOP
+        q <= VitalMUX2 ( d1, d0, dSel, ResultMap );
+        WAIT ON d1, d0, dSel;
+      END LOOP;
+
+    ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( d1_Schd, InitialEdge(d1), tpd_d1_q );
+        BufPath ( d0_Schd, InitialEdge(d0), tpd_d0_q );
+        BufPath ( dSel_bSchd, InitialEdge(dSel), tpd_dsel_q );
+        InvPath ( dSel_iSchd, InitialEdge(dSel), tpd_dsel_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( d1_Schd, GetEdge(d1), tpd_d1_q );
+        BufPath ( d0_Schd, GetEdge(d0), tpd_d0_q );
+        BufPath ( dSel_bSchd, GetEdge(dSel), tpd_dsel_q );
+        InvPath ( dSel_iSchd, GetEdge(dSel), tpd_dsel_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalMUX2 ( d1, d0, dSel );
+        new_schd := VitalMUX2 ( d1_Schd, d0_Schd, dSel_bSchd, dSel_iSchd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON d1, d0, dSel;
+      END LOOP;
+    END IF;
+    END;
+--
+    PROCEDURE VitalMUX4  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector4;
+            SIGNAL         dSel :  IN std_logic_vector2;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE LastdSel  : std_logic_vector(dSel'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+        VARIABLE Data_Schd      : SchedArray4;
+        VARIABLE Data_Edge      : EdgeArray4;
+        VARIABLE dSel_Edge      : EdgeArray2;
+        VARIABLE dSel_bSchd     : SchedArray2;
+        VARIABLE dSel_iSchd     : SchedArray2;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN dSel'RANGE LOOP
+          IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN
+          FOR i IN Data'RANGE LOOP
+              IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+                  AllZeroDelay := FALSE;
+                  EXIT;
+              END IF;
+          END LOOP;
+
+          IF (AllZeroDelay) THEN LOOP
+              q <= VitalMUX(Data, dSel, ResultMap);
+              WAIT ON Data, dSel;
+          END LOOP;
+          END IF;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        FOR n IN dSel'RANGE LOOP
+            BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+            InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        GetEdge ( dSel, LastdSel, dSel_Edge );
+        BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q );
+        InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalMUX4 ( Data, dSel );
+        new_schd := VitalMUX4 ( Data_Schd, dSel_bSchd, dSel_iSchd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, dSel;
+      END LOOP;
+      END IF; --SN
+    END;
+
+    PROCEDURE VitalMUX8  (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector8;
+            SIGNAL         dSel :  IN std_logic_vector3;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType  := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE LastdSel  : std_logic_vector(dSel'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+        VARIABLE Data_Schd      : SchedArray8;
+        VARIABLE Data_Edge      : EdgeArray8;
+        VARIABLE dSel_Edge      : EdgeArray3;
+        VARIABLE dSel_bSchd     : SchedArray3;
+        VARIABLE dSel_iSchd     : SchedArray3;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN dSel'RANGE LOOP
+          IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN
+          FOR i IN Data'RANGE LOOP
+              IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+                  AllZeroDelay := FALSE;
+                  EXIT;
+              END IF;
+          END LOOP;
+
+          IF (AllZeroDelay) THEN LOOP
+              q <= VitalMUX(Data, dSel, ResultMap);
+              WAIT ON Data, dSel;
+          END LOOP;
+          END IF;
+       ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        FOR n IN dSel'RANGE LOOP
+            BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+            InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        GetEdge ( dSel, LastdSel, dSel_Edge );
+        BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q );
+        InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalMUX8 ( Data, dSel );
+        new_schd := VitalMUX8 ( Data_Schd, dSel_bSchd, dSel_iSchd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, dSel;
+      END LOOP;
+      END IF;
+    END;
+--
+    PROCEDURE VitalMUX   (
+            SIGNAL            q : OUT std_ulogic;
+            SIGNAL         Data :  IN std_logic_vector;
+            SIGNAL         dSel :  IN std_logic_vector;
+            CONSTANT tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_dsel_q :  IN VitalDelayArrayType01;
+            CONSTANT  ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE LastdSel  : std_logic_vector(dSel'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : UX01;
+        VARIABLE Glitch_Data    : GlitchDataType;
+        VARIABLE new_schd       : SchedType;
+        VARIABLE Dly, Glch      : TIME;
+        VARIABLE Data_Schd      : SchedArray(Data'RANGE);
+        VARIABLE Data_Edge      : EdgeArray(Data'RANGE);
+        VARIABLE dSel_Edge      : EdgeArray(dSel'RANGE);
+        VARIABLE dSel_bSchd     : SchedArray(dSel'RANGE);
+        VARIABLE dSel_iSchd     : SchedArray(dSel'RANGE);
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      FOR i IN dSel'RANGE LOOP
+          IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+      END LOOP;
+      IF (AllZeroDelay) THEN
+          FOR i IN Data'RANGE LOOP
+              IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+                  AllZeroDelay := FALSE;
+                  EXIT;
+              END IF;
+          END LOOP;
+
+          IF (AllZeroDelay) THEN LOOP
+              q <= VitalMUX(Data, dSel, ResultMap);
+              WAIT ON Data, dSel;
+          END LOOP;
+          END IF;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        FOR n IN dSel'RANGE LOOP
+            BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+            InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) );
+        END LOOP;
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_Schd, Data_Edge, Atpd_data_q );
+
+        GetEdge ( dSel, LastdSel, dSel_Edge );
+        BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q );
+        InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalMUX ( Data, dSel );
+        new_schd := VitalMUX ( Data_Schd, dSel_bSchd, dSel_iSchd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, dSel;
+      END LOOP;
+     END IF; --SN
+    END;
+
+    -- ------------------------------------------------------------------------
+    -- Decoder
+    --          General Algorithm :
+    --              (a) Result(...) := '0' when (enable = '0')
+    --              (b) Result(data) := '1'; all other subelements = '0'
+    --              ... Result array is decending (n-1 downto 0)
+    --
+    --          DECODERn  .......... n:2**n decoder
+    -- Caution: If 'ResultMap' defines other than strength mapping, the
+    --          delay selection is not defined.
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalDECODER2  (
+            SIGNAL              q : OUT std_logic_vector2;
+            SIGNAL           Data :  IN std_ulogic;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE NewValue        : std_logic_vector2;
+        VARIABLE Glitch_Data    : GlitchArray2;
+        VARIABLE new_schd       : SchedArray2;
+        VARIABLE Dly, Glch      : TimeArray2;
+        VARIABLE Enable_Schd  : SchedType := DefSchedType;
+        VARIABLE Data_BSchd, Data_ISchd : SchedType;
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      IF (tpd_enable_q = VitalZeroDelay01) AND (tpd_data_q = VitalZeroDelay01) THEN
+      LOOP
+          q <= VitalDECODER2(Data, Enable, ResultMap);
+          WAIT ON Data, Enable;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        BufPath ( Data_BSchd, InitialEdge(Data), tpd_data_q );
+        InvPath ( Data_ISchd, InitialEdge(Data), tpd_data_q );
+        BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        BufPath ( Data_BSchd, GetEdge(Data), tpd_data_q );
+        InvPath ( Data_ISchd, GetEdge(Data), tpd_data_q );
+
+        BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalDECODER2 ( Data, Enable, ResultMap );
+        new_schd := VitalDECODER2 ( Data_BSchd, Data_ISchd, Enable_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+      END IF; -- SN
+    END;
+--
+    PROCEDURE VitalDECODER4  (
+            SIGNAL              q : OUT std_logic_vector4;
+            SIGNAL           Data :  IN std_logic_vector2;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType       := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : std_logic_vector4;
+        VARIABLE Glitch_Data    : GlitchArray4;
+        VARIABLE new_schd       : SchedArray4;
+        VARIABLE Dly, Glch      : TimeArray4;
+        VARIABLE Enable_Schd    : SchedType;
+        VARIABLE Enable_Edge    : EdgeType;
+        VARIABLE Data_Edge      : EdgeArray2;
+        VARIABLE Data_BSchd, Data_ISchd : SchedArray2;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      IF (tpd_enable_q /= VitalZeroDelay01) THEN
+          AllZeroDelay := FALSE;
+      ELSE
+          FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+          END LOOP;
+      END IF;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalDECODER4(Data, Enable, ResultMap);
+          WAIT ON Data, Enable;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_BSchd, Data_Edge, Atpd_data_q );
+        InvPath ( Data_ISchd, Data_Edge, Atpd_data_q );
+
+        BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalDECODER4 ( Data, Enable, ResultMap );
+        new_schd := VitalDECODER4 ( Data_BSchd, Data_ISchd, Enable_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+      END IF;
+    END;
+--
+    PROCEDURE VitalDECODER8  (
+            SIGNAL              q : OUT std_logic_vector8;
+            SIGNAL           Data :  IN std_logic_vector3;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : std_logic_vector8;
+        VARIABLE Glitch_Data    : GlitchArray8;
+        VARIABLE new_schd       : SchedArray8;
+        VARIABLE Dly, Glch      : TimeArray8;
+        VARIABLE Enable_Schd    : SchedType;
+        VARIABLE Enable_Edge    : EdgeType;
+        VARIABLE Data_Edge      : EdgeArray3;
+        VARIABLE Data_BSchd, Data_ISchd : SchedArray3;
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE; --SN
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      IF (tpd_enable_q /= VitalZeroDelay01) THEN
+          AllZeroDelay := FALSE;
+      ELSE
+          FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+          END LOOP;
+      END IF;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalDECODER(Data, Enable, ResultMap);
+          WAIT ON Data, Enable;
+      END LOOP;
+      ELSE
+
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_BSchd, Data_Edge, Atpd_data_q );
+        InvPath ( Data_ISchd, Data_Edge, Atpd_data_q );
+
+        BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalDECODER8 ( Data, Enable, ResultMap );
+        new_schd := VitalDECODER8 ( Data_BSchd, Data_ISchd, Enable_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+      END IF; --SN
+    END;
+--
+    PROCEDURE VitalDECODER   (
+            SIGNAL              q : OUT std_logic_vector;
+            SIGNAL           Data :  IN std_logic_vector;
+            SIGNAL         Enable :  IN std_ulogic;
+            CONSTANT   tpd_data_q :  IN VitalDelayArrayType01;
+            CONSTANT tpd_enable_q :  IN VitalDelayType01    := VitalDefDelay01;
+            CONSTANT    ResultMap :  IN VitalResultMapType
+                                        := VitalDefaultResultMap
+    ) IS
+        VARIABLE LastData  : std_logic_vector(Data'RANGE) := (OTHERS=>'U');
+        VARIABLE NewValue        : std_logic_vector(q'RANGE);
+        VARIABLE Glitch_Data    : GlitchDataArrayType(q'RANGE);
+        VARIABLE new_schd       : SchedArray(q'RANGE);
+        VARIABLE Dly, Glch      : VitalTimeArray(q'RANGE);
+        VARIABLE Enable_Schd    : SchedType;
+        VARIABLE Enable_Edge    : EdgeType;
+        VARIABLE Data_Edge      : EdgeArray(Data'RANGE);
+        VARIABLE Data_BSchd, Data_ISchd : SchedArray(Data'RANGE);
+        ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q;
+        VARIABLE AllZeroDelay  : BOOLEAN := TRUE;
+    BEGIN
+      -- ------------------------------------------------------------------------
+      --  Check if ALL zero delay paths, use simple model
+      --   ( No delay selection, glitch detection required )
+      -- ------------------------------------------------------------------------
+      IF (tpd_enable_q /= VitalZeroDelay01) THEN
+          AllZeroDelay := FALSE;
+      ELSE
+          FOR i IN Data'RANGE LOOP
+          IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN
+              AllZeroDelay := FALSE;
+              EXIT;
+          END IF;
+          END LOOP;
+      END IF;
+      IF (AllZeroDelay) THEN LOOP
+          q <= VitalDECODER(Data, Enable, ResultMap);
+          WAIT ON Data, Enable;
+      END LOOP;
+      ELSE
+        -- --------------------------------------
+        -- Initialize delay schedules
+        -- --------------------------------------
+        FOR n IN Data'RANGE LOOP
+            BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+            InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) );
+        END LOOP;
+        BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q );
+
+      LOOP
+        -- --------------------------------------
+        -- Process input signals
+        --   get edge values
+        --   re-evaluate output schedules
+        -- --------------------------------------
+        GetEdge ( Data, LastData, Data_Edge );
+        BufPath ( Data_BSchd, Data_Edge, Atpd_data_q );
+        InvPath ( Data_ISchd, Data_Edge, Atpd_data_q );
+
+        BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q );
+
+        -- ------------------------------------
+        -- Compute function and propation delaq
+        -- ------------------------------------
+        NewValue  := VitalDECODER ( Data, Enable, ResultMap );
+        new_schd := VitalDECODER ( Data_BSchd, Data_ISchd, Enable_Schd );
+
+        -- ------------------------------------------------------
+        -- Assign Outputs
+        --  get delays to new value and possable glitch
+        --  schedule output change with On Event glitch detection
+        -- ------------------------------------------------------
+        GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd );
+        VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly,
+                             PrimGlitchMode, GlitchDelay=>Glch );
+
+        WAIT ON Data, Enable;
+      END LOOP;
+      END IF;
+    END;
+
+    -- ------------------------------------------------------------------------
+    FUNCTION VitalTruthTable  (
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+          ) RETURN std_logic_vector IS
+
+        CONSTANT InputSize   : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize     : INTEGER := TruthTable'LENGTH(2) - InputSize;
+        VARIABLE ReturnValue : std_logic_vector(OutSize - 1 DOWNTO 0)
+                               := (OTHERS => 'X');
+        VARIABLE DataInAlias : std_logic_vector(0 TO InputSize - 1)
+                               :=  To_X01(DataIn);
+        VARIABLE Index       : INTEGER;
+        VARIABLE Err         : BOOLEAN := FALSE;
+
+        -- This needs to be done since the TableLookup arrays must be
+        -- ascending starting with 0
+        VARIABLE TableAlias  : VitalTruthTableType(0 TO (TruthTable'LENGTH(1)-1),
+                                                   0 TO (TruthTable'LENGTH(2)-1))
+                                := TruthTable;
+
+    BEGIN
+        -- search through each row of the truth table
+        IF OutSize > 0 THEN
+          ColLoop:
+            FOR i IN TableAlias'RANGE(1) LOOP
+
+            RowLoop: -- Check each input element of the entry
+              FOR j IN 0 TO InputSize LOOP
+
+                IF (j = InputSize) THEN -- This entry matches
+                    -- Return the Result
+                    Index := 0;
+                    FOR k IN TruthTable'LENGTH(2) - 1 DOWNTO InputSize LOOP
+                        TruthOutputX01Z ( TableAlias(i,k),
+                                          ReturnValue(Index), Err);
+                        EXIT WHEN Err;
+                        Index := Index + 1;
+                    END LOOP;
+
+                    IF Err THEN
+                        ReturnValue := (OTHERS => 'X');
+                    END IF;
+                    RETURN ReturnValue;
+                END IF;
+                IF NOT ValidTruthTableInput(TableAlias(i,j)) THEN
+                    VitalError ( "VitalTruthTable", ErrInpSym,
+                                 To_TruthChar(TableAlias(i,j)) );
+                    EXIT ColLoop;
+                END IF;
+                EXIT RowLoop WHEN NOT ( TruthTableMatch( DataInAlias(j),
+                                                         TableAlias(i, j)));
+              END LOOP RowLoop;
+            END LOOP ColLoop;
+
+        ELSE
+            VitalError ( "VitalTruthTable", ErrTabWidSml );
+        END IF;
+        RETURN ReturnValue;
+    END VitalTruthTable;
+
+    FUNCTION VitalTruthTable  (
+            CONSTANT TruthTable   : IN VitalTruthTableType;
+            CONSTANT DataIn       : IN std_logic_vector
+          ) RETURN std_logic IS
+
+        CONSTANT InputSize  : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize    : INTEGER := TruthTable'LENGTH(2) - InputSize;
+        VARIABLE TempResult : std_logic_vector(OutSize - 1 DOWNTO 0)
+                              := (OTHERS => 'X');
+    BEGIN
+        IF (OutSize > 0) THEN
+            TempResult := VitalTruthTable(TruthTable, DataIn);
+            IF ( 1 > OutSize) THEN
+                VitalError ( "VitalTruthTable", ErrTabResSml );
+            ELSIF ( 1 < OutSize) THEN
+                VitalError ( "VitalTruthTable", ErrTabResLrg );
+            END IF;
+            RETURN (TempResult(0));
+        ELSE
+            VitalError ( "VitalTruthTable", ErrTabWidSml );
+            RETURN 'X';
+        END IF;
+    END VitalTruthTable;
+
+    PROCEDURE VitalTruthTable (
+            SIGNAL   Result     : OUT std_logic_vector;
+            CONSTANT TruthTable : IN  VitalTruthTableType;
+            CONSTANT DataIn     : IN  std_logic_vector
+    ) IS
+        CONSTANT ResLeng     : INTEGER := Result'LENGTH;
+        CONSTANT ActResLen   : INTEGER := TruthTable'LENGTH(2) - DataIn'LENGTH;
+        CONSTANT FinalResLen : INTEGER := Minimum(ActResLen, ResLeng);
+        VARIABLE TempResult  : std_logic_vector(ActResLen - 1 DOWNTO 0)
+                                := (OTHERS => 'X');
+
+    BEGIN
+        TempResult := VitalTruthTable(TruthTable, DataIn);
+
+        IF (ResLeng > ActResLen) THEN
+            VitalError ( "VitalTruthTable", ErrTabResSml );
+        ELSIF (ResLeng < ActResLen) THEN
+            VitalError ( "VitalTruthTable", ErrTabResLrg );
+        END IF;
+        TempResult(FinalResLen-1 DOWNTO 0) := TempResult(FinalResLen-1 DOWNTO 0);
+        Result <= TempResult;
+
+    END VitalTruthTable;
+
+    PROCEDURE VitalTruthTable (
+            SIGNAL   Result     : OUT std_logic;
+            CONSTANT TruthTable : IN VitalTruthTableType;
+            CONSTANT DataIn     : IN std_logic_vector
+    ) IS
+
+        CONSTANT ActResLen  : INTEGER := TruthTable'LENGTH(2) - DataIn'LENGTH;
+        VARIABLE TempResult : std_logic_vector(ActResLen - 1 DOWNTO 0)
+                              := (OTHERS => 'X');
+
+    BEGIN
+        TempResult := VitalTruthTable(TruthTable, DataIn);
+
+        IF ( 1 > ActResLen) THEN
+            VitalError ( "VitalTruthTable", ErrTabResSml );
+        ELSIF ( 1 < ActResLen) THEN
+            VitalError ( "VitalTruthTable", ErrTabResLrg );
+        END IF;
+        IF (ActResLen >  0) THEN
+            Result <= TempResult(0);
+        END IF;
+
+    END VitalTruthTable;
+
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalStateTable (
+            VARIABLE Result         : INOUT std_logic_vector;
+            VARIABLE PreviousDataIn : INOUT std_logic_vector;
+            CONSTANT StateTable     : IN VitalStateTableType;
+            CONSTANT DataIn         : IN std_logic_vector;
+            CONSTANT NumStates      : IN NATURAL
+    ) IS
+
+        CONSTANT InputSize     : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize       : INTEGER
+                                 := StateTable'LENGTH(2) - InputSize - NumStates;
+        CONSTANT ResLeng       : INTEGER := Result'LENGTH;
+        VARIABLE DataInAlias   : std_logic_vector(0 TO DataIn'LENGTH-1)
+                                 := To_X01(DataIn);
+        VARIABLE PrevDataAlias : std_logic_vector(0 TO PreviousDataIn'LENGTH-1)
+                                 := To_X01(PreviousDataIn);
+        VARIABLE ResultAlias   : std_logic_vector(0 TO ResLeng-1)
+                                 := To_X01(Result);
+        VARIABLE ExpResult     : std_logic_vector(0 TO OutSize-1);
+
+    BEGIN
+        IF (PreviousDataIn'LENGTH < DataIn'LENGTH) THEN
+            VitalError ( "VitalStateTable", ErrVctLng, "PreviousDataIn<DataIn");
+
+            ResultAlias := (OTHERS => 'X');
+            Result := ResultAlias;
+
+        ELSIF (OutSize <= 0) THEN
+            VitalError ( "VitalStateTable", ErrTabWidSml );
+
+            ResultAlias := (OTHERS => 'X');
+            Result := ResultAlias;
+
+        ELSE
+            IF (ResLeng > OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResSml );
+            ELSIF (ResLeng < OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResLrg );
+            END IF;
+
+            ExpResult := StateTableLookUp ( StateTable, DataInAlias,
+                                            PrevDataAlias, NumStates,
+                                            ResultAlias);
+            ResultAlias := (OTHERS => 'X');
+            ResultAlias ( Maximum(0, ResLeng - OutSize) TO ResLeng - 1)
+                   := ExpResult(Maximum(0, OutSize - ResLeng) TO OutSize-1);
+
+            Result := ResultAlias;
+            PrevDataAlias(0 TO InputSize - 1) := DataInAlias;
+            PreviousDataIn := PrevDataAlias;
+
+        END IF;
+    END VitalStateTable;
+
+
+    PROCEDURE VitalStateTable (
+            VARIABLE Result         : INOUT std_logic;        -- states
+            VARIABLE PreviousDataIn : INOUT std_logic_vector; -- previous inputs and states
+            CONSTANT StateTable     : IN VitalStateTableType; -- User's StateTable data
+            CONSTANT DataIn         : IN std_logic_vector     -- Inputs
+    ) IS
+
+        VARIABLE ResultAlias : std_logic_vector(0 TO 0);
+    BEGIN
+        ResultAlias(0) := Result;
+        VitalStateTable ( StateTable     => StateTable,
+                          DataIn         => DataIn,
+                          NumStates      => 1,
+                          Result         => ResultAlias,
+                          PreviousDataIn => PreviousDataIn
+                        );
+        Result := ResultAlias(0);
+
+    END VitalStateTable;
+
+    PROCEDURE VitalStateTable (
+            SIGNAL   Result     : INOUT std_logic_vector;
+            CONSTANT StateTable : IN VitalStateTableType;
+            SIGNAL   DataIn     : IN std_logic_vector;
+            CONSTANT NumStates  : IN NATURAL
+    ) IS
+
+        CONSTANT InputSize   : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize     : INTEGER
+                               := StateTable'LENGTH(2) - InputSize - NumStates;
+        CONSTANT ResLeng     : INTEGER := Result'LENGTH;
+
+        VARIABLE PrevData    : std_logic_vector(0 TO DataIn'LENGTH-1)
+                               := (OTHERS => 'X');
+        VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1);
+        VARIABLE ResultAlias : std_logic_vector(0 TO ResLeng-1);
+        VARIABLE ExpResult   : std_logic_vector(0 TO OutSize-1);
+
+    BEGIN
+        IF (OutSize <= 0) THEN
+            VitalError ( "VitalStateTable", ErrTabWidSml );
+
+            ResultAlias  := (OTHERS => 'X');
+            Result <= ResultAlias;
+
+        ELSE
+            IF (ResLeng > OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResSml );
+            ELSIF (ResLeng < OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResLrg );
+            END IF;
+
+            LOOP
+                DataInAlias := To_X01(DataIn);
+                ResultAlias := To_X01(Result);
+                ExpResult   := StateTableLookUp ( StateTable, DataInAlias,
+                                                  PrevData, NumStates,
+                                                  ResultAlias);
+                ResultAlias := (OTHERS => 'X');
+                ResultAlias(Maximum(0, ResLeng - OutSize) TO ResLeng-1)
+                       := ExpResult(Maximum(0, OutSize - ResLeng) TO OutSize-1);
+
+                Result   <= ResultAlias;
+                PrevData := DataInAlias;
+
+                WAIT ON DataIn;
+            END LOOP;
+
+        END IF;
+
+    END VitalStateTable;
+
+    PROCEDURE VitalStateTable (
+            SIGNAL   Result     : INOUT std_logic;
+            CONSTANT StateTable : IN VitalStateTableType;
+            SIGNAL   DataIn     : IN std_logic_vector
+    ) IS
+
+        CONSTANT InputSize   : INTEGER := DataIn'LENGTH;
+        CONSTANT OutSize     : INTEGER := StateTable'LENGTH(2) - InputSize-1;
+
+        VARIABLE PrevData    : std_logic_vector(0 TO DataIn'LENGTH-1)
+                               := (OTHERS => 'X');
+        VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1);
+        VARIABLE ResultAlias : std_logic_vector(0 TO 0);
+        VARIABLE ExpResult   : std_logic_vector(0 TO OutSize-1);
+
+    BEGIN
+        IF (OutSize <= 0) THEN
+            VitalError ( "VitalStateTable", ErrTabWidSml );
+
+            Result <= 'X';
+
+        ELSE
+            IF ( 1 > OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResSml );
+            ELSIF ( 1 < OutSize) THEN
+                VitalError ( "VitalStateTable", ErrTabResLrg );
+            END IF;
+
+            LOOP
+                ResultAlias(0) := To_X01(Result);
+                DataInAlias := To_X01(DataIn);
+                ExpResult   := StateTableLookUp ( StateTable, DataInAlias,
+                                                  PrevData, 1, ResultAlias);
+
+                Result   <= ExpResult(OutSize-1);
+                PrevData := DataInAlias;
+
+                WAIT ON DataIn;
+            END LOOP;
+        END IF;
+
+    END VitalStateTable;
+
+    -- ------------------------------------------------------------------------
+    -- std_logic resolution primitive
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalResolve (
+            SIGNAL              q : OUT std_ulogic;
+            CONSTANT         Data :  IN std_logic_vector
+    ) IS
+        VARIABLE uData : std_ulogic_vector(Data'RANGE);
+    BEGIN
+        FOR i IN Data'RANGE LOOP
+            uData(i) := Data(i);
+        END LOOP;
+        q <= resolved(uData);
+    END;
+
+END VITAL_Primitives;
diff --git a/libraries/vital95/vital_timing.vhdl b/libraries/vital95/vital_timing.vhdl
new file mode 100644
index 000000000..1fe5a9e24
--- /dev/null
+++ b/libraries/vital95/vital_timing.vhdl
@@ -0,0 +1,880 @@
+-------------------------------------------------------------------------------
+-- Title        : Standard VITAL TIMING Package
+--              : $Revision: 597 $
+--              :
+-- Library      : This package shall be compiled into a library
+--              : symbolically named IEEE.
+--              :
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              :
+-- Purpose      : This packages defines standard types, attributes, constants,
+--              : functions and procedures for use in developing ASIC models.
+--              :
+-- Known Errors : 
+--              :
+-- Note         : No declarations or definitions shall be included in,
+--              : or excluded from this package. The "package declaration"
+--              : defines the objects (types, subtypes, constants, functions,
+--              : procedures ... etc.) that can be used by a user.  The package
+--              : body shall be considered the formal definition of the
+--              : semantics of this package.  Tool developers may choose to
+--              : implement the package body in the most efficient manner
+--              : available to them.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Acknowledgments:
+--   This code was originally developed under the "VHDL Initiative Toward ASIC
+--   Libraries" (VITAL), an industry sponsored initiative.  Technical
+--   Director: William Billowitch, VHDL Technology Group; U.S. Coordinator:
+--   Steve Schultz;  Steering Committee Members: Victor Berman, Cadence Design
+--   Systems; Oz Levia, Synopsys Inc.; Ray Ryan, Ryan & Ryan; Herman van Beek,
+--   Texas Instruments; Victor Martin, Hewlett-Packard Company.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History :
+-- ----------------------------------------------------------------------------
+-- Version No:|Auth:| Mod.Date:| Changes Made:
+--   v95.0 A  |     | 06/02/95 | Initial ballot draft 1995
+--   v95.1    |     | 08/31/95 | #203 - Timing violations at time 0
+--                               #204 - Output mapping prior to glitch detection 
+-- ---------------------------------------------------------------------------- 
+LIBRARY IEEE;
+USE     IEEE.Std_Logic_1164.ALL;
+
+PACKAGE VITAL_Timing IS
+    TYPE VitalTransitionType IS ( tr01, tr10, tr0z, trz1, tr1z, trz0,
+                                  tr0X, trx1, tr1x, trx0, trxz, trzx);
+
+    SUBTYPE VitalDelayType     IS TIME;
+    TYPE VitalDelayType01   IS ARRAY (VitalTransitionType   RANGE tr01 to tr10)
+         OF TIME;
+    TYPE VitalDelayType01Z  IS ARRAY (VitalTransitionType   RANGE tr01 to trz0)
+         OF TIME;
+    TYPE VitalDelayType01ZX IS ARRAY (VitalTransitionType   RANGE tr01 to trzx)
+         OF TIME;
+
+    TYPE VitalDelayArrayType     IS ARRAY (NATURAL RANGE <>) OF VitalDelayType;
+    TYPE VitalDelayArrayType01   IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01;
+    TYPE VitalDelayArrayType01Z  IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01Z;
+    TYPE VitalDelayArrayType01ZX IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01ZX;
+    -- ----------------------------------------------------------------------
+    -- **********************************************************************
+    -- ----------------------------------------------------------------------
+
+    CONSTANT VitalZeroDelay     : VitalDelayType     :=   0 ns;
+    CONSTANT VitalZeroDelay01   : VitalDelayType01   := ( 0 ns, 0 ns );
+    CONSTANT VitalZeroDelay01Z  : VitalDelayType01Z  := ( OTHERS => 0 ns );
+    CONSTANT VitalZeroDelay01ZX : VitalDelayType01ZX := ( OTHERS => 0 ns );
+
+    ---------------------------------------------------------------------------
+    -- examples of usage:
+    ---------------------------------------------------------------------------
+    -- tpd_CLK_Q : VitalDelayType  := 5 ns;
+    -- tpd_CLK_Q : VitalDelayType01  := (tr01 => 2 ns, tr10 => 3 ns);
+    -- tpd_CLK_Q : VitalDelayType01Z := ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns );
+    -- tpd_CLK_Q : VitalDelayArrayType(0 to 1)
+    --                          := (0 => 5 ns, 1 => 6 ns);
+    -- tpd_CLK_Q : VitalDelayArrayType01(0 to 1)
+    --                          := (0 => (tr01 => 2 ns, tr10 => 3 ns),
+    --                              1 => (tr01 => 2 ns, tr10 => 3 ns));
+    -- tpd_CLK_Q : VitalDelayArrayType01Z(0 to 1)
+    --                        := (0 => ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns ),
+    --                            1 => ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns ));
+    ---------------------------------------------------------------------------
+
+    -- TRUE if the model is LEVEL0 | LEVEL1 compliant
+    ATTRIBUTE VITAL_Level0 : BOOLEAN;
+    ATTRIBUTE VITAL_Level1 : BOOLEAN;
+
+    SUBTYPE std_logic_vector2 IS std_logic_vector(1 DOWNTO 0);
+    SUBTYPE std_logic_vector3 IS std_logic_vector(2 DOWNTO 0);
+    SUBTYPE std_logic_vector4 IS std_logic_vector(3 DOWNTO 0);
+    SUBTYPE std_logic_vector8 IS std_logic_vector(7 DOWNTO 0);
+
+    -- Types for strength mapping of outputs
+    TYPE VitalOutputMapType  IS ARRAY ( std_ulogic ) OF std_ulogic;
+    TYPE VitalResultMapType  IS ARRAY ( UX01       ) OF std_ulogic;
+    TYPE VitalResultZMapType IS ARRAY ( UX01Z      ) OF std_ulogic;
+    CONSTANT VitalDefaultOutputMap  : VitalOutputMapType
+                                    := "UX01ZWLH-";
+    CONSTANT VitalDefaultResultMap  : VitalResultMapType
+                                    := ( 'U', 'X', '0', '1' );
+    CONSTANT VitalDefaultResultZMap : VitalResultZMapType
+                                    := ( 'U', 'X', '0', '1', 'Z' );
+
+    -- Types for fields of VitalTimingDataType
+    TYPE VitalTimeArrayT  IS ARRAY (INTEGER RANGE <>) OF TIME;
+    TYPE VitalTimeArrayPT IS ACCESS VitalTimeArrayT;
+    TYPE VitalBoolArrayT  IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+    TYPE VitalBoolArrayPT IS ACCESS VitalBoolArrayT;
+    TYPE VitalLogicArrayPT IS ACCESS std_logic_vector;
+
+    TYPE VitalTimingDataType IS RECORD
+        NotFirstFlag : BOOLEAN;
+        RefLast   : X01;
+        RefTime   : TIME;
+        HoldEn    : BOOLEAN;
+        TestLast  : std_ulogic;
+        TestTime  : TIME;
+        SetupEn   : BOOLEAN;
+        TestLastA : VitalLogicArrayPT;
+        TestTimeA : VitalTimeArrayPT;
+        HoldEnA   : VitalBoolArrayPT;
+        SetupEnA  : VitalBoolArrayPT;
+    END RECORD;
+
+    FUNCTION VitalTimingDataInit RETURN VitalTimingDataType;
+
+    -- type for internal data of VitalPeriodPulseCheck
+    TYPE VitalPeriodDataType IS RECORD
+        Last : X01;
+        Rise : TIME;
+        Fall : TIME;
+        NotFirstFlag : BOOLEAN;
+    END RECORD;
+    CONSTANT VitalPeriodDataInit : VitalPeriodDataType 
+                                 := ('X', 0 ns, 0 ns, FALSE );
+
+    -- Type for specifying the kind of Glitch handling to use
+    TYPE VitalGlitchKindType IS (OnEvent,
+                                 OnDetect,
+                                 VitalInertial,
+                                 VitalTransport);
+
+    TYPE VitalGlitchDataType IS
+      RECORD
+        SchedTime    : TIME;
+        GlitchTime   : TIME;
+        SchedValue   : std_ulogic;
+        LastValue    : std_ulogic;
+      END RECORD;
+    TYPE VitalGlitchDataArrayType IS ARRAY (NATURAL RANGE <>)
+         OF VitalGlitchDataType;
+
+    -- PathTypes: for handling simple PathDelay info
+    TYPE VitalPathType IS RECORD
+        InputChangeTime : TIME;             -- timestamp for path input signal
+        PathDelay       : VitalDelayType;   -- delay for this path
+        PathCondition   : BOOLEAN;          -- path sensitize condition
+    END RECORD;
+    TYPE VitalPath01Type IS RECORD
+        InputChangeTime : TIME;             -- timestamp for path input signal
+        PathDelay       : VitalDelayType01; -- delay for this path
+        PathCondition   : BOOLEAN;          -- path sensitize condition
+    END RECORD;
+    TYPE VitalPath01ZType IS RECORD
+        InputChangeTime : TIME;             -- timestamp for path input signal
+        PathDelay       : VitalDelayType01Z;-- delay for this path
+        PathCondition   : BOOLEAN;          -- path sensitize condition
+    END RECORD;
+
+    -- For representing multiple paths to an output
+    TYPE VitalPathArrayType    IS ARRAY (NATURAL RANGE <> ) OF VitalPathType;
+    TYPE VitalPathArray01Type  IS ARRAY (NATURAL RANGE <> ) OF VitalPath01Type;
+    TYPE VitalPathArray01ZType IS ARRAY (NATURAL RANGE <> ) OF VitalPath01ZType;
+
+    TYPE VitalTableSymbolType IS (
+       '/',      -- 0 -> 1                                      
+       '\',      -- 1 -> 0                                      
+       'P',      -- Union of '/' and '^' (any edge to 1)                     
+       'N',      -- Union of '\' and 'v' (any edge to 0)                       
+       'r',      -- 0 -> X                                      
+       'f',      -- 1 -> X                                      
+       'p',      -- Union of '/' and 'r' (any edge from 0)               
+       'n',      -- Union of '\' and 'f' (any edge from 1)               
+       'R',      -- Union of '^' and 'p' (any possible rising edge)      
+       'F',      -- Union of 'v' and 'n' (any possible falling edge)     
+       '^',      -- X -> 1                                      
+       'v',      -- X -> 0                                      
+       'E',      -- Union of 'v' and '^' (any edge from X)               
+       'A',      -- Union of 'r' and '^' (rising edge to or from 'X')                           
+       'D',      -- Union of 'f' and 'v' (falling edge to or from 'X')                          
+       '*',      -- Union of 'R' and 'F' (any edge)                      
+       'X',      -- Unknown level                               
+       '0',      -- low level                                   
+       '1',      -- high level                                  
+       '-',      -- don't care                                  
+       'B',      -- 0 or 1                                      
+       'Z',      -- High Impedance                              
+       'S'       -- steady value                                
+    );
+
+    SUBTYPE VitalEdgeSymbolType IS VitalTableSymbolType RANGE '/' TO '*';
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalExtendToFillDelay
+    --
+    -- Description:     A six element array of delay values of type 
+    --                  VitalDelayType01Z is returned when a 1, 2 or 6
+    --                  element array is given.  This function will convert
+    --                  VitalDelayType and VitalDelayType01 delay values into
+    --                  a VitalDelayType01Z type following these rules:
+    --
+    --                  When a VitalDelayType is passed, all six transition
+    --                  values are assigned the input value.  When a 
+    --                  VitalDelayType01 is passed, the 01 transitions are
+    --                  assigned to the 01, 0Z and Z1 transitions and the 10
+    --                  transitions are assigned to 10, 1Z and Z0 transition
+    --                  values.  When a VitalDelayType01Z is passed, the values
+    --                  are kept as is.
+    --
+    --                  The function is overloaded based on input type.
+    --
+    --                  There is no function to fill a 12 value delay
+    --                  type.
+    --
+    -- Arguments:         
+    --
+    --  IN                 Type           Description
+    --                     Delay          A one, two or six delay value Vital-
+    --                                    DelayType is passed and a six delay,
+    --                                    VitalDelayType01Z, item is returned.        
+    --                    
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --   VitalDelayType01Z
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalExtendToFillDelay (
+            CONSTANT Delay : IN VitalDelayType
+          ) RETURN VitalDelayType01Z;
+    FUNCTION VitalExtendToFillDelay (
+            CONSTANT Delay : IN VitalDelayType01
+          ) RETURN VitalDelayType01Z;
+    FUNCTION VitalExtendToFillDelay (
+            CONSTANT Delay : IN VitalDelayType01Z
+          ) RETURN VitalDelayType01Z;
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalCalcDelay
+    --
+    -- Description:     This function accepts a 1, 2 or 6 value delay and 
+    --                  chooses the correct delay time to delay the NewVal 
+    --                  signal.  This function is overloaded based on the
+    --                  delay type passed. The function returns a single value
+    --                  of time.
+    --
+    --                  This function is provided for Level 0 models in order
+    --                  to calculate the delay which should be applied 
+    --                  for the passed signal. The delay selection is performed
+    --                  using the OldVal and the NewVal to determine the 
+    --                  transition to select.  The default value of OldVal is X.
+    --
+    --                  This function cannot be used in a Level 1 model since
+    --                  the VitalPathDelay routines perform the delay path
+    --                  selection and output driving function.
+    --
+    -- Arguments:         
+    --
+    --  IN                 Type           Description
+    --                      NewVal         New value of the signal to be
+    --                                     assigned   
+    --                      OldVal         Previous value of the signal.
+    --                                     Default value is 'X'
+    --                      Delay          The delay structure from which to
+    --                                     select the appropriate delay.  The
+    --                                     function overload is based on the
+    --                                     type of delay passed.  In the case of
+    --                                     the single delay, VitalDelayType, no
+    --                                     selection is performed, since there
+    --                                     is only one value to choose from.
+    --                                     For the other cases, the transition
+    --                                     from the old value to the new value
+    --                                     decide the value returned.  
+    --                    
+    --  INOUT
+    --   none 
+    --
+    --  OUT
+    --   none
+    --
+    --  Returns              
+    --   Time                              The time value selected from the
+    --                                     Delay INPUT is returned.
+    --
+    -- -------------------------------------------------------------------------
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType
+          ) RETURN TIME;
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType01
+          ) RETURN TIME;
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType01Z
+          ) RETURN TIME;
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalPathDelay
+    --
+    -- Description:     VitalPathDelay is the Level 1 routine used to select
+    --                  the propagation delay path and schedule a new output 
+    --                  value.
+    --
+    --                  For single and dual delay values, VitalDelayType and
+    --                  VitalDelayType01 are used.  The output value is
+    --                  scheduled with a calculated delay without strength
+    --                  modification.  
+    --
+    --                  For the six delay value, VitalDelayType01Z, the output       
+    --                  value is scheduled with a calculated delay.  The drive 
+    --                  strength can be modified to handle weak signal strengths
+    --                  to model tri-state devices, pull-ups and pull-downs as
+    --                  an example.
+    --
+    --                  The correspondence between the delay type and the
+    --                  path delay function is as follows:
+    --
+    --                  Delay Type                Path Type
+    --
+    --                  VitalDelayType            VitalPathDelay
+    --                  VitalDelayType01          VitalPathDelay01
+    --                  VitalDelayType01Z         VitalPathDelay01Z
+    --
+    --                  For each of these routines, the following capabilities
+    --                  is provided:
+    --     
+    --                  o Transition dependent path delay selection
+    --                  o User controlled glitch detection with the ability
+    --                    to generate "X" on output and report the violation
+    --                  o Control of the severity level for message generation
+    --                  o Scheduling of the computed values on the specified
+    --                    signal.
+    --                  
+    --                  Selection of the appropriate path delay begins with the
+    --                  candidate paths.  The candidate paths are selected by
+    --                  identifying the paths for which the PathCondition is 
+    --                  true.  If there is a single candidate path, then that
+    --                  delay is selected.  If there is more than one candidate
+    --                  path, then the shortest delay is selected using 
+    --                  transition dependent delay selection.  If there is no 
+    --                  candidate paths, then the delay specified by the 
+    --                  DefaultDelay parameter to the path delay is used.
+    --                  
+    --                  Once the delay is known, the output signal is then
+    --                  scheduled with that delay.  In the case of 
+    --                  VitalPathDelay01Z, an additional result mapping of
+    --                  the output value is performed before scheduling.  The
+    --                  result mapping is performed after transition dependent
+    --                  delay selection but before scheduling the final output.
+    --                      
+    --                  In order to perform glitch detection, the user is
+    --                  obligated to provide a variable of VitalGlitchDataType
+    --                  for the propagation delay functions to use.  The user
+    --                  cannot modify or use this information.
+    --
+    -- Arguments:         
+    --
+    --  IN             Type                   Description
+    --   OutSignalName  string                 The name of the output signal
+    --   OutTemp        std_logic              The new output value to be driven
+    --   Paths          VitalPathArrayType     A list of paths of VitalPathArray
+    --                  VitalPathArrayType01   type.  The VitalPathDelay routine
+    --                  VitalPathArrayType01Z  is overloaded based on the type
+    --                                         of constant passed in.  With
+    --                                         VitalPathArrayType01Z, the
+    --                                         resulting output strengths can be
+    --                                         mapped.
+    --   DefaultDelay   VitalDelayType         The default delay can be changed  
+    --                  VitalDelayType01       from zero-delay to another set of 
+    --                  VitalDelayType01Z      values.   
+    --   Mode           VitalGlitchKindType    The value of this constant
+    --                                         selects the type of glitch
+    --                                         detection.
+    --                       OnEvent           Glitch on transition event
+    --                     | OnDetect          Glitch immediate on detection
+    --                     | VitalInertial     No glitch, use INERTIAL
+    --                                         assignment
+    --                     | VitalTransport    No glitch, use TRANSPORT 
+    --                                         assignment
+    --   XOn            BOOLEAN                Control for generation of 'X' on 
+    --                                         glitch.  When TRUE, 'X's are
+    --                                         scheduled for glitches, otherwise
+    --                                         no are generated.             
+    --   MsgOn          BOOLEAN                Control for message generation on
+    --                                         glitch detect.  When TRUE,
+    --                                         glitches are reported, otherwise
+    --                                         they are not reported.      
+    --   MsgSeverity    SEVERITY_LEVEL         The level at which the message,
+    --                                         or assertion, will be reported. 
+    --   OutputMap      VitalOutputMapType     For VitalPathDelay01Z, the output
+    --                                         can be mapped to alternate
+    --                                         strengths to model tri-state 
+    --                                         devices, pull-ups and pull-downs.  
+    -- 
+    --  INOUT
+    --   GlitchData     VitalGlitchDataType    The internal data storage
+    --                                         variable required to detect
+    --                                         glitches.
+    --
+    --  OUT
+    --   OutSignal      std_logic              The output signal to be driven
+    --
+    --  Returns              
+    --   none 
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalPathDelay (
+        SIGNAL   OutSignal     : OUT   std_logic;
+        VARIABLE GlitchData    : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName : IN    string;
+        CONSTANT OutTemp       : IN    std_logic;
+        CONSTANT Paths         : IN    VitalPathArrayType;
+        CONSTANT DefaultDelay  : IN    VitalDelayType      := VitalZeroDelay;
+        CONSTANT Mode          : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn           : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn         : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity   : IN    SEVERITY_LEVEL      := WARNING
+    );
+    PROCEDURE VitalPathDelay01 (
+        SIGNAL   OutSignal     : OUT   std_logic;
+        VARIABLE GlitchData    : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName : IN    string;
+        CONSTANT OutTemp       : IN    std_logic;
+        CONSTANT Paths         : IN    VitalPathArray01Type;
+        CONSTANT DefaultDelay  : IN    VitalDelayType01    := VitalZeroDelay01;
+        CONSTANT Mode          : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn           : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn         : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity   : IN    SEVERITY_LEVEL      := WARNING
+    );
+    PROCEDURE VitalPathDelay01Z (
+        SIGNAL   OutSignal     : OUT   std_logic;
+        VARIABLE GlitchData    : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName : IN    string;
+        CONSTANT OutTemp       : IN    std_logic;
+        CONSTANT Paths         : IN    VitalPathArray01ZType;
+        CONSTANT DefaultDelay  : IN    VitalDelayType01Z   := VitalZeroDelay01Z;
+        CONSTANT Mode          : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn           : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn         : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity   : IN    SEVERITY_LEVEL      := WARNING;
+        CONSTANT OutputMap     : IN    VitalOutputMapType
+                                        := VitalDefaultOutputMap
+    );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalWireDelay
+    --
+    -- Description:     VitalWireDelay is used to delay an input signal.
+    --                  The delay is selected from the input parameter passed.
+    --                  The function is useful for back annotation of actual
+    --                  net delays.  
+    --                  
+    --                  The function is overloaded to permit passing a delay
+    --                  value for twire for VitalDelayType, VitalDelayType01
+    --                  and VitalDelayType01Z.  twire is a generic which can
+    --                  be back annotated and must be constructed to follow
+    --                  the SDF to generic mapping rules.       
+    --                  
+    -- Arguments:         
+    --
+    --  IN          Type                  Description         
+    --   InSig       std_ulogic            The input signal (port) to be
+    --                                     delayed.
+    --   twire       VitalDelayType        The delay value for which the input 
+    --               VitalDelayType01      signal should be delayed.  For Vital-
+    --               VitalDelayType01Z     DelayType, the value is single value 
+    --                                     passed.  For VitalDelayType01 and
+    --                                     VitalDelayType01Z, the appropriate
+    --                                     delay value is selected by VitalCalc-
+    --                                     Delay.
+    --
+    --  INOUT
+    --   none 
+    --
+    --  OUT
+    --   OutSig      std_ulogic            The internal delayed signal
+    --
+    --  Returns              
+    --   none 
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT twire      : IN    VitalDelayType
+        );
+
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT twire      : IN    VitalDelayType01
+        );
+
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT twire      : IN    VitalDelayType01Z
+        );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalSignalDelay
+    --
+    -- Description:     The VitalSignalDelay procedure is called in a signal
+    --                  delay block in the architecture to delay the 
+    --                  appropriate test or reference signal in order to 
+    --                  accommodate negative constraint checks.
+    --
+    --                  The amount of delay is of type TIME and is a constant.
+    --
+    -- Arguments:         
+    --
+    --  IN                Type            Description         
+    --   InSig             std_ulogic      The signal to be delayed.
+    --   dly               TIME            The amount of time the signal is
+    --                                     delayed.
+    --
+    --  INOUT
+    --   none
+    --
+    --  OUT
+    --   OutSig            std_ulogic      The delayed signal
+    --
+    --  Returns              
+    --   none
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalSignalDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT dly        : IN   TIME
+    );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:  VitalSetupHoldCheck
+    --
+    -- Description:    The VitalSetupHoldCheck procedure detects a setup or a 
+    --                 hold violation on the input test signal with respect
+    --                 to the corresponding input reference signal.  The timing 
+    --                 constraints are specified through parameters 
+    --                 representing the high and low values for the setup and
+    --                 hold values for the setup and hold times.  This 
+    --                 procedure assumes non-negative values for setup and hold 
+    --                 timing constraints. 
+    --
+    --                 It is assumed that negative timing constraints
+    --                 are handled by internally delaying the test or
+    --                 reference signals.  Negative setup times result in
+    --                 a delayed reference signal.  Negative hold times
+    --                 result in a delayed test signal.  Furthermore, the
+    --                 delays and constraints associated with these and
+    --                 other signals may need to be appropriately
+    --                 adjusted so that all constraint intervals overlap
+    --                 the delayed reference signals and all constraint
+    --                 values (with respect to the delayed signals) are
+    --                 non-negative.
+    --
+    --                 This function is overloaded based on the input
+    --                 TestSignal.  A vector and scalar form are provided.
+    --                  
+    -- TestSignal XXXXXXXXXXXX____________________________XXXXXXXXXXXXXXXXXXXXXX
+    --            :
+    --            :        -->|       error region       |<--
+    --            :
+    --            _______________________________
+    -- RefSignal                                 \______________________________
+    --            :           |                  |       |
+    --            :           |               -->|       |<-- thold
+    --            :        -->|     tsetup       |<--
+    --
+    -- Arguments:         
+    --
+    --  IN                 Type           Description    
+    --   TestSignal         std_ulogic     Value of test signal
+    --                      std_logic_vector
+    --   TestSignalName     STRING         Name of test signal
+    --   TestDelay          TIME           Model's internal delay associated
+    --                                     with TestSignal
+    --   RefSignal          std_ulogic     Value of reference signal
+    --   RefSignalName      STRING         Name of reference signal
+    --   RefDelay           TIME           Model's internal delay associated
+    --                                     with RefSignal
+    --   SetupHigh          TIME           Absolute minimum time duration before
+    --                                     the transition of RefSignal for which
+    --                                     transitions of TestSignal are allowed
+    --                                     to proceed to the "1" state without
+    --                                     causing a setup violation.      
+    --   SetupLow           TIME           Absolute minimum time duration before 
+    --                                     the transition of RefSignal for which
+    --                                     transitions of TestSignal are allowed
+    --                                     to proceed to the "0" state without
+    --                                     causing a setup violation.      
+    --   HoldHigh           TIME           Absolute minimum time duration after
+    --                                     the transition of RefSignal for which
+    --                                     transitions of TestSignal are allowed
+    --                                     to proceed to the "1" state without
+    --                                     causing a hold violation.      
+    --   HoldLow            TIME           Absolute minimum time duration after 
+    --                                     the transition of RefSignal for which
+    --                                     transitions of TestSignal are allowed
+    --                                     to proceed to the "0" state without
+    --                                     causing a hold violation.      
+    --   CheckEnabled       BOOLEAN        Check performed if TRUE.
+    --   RefTransition      VitalEdgeSymbolType
+    --                                     Reference edge specified. Events on
+    --                                     the RefSignal which match the edge
+    --                                     spec. are used as reference edges.      
+    --   HeaderMsg          STRING         String that will accompany any
+    --                                     assertion messages produced.      
+    --   XOn                BOOLEAN        If TRUE, Violation output parameter
+    --                                     is set to "X". Otherwise, Violation
+    --                                     is always set to "0."      
+    --   MsgOn              BOOLEAN        If TRUE, set and hold violation 
+    --                                     message will be generated.
+    --                                     Otherwise, no messages are generated,
+    --                                     even upon violations.      
+    --   MsgSeverity        SEVERITY_LEVEL Severity level for the assertion.      
+    --              
+    --  INOUT
+    --   TimingData         VitalTimingDataType  
+    --                                     VitalSetupHoldCheck information
+    --                                     storage area.  This is used
+    --                                     internally to detect reference edges
+    --                                     and record the time of the last edge.
+    --
+    --  OUT
+    --   Violation   X01                   This is the violation flag returned. 
+    --
+    --  Returns              
+    --   none    
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalSetupHoldCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_ulogic;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING
+    );
+
+    PROCEDURE VitalSetupHoldCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_logic_vector;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING
+    );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:   VitalRecoveryRemovalCheck
+    --
+    -- Description:     The VitalRecoveryRemovalCheck detects the presence of
+    --                  a recovery or removal violation on the input test 
+    --                  signal with respect to the corresponding input reference
+    --                  signal.  It assumes non-negative values of setup and
+    --                  hold timing constraints.  The timing constraint is 
+    --                  specified through parameters representing the recovery
+    --                  and removal times associated with a reference edge of 
+    --                  the reference signal.  A flag indicates whether a test
+    --                  signal is asserted when it is high or when it is low.
+    --                  
+    --                  It is assumed that negative timing constraints 
+    --                  are handled by internally delaying the test or 
+    --                  reference signals.  Negative recovery times result in 
+    --                  a delayed reference signal.  Negative removal times 
+    --                  result in a delayed test signal.  Furthermore, the 
+    --                  delays and constraints associated with these and
+    --                  other signals may need to be appropriately
+    --                  adjusted so that all constraint intervals overlap 
+    --                  the delayed reference signals and all constraint
+    --                  values (with respect to the delayed signals) are
+    --                  non-negative.
+    --                  
+    -- Arguments:         
+    --
+    --  IN               Type             Description
+    --   TestSignal       std_ulogic       Value of TestSignal.  The routine is
+    --   TestSignalName   STRING           Name of TestSignal 
+    --   TestDelay        TIME             Model internal delay associated with
+    --                                     the TestSignal
+    --   RefSignal        std_ulogic       Value of RefSignal
+    --   RefSignalName    STRING           Name of RefSignal
+    --   RefDelay         TIME             Model internal delay associated with
+    --                                     the RefSignal
+    --   Recovery         TIME             A change to an unasserted value on
+    --                                     the asynchronous TestSignal must
+    --                                     precede reference edge (on RefSignal)
+    --                                     by at least this time.
+    --   Removal          TIME             An asserted condition must be present
+    --                                     on the asynchronous TestSignal for at
+    --                                     least the removal time following a
+    --                                     reference edge on RefSignal.
+    --   ActiveLow        BOOLEAN          A flag which indicates if TestSignal
+    --                                     is asserted when it is low - "0."
+    --                                     FALSE indicate that TestSignal is
+    --                                     asserted when it has a value "1."
+    --   CheckEnabled     BOOLEAN          The check in enabled when the value
+    --                                     is TRUE, otherwise the constraints 
+    --                                     are not checked.
+    --   RefTransition    VitalEdgeSymbolType  
+    --                                     Reference edge specifier.  Events on
+    --                                     RefSignal will match the edge
+    --                                     specified.
+    --   HeaderMsg         STRING          A header message that will accompany
+    --                                     any assertion message.
+    --   XOn               BOOLEAN         When TRUE, the output Violation is
+    --                                     set to "X."  When FALSE, it is always 
+    --                                     "0."
+    --   MsgOn             BOOLEAN         When TRUE, violation messages are
+    --                                     output.  When FALSE, no messages are
+    --                                     generated.
+    --   MsgSeverity       SEVERITY_LEVEL  Severity level of the asserted
+    --                                     message.
+    --                             
+    --   INOUT
+    --    TimingData       VitalTimingDataType 
+    --                                     VitalRecoveryRemovalCheck information
+    --                                     storage area.  This is used
+    --                                     internally to detect reference edges
+    --                                     and record the time of the last edge.
+    --   OUT
+    --    Violation        X01             This is the violation flag returned.
+    --
+    --   Returns              
+    --           none
+    --
+    -- -------------------------------------------------------------------------
+    PROCEDURE VitalRecoveryRemovalCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_ulogic;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT Recovery      : IN     TIME := 0 ns;
+            CONSTANT Removal       : IN     TIME := 0 ns;
+            CONSTANT ActiveLow     : IN     BOOLEAN := TRUE;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING
+    );
+
+    -- ------------------------------------------------------------------------
+    --
+    -- Function Name:  VitalPeriodPulseCheck
+    --
+    -- Description:    VitalPeriodPulseCheck checks for minimum and maximum
+    --                 periodicity and pulse width for "1" and "0" values of
+    --                 the input test signal.  The timing constraint is 
+    --                 specified through parameters representing the minimal
+    --                 period between successive rising and falling edges of
+    --                 the input test signal and the minimum pulse widths 
+    --                 associated with high and low values.  
+    --                 
+    --                 VitalPeriodCheck's accepts rising and falling edges
+    --                 from 1 and 0 as well as transitions to and from 'X.'
+    --                 
+    --                    _______________         __________
+    --       ____________|               |_______|
+    --
+    --                   |<--- pw_hi --->|
+    --                   |<-------- period ----->|
+    --                                -->| pw_lo |<--
+    --                 
+    -- Arguments:
+    --  IN                 Type           Description
+    --    TestSignal        std_ulogic     Value of test signal  
+    --    TestSignalName    STRING         Name of the test signal
+    --    TestDelay         TIME           Model's internal delay associated
+    --                                     with TestSignal
+    --    Period            TIME           Minimum period allowed between
+    --                                     consecutive rising ('P') or 
+    --                                     falling ('F') transitions.
+    --    PulseWidthHigh    TIME           Minimum time allowed for a high
+    --                                     pulse ('1' or 'H')
+    --    PulseWidthLow     TIME           Minimum time allowed for a low
+    --                                     pulse ('0' or 'L')
+    --    CheckEnabled      BOOLEAN        Check performed if TRUE.
+    --    HeaderMsg         STRING         String that will accompany any
+    --                                     assertion messages produced.   
+    --    XOn               BOOLEAN        If TRUE, Violation output parameter
+    --                                     is set to "X". Otherwise, Violation
+    --                                     is always set to "0." 
+    --    MsgOn             BOOLEAN        If TRUE, period/pulse violation
+    --                                     message will be generated.
+    --                                     Otherwise, no messages are generated,
+    --                                     even though a violation is detected. 
+    --    MsgSeverity       SEVERITY_LEVEL Severity level for the assertion.
+    --         
+    --   INOUT
+    --    PeriodData        VitalPeriodDataType 
+    --                                     VitalPeriodPulseCheck information
+    --                                     storage area.  This is used
+    --                                     internally to detect reference edges
+    --                                     and record the pulse and period
+    --                                     times.
+    --   OUT
+    --    Violation         X01            This is the violation flag returned. 
+    --
+    --   Returns              
+    --    none
+    --
+    -- ------------------------------------------------------------------------
+    PROCEDURE VitalPeriodPulseCheck  (
+            VARIABLE Violation      : OUT    X01;
+            VARIABLE PeriodData     : INOUT  VitalPeriodDataType;
+            SIGNAL   TestSignal     : IN     std_ulogic;
+            CONSTANT TestSignalName : IN     STRING := "";
+            CONSTANT TestDelay      : IN     TIME := 0 ns;
+            CONSTANT Period         : IN     TIME := 0 ns;
+            CONSTANT PulseWidthHigh : IN     TIME := 0 ns;
+            CONSTANT PulseWidthLow  : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled   : IN     BOOLEAN := TRUE;
+            CONSTANT HeaderMsg      : IN     STRING := " ";
+            CONSTANT XOn            : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn          : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity    : IN     SEVERITY_LEVEL := WARNING
+        );
+ 
+END VITAL_Timing;
diff --git a/libraries/vital95/vital_timing_body.vhdl b/libraries/vital95/vital_timing_body.vhdl
new file mode 100644
index 000000000..09eb75565
--- /dev/null
+++ b/libraries/vital95/vital_timing_body.vhdl
@@ -0,0 +1,1275 @@
+-------------------------------------------------------------------------------
+-- Title        : Standard VITAL TIMING Package
+--              : $Revision: 597 $
+-- Library      : VITAL
+--              :  
+-- Developers   : IEEE DASC Timing Working Group (TWG), PAR 1076.4
+--              :  
+-- Purpose      : This packages defines standard types, attributes, constants,
+--              : functions and procedures for use in developing ASIC models.
+--              : This file contains the Package Body.
+-- ----------------------------------------------------------------------------
+--
+-- ----------------------------------------------------------------------------
+-- Modification History : 
+-- ----------------------------------------------------------------------------
+-- Version No:|Auth:| Mod.Date:| Changes Made:
+--   v95.0 A  |     | 06/08/95 | Initial ballot draft 1995
+--   v95.1    |     | 08/31/95 | #203 - Timing violations at time 0
+--                               #204 - Output mapping prior to glitch detection
+-- ----------------------------------------------------------------------------
+
+LIBRARY STD;
+USE STD.TEXTIO.ALL;
+
+PACKAGE BODY VITAL_Timing IS
+
+    -- --------------------------------------------------------------------
+    -- Package Local Declarations
+    -- --------------------------------------------------------------------
+    TYPE CheckType IS ( SetupCheck, HoldCheck, RecoveryCheck, RemovalCheck,
+                        PulseWidCheck, PeriodCheck );
+
+    TYPE CheckInfoType IS RECORD
+            Violation : BOOLEAN;
+            CheckKind : CheckType;
+            ObsTime   : TIME;
+            ExpTime   : TIME;
+            DetTime   : TIME;
+            State     : X01;
+    END RECORD;
+
+    TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; 
+    TYPE HiLoStrType IS ARRAY (std_ulogic RANGE 'X' TO '1') OF STRING(1 TO 4); 
+
+    CONSTANT LogicCvtTable : LogicCvtTableType 
+                     := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); 
+    CONSTANT HiLoStr     : HiLoStrType := ("  X ", " Low", "High" ); 
+
+    TYPE EdgeSymbolMatchType IS ARRAY (X01,X01,VitalEdgeSymbolType) OF BOOLEAN;
+    -- last value, present value, edge symbol
+    CONSTANT EdgeSymbolMatch : EdgeSymbolMatchType :=  (
+      'X'=>('X'=>(                                 OTHERS => FALSE),
+            '0'=>('N'|'F'|'v'|'E'|'D'|'*' => TRUE, OTHERS => FALSE ),
+            '1'=>('P'|'R'|'^'|'E'|'A'|'*' => TRUE, OTHERS => FALSE ) ),
+      '0'=>('X'=>(    'r'|'p'|'R'|'A'|'*' => TRUE, OTHERS => FALSE ),
+            '0'=>(                                 OTHERS => FALSE ),
+            '1'=>(    '/'|'P'|'p'|'R'|'*' => TRUE, OTHERS => FALSE ) ),
+      '1'=>('X'=>(    'f'|'n'|'F'|'D'|'*' => TRUE, OTHERS => FALSE ),
+            '0'=>(    '\'|'N'|'n'|'F'|'*' => TRUE, OTHERS => FALSE ),
+            '1'=>(                                 OTHERS => FALSE ) ) );
+
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    -- Misc Utilities Local Utilities
+    ---------------------------------------------------------------------------
+    -----------------------------------------------------------------------
+    FUNCTION Minimum ( CONSTANT t1,t2 : IN TIME ) RETURN TIME IS
+    BEGIN
+        IF ( t1 < t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+    END Minimum;
+    -----------------------------------------------------------------------
+    FUNCTION Maximum ( CONSTANT t1,t2 : IN TIME ) RETURN TIME IS
+    BEGIN
+        IF ( t1 > t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF;
+    END Maximum;
+
+    --------------------------------------------------------------------
+    -- Error Message Types and Tables
+    --------------------------------------------------------------------
+    TYPE VitalErrorType IS (
+        ErrVctLng  ,
+        ErrNoPath  ,
+        ErrNegPath ,
+        ErrNegDel
+    );
+ 
+    TYPE VitalErrorSeverityType IS ARRAY (VitalErrorType) OF SEVERITY_LEVEL;
+    CONSTANT VitalErrorSeverity : VitalErrorSeverityType := (
+        ErrVctLng    => ERROR,
+        ErrNoPath    => WARNING,
+        ErrNegPath   => WARNING,
+        ErrNegDel    => WARNING
+    );
+ 
+    CONSTANT MsgNoPath : STRING :=
+      "No Delay Path Condition TRUE.  0-delay used. Output signal is: ";
+    CONSTANT MsgNegPath : STRING :=
+      "Path Delay less than time since input. 0 delay used. Output signal is: ";
+    CONSTANT MsgNegDel : STRING :=
+      "Negative delay. New output value not scheduled. Output signal is: ";
+    CONSTANT MsgVctLng : STRING :=
+      "Vector (array) lengths not equal. ";
+ 
+    CONSTANT MsgUnknown : STRING :=
+      "Unknown error message.";
+ 
+    FUNCTION VitalMessage (
+            CONSTANT ErrorId : IN VitalErrorType
+          ) RETURN STRING IS
+    BEGIN
+        CASE ErrorId IS
+            WHEN ErrVctLng    => RETURN MsgVctLng;
+            WHEN ErrNoPath    => RETURN MsgNoPath;
+            WHEN ErrNegPath   => RETURN MsgNegPath;
+            WHEN ErrNegDel    => RETURN MsgNegDel;
+            WHEN OTHERS       => RETURN MsgUnknown;
+        END CASE;
+    END;
+
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId)
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+ 
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType;
+            CONSTANT Info    : IN STRING
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId) & Info
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+ 
+    PROCEDURE VitalError (
+            CONSTANT Routine : IN STRING;
+            CONSTANT ErrorId : IN VitalErrorType;
+            CONSTANT Info    : IN CHARACTER
+    ) IS
+    BEGIN
+        ASSERT FALSE
+          REPORT Routine & ": " & VitalMessage(ErrorId) & Info
+          SEVERITY VitalErrorSeverity(ErrorId);
+    END;
+ 
+    ---------------------------------------------------------------------------
+    -- Time Delay Assignment Subprograms
+    ---------------------------------------------------------------------------
+    FUNCTION VitalExtendToFillDelay ( 
+            CONSTANT Delay : IN VitalDelayType
+          ) RETURN VitalDelayType01Z IS
+    BEGIN
+        RETURN (OTHERS => Delay);
+    END VitalExtendToFillDelay;
+
+    FUNCTION VitalExtendToFillDelay ( 
+            CONSTANT Delay : IN VitalDelayType01
+          ) RETURN VitalDelayType01Z IS
+        VARIABLE Delay01Z  : VitalDelayType01Z;
+    BEGIN
+        Delay01Z(tr01) := Delay(tr01);
+        Delay01Z(tr0z) := Delay(tr01);
+        Delay01Z(trz1) := Delay(tr01);
+        Delay01Z(tr10) := Delay(tr10);
+        Delay01Z(tr1z) := Delay(tr10);
+        Delay01Z(trz0) := Delay(tr10);
+        RETURN (Delay01Z);
+    END VitalExtendToFillDelay;
+
+    FUNCTION VitalExtendToFillDelay ( 
+            CONSTANT Delay : IN VitalDelayType01Z
+          ) RETURN VitalDelayType01Z IS
+    BEGIN
+        RETURN Delay;
+    END VitalExtendToFillDelay;
+
+    ---------------------------------------------------------------------------
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType
+          ) RETURN TIME IS
+    BEGIN
+          RETURN delay;
+    END VitalCalcDelay;
+
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType01
+          ) RETURN TIME IS
+        VARIABLE Result : TIME;
+    BEGIN
+        CASE Newval IS
+          WHEN '0' | 'L' => Result := Delay(tr10);
+          WHEN '1' | 'H' => Result := Delay(tr01);
+          WHEN 'Z' =>
+            CASE Oldval IS
+              WHEN '0' | 'L' => Result := Delay(tr01);
+              WHEN '1' | 'H' => Result := Delay(tr10);
+              WHEN OTHERS    => Result := MAXIMUM(Delay(tr10), Delay(tr01));
+            END CASE;
+          WHEN OTHERS =>
+            CASE Oldval IS
+              WHEN '0' | 'L' => Result := Delay(tr01);
+              WHEN '1' | 'H' => Result := Delay(tr10);
+              WHEN 'Z'       => Result := MINIMUM(Delay(tr10), Delay(tr01));
+              WHEN OTHERS    => Result := MAXIMUM(Delay(tr10), Delay(tr01));
+            END CASE;
+        END CASE;
+        RETURN Result;
+    END VitalCalcDelay;
+
+    FUNCTION VitalCalcDelay (
+            CONSTANT NewVal : IN std_ulogic   := 'X';
+            CONSTANT OldVal : IN std_ulogic   := 'X';
+            CONSTANT Delay  : IN VitalDelayType01Z
+          ) RETURN TIME IS
+        VARIABLE Result : TIME;
+    BEGIN
+        CASE Oldval IS
+          WHEN '0' | 'L' =>
+            CASE Newval IS
+              WHEN '0' | 'L' => Result := Delay(tr10);
+              WHEN '1' | 'H' => Result := Delay(tr01);
+              WHEN 'Z'       => Result := Delay(tr0z);
+              WHEN OTHERS    => Result := MINIMUM(Delay(tr01), Delay(tr0z));
+            END CASE;
+          WHEN '1' | 'H' =>
+            CASE Newval IS
+              WHEN '0' | 'L' => Result := Delay(tr10);
+              WHEN '1' | 'H' => Result := Delay(tr01);
+              WHEN 'Z'       => Result := Delay(tr1z);
+              WHEN OTHERS    => Result := MINIMUM(Delay(tr10), Delay(tr1z));
+            END CASE;
+          WHEN 'Z' =>
+            CASE Newval IS
+              WHEN '0' | 'L' => Result := Delay(trz0);
+              WHEN '1' | 'H' => Result := Delay(trz1);
+              WHEN 'Z'       => Result := MAXIMUM (Delay(tr0z), Delay(tr1z));
+              WHEN OTHERS    => Result := MINIMUM (Delay(trz1), Delay(trz0));
+            END CASE;
+          WHEN 'U' | 'X' | 'W' | '-'  =>
+            CASE Newval IS
+              WHEN '0' | 'L' => Result := MAXIMUM(Delay(tr10), Delay(trz0));
+              WHEN '1' | 'H' => Result := MAXIMUM(Delay(tr01), Delay(trz1));
+              WHEN 'Z'       => Result := MAXIMUM(Delay(tr1z), Delay(tr0z));
+              WHEN OTHERS    => Result := MAXIMUM(Delay(tr10), Delay(tr01));
+            END CASE;
+        END CASE;
+        RETURN Result;
+    END VitalCalcDelay;
+
+    ---------------------------------------------------------------------------
+    FUNCTION VitalSelectPathDelay (
+            CONSTANT NewValue      : IN  std_logic;
+            CONSTANT OldValue      : IN  std_logic;
+            CONSTANT OutSignalName : IN  string;
+            CONSTANT Paths         : IN  VitalPathArrayType;
+            CONSTANT DefaultDelay  : IN  VitalDelayType
+          ) RETURN TIME IS
+ 
+        VARIABLE TmpDelay  : TIME;
+        VARIABLE InputAge  : TIME := TIME'HIGH;
+        VARIABLE PropDelay : TIME := TIME'HIGH;
+    BEGIN
+        -- for each delay path
+        FOR i IN Paths'RANGE LOOP
+            -- ignore the delay path if it is not enabled
+            NEXT WHEN NOT Paths(i).PathCondition;
+            -- ignore the delay path if a more recent input event has been seen
+            NEXT WHEN Paths(i).InputChangeTime > InputAge;
+ 
+            -- This is the most recent input change (so far)
+            -- Get the transition dependent delay
+            TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay);
+ 
+            -- If other inputs changed at the same time,
+            --  then use the minimum of their propagation delays,
+            --  else use the propagation delay from this input.
+            IF Paths(i).InputChangeTime < InputAge THEN
+                PropDelay := TmpDelay;
+            ELSE -- Simultaneous inputs change
+                IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF;
+            end if;
+ 
+            InputAge := Paths(i).InputChangeTime;
+        END LOOP;
+ 
+        -- If there were no paths (with an enabled condition),
+        --  use the default the delay
+        IF (PropDelay  = TIME'HIGH ) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- If the time since the most recent input event is greater than the
+        -- propagation delay from that input then
+        --  use the default the delay
+        ELSIF (InputAge > PropDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- Adjust the propagation delay by the time since the
+        -- the input event occurred  (Usually 0 ns).
+        ELSE
+            PropDelay := PropDelay - InputAge;
+        END IF;
+ 
+        RETURN PropDelay;
+    END;
+ 
+    FUNCTION VitalSelectPathDelay (
+            CONSTANT NewValue      : IN  std_logic;
+            CONSTANT OldValue      : IN  std_logic;
+            CONSTANT OutSignalName : IN  string;
+            CONSTANT Paths         : IN  VitalPathArray01Type;
+            CONSTANT DefaultDelay  : IN  VitalDelayType01
+          ) RETURN TIME IS
+ 
+        VARIABLE TmpDelay  : TIME;
+        VARIABLE InputAge  : TIME := TIME'HIGH;
+        VARIABLE PropDelay : TIME := TIME'HIGH;
+    BEGIN
+        -- for each delay path
+        FOR i IN Paths'RANGE LOOP
+            -- ignore the delay path if it is not enabled
+            NEXT WHEN NOT Paths(i).PathCondition;
+            -- ignore the delay path if a more recent input event has been seen
+            NEXT WHEN Paths(i).InputChangeTime > InputAge;
+ 
+            -- This is the most recent input change (so far)
+            -- Get the transition dependent delay
+            TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay);
+ 
+            -- If other inputs changed at the same time,
+            --  then use the minimum of their propagation delays,
+            --  else use the propagation delay from this input.
+            IF Paths(i).InputChangeTime < InputAge THEN
+                PropDelay := TmpDelay;
+            ELSE -- Simultaneous inputs change
+                IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF;
+            end if;
+ 
+            InputAge := Paths(i).InputChangeTime;
+        END LOOP;
+ 
+        -- If there were no paths (with an enabled condition),
+        --  use the default the delay
+        IF (PropDelay  = TIME'HIGH ) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- If the time since the most recent input event is greater than the
+        -- propagation delay from that input then
+        --  use the default the delay
+        ELSIF (InputAge > PropDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- Adjust the propagation delay by the time since the
+        -- the input event occurred  (Usually 0 ns).
+        ELSE
+            PropDelay := PropDelay - InputAge;
+        END IF;
+ 
+        RETURN PropDelay;
+    END;
+ 
+    FUNCTION VitalSelectPathDelay (
+            CONSTANT NewValue      : IN  std_logic;
+            CONSTANT OldValue      : IN  std_logic;
+            CONSTANT OutSignalName : IN  string;
+            CONSTANT Paths         : IN  VitalPathArray01ZType;
+            CONSTANT DefaultDelay  : IN  VitalDelayType01Z
+          ) RETURN TIME IS
+ 
+        VARIABLE TmpDelay  : TIME;
+        VARIABLE InputAge  : TIME := TIME'HIGH;
+        VARIABLE PropDelay : TIME := TIME'HIGH;
+    BEGIN
+        -- for each delay path
+        FOR i IN Paths'RANGE LOOP
+            -- ignore the delay path if it is not enabled
+            NEXT WHEN NOT Paths(i).PathCondition;
+            -- ignore the delay path if a more recent input event has been seen
+            NEXT WHEN Paths(i).InputChangeTime > InputAge;
+ 
+            -- This is the most recent input change (so far)
+            -- Get the transition dependent delay
+            TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay);
+ 
+            -- If other inputs changed at the same time,
+            --  then use the minimum of their propagation delays,
+            --  else use the propagation delay from this input.
+            IF Paths(i).InputChangeTime < InputAge THEN
+                PropDelay := TmpDelay;
+            ELSE -- Simultaneous inputs change
+                IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF;
+            end if;
+ 
+            InputAge := Paths(i).InputChangeTime;
+        END LOOP;
+ 
+        -- If there were no paths (with an enabled condition),
+        --  use the default the delay
+        IF (PropDelay  = TIME'HIGH ) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- If the time since the most recent input event is greater than the
+        -- propagation delay from that input then
+        --  use the default the delay
+        ELSIF (InputAge > PropDelay) THEN
+            PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay);
+ 
+        -- Adjust the propagation delay by the time since the
+        -- the input event occurred  (Usually 0 ns).
+        ELSE
+            PropDelay := PropDelay - InputAge;
+        END IF;
+ 
+        RETURN PropDelay;
+    END;
+ 
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    -- Glitch Handlers
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    PROCEDURE ReportGlitch ( 
+            CONSTANT GlitchRoutine  : IN  STRING;
+            CONSTANT OutSignalName  : IN  STRING;
+            CONSTANT PreemptedTime  : IN  TIME;
+            CONSTANT PreemptedValue : IN  std_ulogic;
+            CONSTANT NewTime        : IN  TIME;
+            CONSTANT NewValue       : IN  std_ulogic;
+            CONSTANT Index          : IN  INTEGER := 0;
+            CONSTANT IsArraySignal  : IN  BOOLEAN := FALSE;
+            CONSTANT MsgSeverity    : IN  SEVERITY_LEVEL := WARNING
+    ) IS
+
+        VARIABLE StrPtr1, StrPtr2, StrPtr3, StrPtr4, StrPtr5 : LINE;
+    BEGIN
+
+        Write (StrPtr1, PreemptedTime );
+        Write (StrPtr2, NewTime);
+        Write (StrPtr3, LogicCvtTable(PreemptedValue));
+        Write (StrPtr4, LogicCvtTable(NewValue));
+        IF IsArraySignal THEN
+            Write (StrPtr5, STRING'( "(" ) );
+            Write (StrPtr5, Index);
+            Write (StrPtr5, STRING'( ")" ) );
+        ELSE
+            Write (StrPtr5, STRING'( " " ) );
+        END IF;
+
+        -- Issue Report only if Preempted value has not been
+        --  removed from event queue
+        ASSERT PreemptedTime >  NewTime
+          REPORT GlitchRoutine & ": GLITCH Detected on port " & 
+                 OutSignalName & StrPtr5.ALL &
+                 "; Preempted Future Value := " & StrPtr3.ALL &
+                 " @ " & StrPtr1.ALL &
+                 "; Newly Scheduled Value := " & StrPtr4.ALL &
+                 " @ " & StrPtr2.ALL &
+                 ";"
+          SEVERITY MsgSeverity;
+
+        DEALLOCATE(StrPtr1);
+        DEALLOCATE(StrPtr2);
+        DEALLOCATE(StrPtr3);
+        DEALLOCATE(StrPtr4); 
+        DEALLOCATE(StrPtr5); 
+        RETURN;
+    END ReportGlitch;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalGlitch (
+        SIGNAL   OutSignal     : OUT   std_logic;
+        VARIABLE GlitchData    : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName : IN    string;
+        CONSTANT NewValue      : IN    std_logic;
+        CONSTANT NewDelay      : IN    TIME           := 0 ns;
+        CONSTANT Mode          : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn           : IN    BOOLEAN        := TRUE;
+        CONSTANT MsgOn         : IN    BOOLEAN        := FALSE;
+        CONSTANT MsgSeverity   : IN    SEVERITY_LEVEL := WARNING
+        ) IS
+    ---------------------------------------------------------------------------
+        VARIABLE NewGlitch : BOOLEAN := TRUE;
+        VARIABLE dly       : TIME    := NewDelay;
+ 
+    BEGIN
+        -- If nothing to schedule, just return
+        IF NewDelay < 0 ns THEN
+            IF (NewValue /= GlitchData.SchedValue) THEN
+                VitalError ( "VitalGlitch", ErrNegDel, OutSignalName );
+            END IF;
+            RETURN;
+        END IF;
+ 
+        -- If simple signal assignment
+        --   perform the signal assignment
+        IF    ( Mode = VitalInertial) THEN
+            OutSignal <= NewValue AFTER dly;
+        ELSIF ( Mode = VitalTransport ) THEN
+            OutSignal <= TRANSPORT NewValue AFTER dly;
+        ELSE
+            -- Glitch Processing ---
+            -- If nothing currently scheduled
+            IF GlitchData.SchedTime <= NOW THEN
+                -- Note: NewValue is always /= OldValue when called from VPPD
+                IF (NewValue = GlitchData.SchedValue) THEN RETURN; END IF;
+                -- No new glitch, save time for possable future glitch
+                NewGlitch := FALSE;
+                GlitchData.GlitchTime := NOW+dly;
+     
+            -- New value earlier than the earliest previous value scheduled
+            ELSIF (NOW+dly <= GlitchData.GlitchTime)
+                  AND (NOW+dly <= GlitchData.SchedTime) THEN
+                -- No new glitch, save time for possible future glitch
+                NewGlitch := FALSE;
+                GlitchData.GlitchTime := NOW+dly;
+         
+            -- Transaction currently scheduled - if glitch already happened
+            ELSIF GlitchData.GlitchTime <= NOW THEN
+                IF (GlitchData.SchedValue = NewValue) THEN
+                    dly := Minimum( GlitchData.SchedTime-NOW, NewDelay );
+                END IF;
+                NewGlitch := FALSE;
+     
+            -- Transaction currently scheduled (no glitch if same value)
+            ELSIF (GlitchData.SchedValue = NewValue)
+                  AND (GlitchData.SchedTime = GlitchData.GlitchTime) THEN
+                -- revise scheduled output time if new delay is sooner
+                dly := Minimum( GlitchData.SchedTime-NOW, NewDelay );
+                -- No new glitch, save time for possable future glitch
+                NewGlitch := FALSE;
+                GlitchData.GlitchTime := NOW+dly;
+     
+            -- Transaction currently scheduled represents a glitch
+            ELSE
+                -- A new glitch has been detected
+                NewGlitch := TRUE;
+            END IF;
+     
+            IF NewGlitch THEN
+                -- If  messages requested, report the glitch
+                IF MsgOn THEN
+                    ReportGlitch ("VitalGlitch", OutSignalName,
+                                   GlitchData.GlitchTime, GlitchData.SchedValue,
+                                   (dly + NOW), NewValue,
+                                   MsgSeverity=>MsgSeverity );
+                END IF;
+     
+                -- Force immediate glitch for "OnDetect" mode.
+                IF (Mode = OnDetect) THEN
+                    GlitchData.GlitchTime := NOW;
+                END IF;
+     
+                -- If 'X' generation is requested, schedule the new value 
+                --  preceeded by a glitch pulse.
+                -- Otherwise just schedule the new value (inertial mode).
+                IF XOn THEN
+                    OutSignal <= 'X' AFTER GlitchData.GlitchTime-NOW;
+                    OutSignal <= TRANSPORT NewValue AFTER dly;
+                ELSE
+                    OutSignal <= NewValue AFTER dly;
+                END IF;
+     
+            -- If there no new glitch was detected, just schedule the new value.
+            ELSE
+                OutSignal <= NewValue AFTER dly;
+            END IF;
+
+        END IF;
+ 
+        -- Record the new value and time just scheduled.
+        GlitchData.SchedValue := NewValue;
+        GlitchData.SchedTime  := NOW+dly;
+        RETURN;
+    END;
+ 
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalPathDelay (
+        SIGNAL   OutSignal     : OUT   std_logic;
+        VARIABLE GlitchData    : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName : IN    string;
+        CONSTANT OutTemp       : IN    std_logic;
+        CONSTANT Paths         : IN    VitalPathArrayType;
+        CONSTANT DefaultDelay  : IN    VitalDelayType      := VitalZeroDelay;
+        CONSTANT Mode          : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn           : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn         : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity   : IN    SEVERITY_LEVEL      := WARNING
+    ) IS
+ 
+        VARIABLE PropDelay : TIME;
+    BEGIN
+        -- Check if the new value to be scheduled is different than the
+        -- previously scheduled value
+        IF (GlitchData.SchedTime <= NOW) AND
+           (GlitchData.SchedValue = OutTemp)
+             THEN RETURN;
+        END IF;
+ 
+        -- Evaluate propagation delay paths
+        PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue,
+                                           OutSignalName, Paths, DefaultDelay);
+        GlitchData.LastValue := OutTemp;
+ 
+        -- Schedule the output transactions - including glitch handling
+        VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp,
+                     PropDelay, Mode, XOn, MsgOn, MsgSeverity );
+ 
+    END VitalPathDelay;
+
+    PROCEDURE VitalPathDelay01 (
+        SIGNAL   OutSignal     : OUT   std_logic;
+        VARIABLE GlitchData    : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName : IN    string;
+        CONSTANT OutTemp       : IN    std_logic;
+        CONSTANT Paths         : IN    VitalPathArray01Type;
+        CONSTANT DefaultDelay  : IN    VitalDelayType01    := VitalZeroDelay01;
+        CONSTANT Mode          : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn           : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn         : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity   : IN    SEVERITY_LEVEL      := WARNING
+    ) IS
+ 
+        VARIABLE PropDelay : TIME;
+    BEGIN
+        -- Check if the new value to be scheduled is different than the
+        -- previously scheduled value
+        IF (GlitchData.SchedTime <= NOW) AND
+           (GlitchData.SchedValue = OutTemp)
+             THEN RETURN;
+        END IF;
+ 
+        -- Evaluate propagation delay paths
+        PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue,
+                                           OutSignalName, Paths, DefaultDelay);
+        GlitchData.LastValue := OutTemp;
+ 
+        -- Schedule the output transactions - including glitch handling
+        VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp,
+                     PropDelay, Mode, XOn, MsgOn, MsgSeverity );
+ 
+    END VitalPathDelay01;
+
+    PROCEDURE VitalPathDelay01Z (
+        SIGNAL   OutSignal     : OUT   std_logic;
+        VARIABLE GlitchData    : INOUT VitalGlitchDataType;
+        CONSTANT OutSignalName : IN    string;
+        CONSTANT OutTemp       : IN    std_logic;
+        CONSTANT Paths         : IN    VitalPathArray01ZType;
+        CONSTANT DefaultDelay  : IN    VitalDelayType01Z   := VitalZeroDelay01Z;
+        CONSTANT Mode          : IN    VitalGlitchKindType := OnEvent;
+        CONSTANT XOn           : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgOn         : IN    BOOLEAN             := TRUE;
+        CONSTANT MsgSeverity   : IN    SEVERITY_LEVEL      := WARNING;
+        CONSTANT OutputMap     : IN    VitalOutputMapType 
+                                        := VitalDefaultOutputMap
+    ) IS
+ 
+        VARIABLE PropDelay : TIME;
+    BEGIN
+        -- Check if the new value to be scheduled is different than the
+        -- previously scheduled value
+        IF (GlitchData.SchedTime <= NOW) AND
+           (GlitchData.SchedValue = OutputMap(OutTemp) )
+             THEN RETURN;
+        END IF;
+ 
+        -- Evaluate propagation delay paths
+        PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue,
+                                           OutSignalName, Paths, DefaultDelay);
+        GlitchData.LastValue := OutTemp;
+ 
+        -- Schedule the output transactions - including glitch handling
+        VitalGlitch (OutSignal, GlitchData, OutSignalName, OutputMap(OutTemp),
+                     PropDelay, Mode, XOn, MsgOn, MsgSeverity );
+ 
+    END VitalPathDelay01Z;
+
+    ----------------------------------------------------------------------------
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig  : OUT   std_ulogic;
+            SIGNAL   InSig   : IN    std_ulogic;
+            CONSTANT twire   : IN    VitalDelayType
+    ) IS
+    BEGIN
+        OutSig <= TRANSPORT InSig AFTER twire;
+    END VitalWireDelay;    
+
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig  : OUT   std_ulogic;
+            SIGNAL   InSig   : IN    std_ulogic;
+            CONSTANT twire   : IN    VitalDelayType01
+    ) IS
+       VARIABLE Delay   : TIME;
+    BEGIN
+        Delay := VitalCalcDelay( InSig, InSig'LAST_VALUE, twire );
+        OutSig <= TRANSPORT InSig AFTER Delay;
+    END VitalWireDelay;    
+
+    PROCEDURE VitalWireDelay (
+            SIGNAL   OutSig  : OUT   std_ulogic;
+            SIGNAL   InSig   : IN    std_ulogic;
+            CONSTANT twire   : IN    VitalDelayType01Z
+    ) IS
+       VARIABLE Delay   : TIME;
+    BEGIN
+        Delay := VitalCalcDelay( InSig, InSig'LAST_VALUE, twire );
+        OutSig <= TRANSPORT InSig AFTER Delay;
+    END VitalWireDelay;    
+
+    ----------------------------------------------------------------------------
+    PROCEDURE VitalSignalDelay (
+            SIGNAL   OutSig     : OUT   std_ulogic;
+            SIGNAL   InSig      : IN    std_ulogic;
+            CONSTANT dly        : IN   TIME
+    ) IS
+    BEGIN
+        OutSig <= TRANSPORT InSig AFTER dly;
+    END;
+
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    -- Setup and Hold Time Check Routine 
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    PROCEDURE ReportViolation (
+            CONSTANT TestSignalName : IN STRING := "";
+            CONSTANT RefSignalName  : IN STRING := "";
+            CONSTANT HeaderMsg      : IN STRING := " ";
+            CONSTANT CheckInfo      : IN CheckInfoType;
+            CONSTANT MsgSeverity    : IN SEVERITY_LEVEL := WARNING
+    ) IS
+        VARIABLE Message : LINE;
+    BEGIN
+        IF NOT CheckInfo.Violation THEN RETURN; END IF;
+
+        Write ( Message, HeaderMsg );
+        Case CheckInfo.CheckKind IS
+          WHEN    SetupCheck => Write ( Message, STRING'(" SETUP ")      );
+          WHEN     HoldCheck => Write ( Message, STRING'(" HOLD ")       );
+          WHEN RecoveryCheck => Write ( Message, STRING'(" RECOVERY ")   );
+          WHEN  RemovalCheck => Write ( Message, STRING'(" REMOVAL ")    );
+          WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH "));
+          WHEN   PeriodCheck => Write ( Message, STRING'(" PERIOD ")     );
+        END CASE;
+        Write ( Message, HiLoStr(CheckInfo.State) );
+        Write ( Message, STRING'(" VIOLATION ON ") );
+        Write ( Message, TestSignalName );
+        IF (RefSignalName'LENGTH > 0) THEN
+            Write ( Message, STRING'(" WITH RESPECT TO ") );
+            Write ( Message, RefSignalName );
+        END IF;
+        Write ( Message, ';' & LF );
+        Write ( Message, STRING'("  Expected := ")  );
+        Write ( Message, CheckInfo.ExpTime);
+        Write ( Message, STRING'("; Observed := ")  );
+        Write ( Message, CheckInfo.ObsTime);
+        Write ( Message, STRING'("; At : ")         );
+        Write ( Message, CheckInfo.DetTime);
+
+        ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity;
+
+        DEALLOCATE (Message);
+    END ReportViolation;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : InternalTimingCheck
+    ---------------------------------------------------------------------------
+    PROCEDURE InternalTimingCheck (
+            CONSTANT TestSignal    : IN     std_ulogic;
+            CONSTANT RefSignal     : IN     std_ulogic;
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            VARIABLE RefTime       : IN     TIME;
+            VARIABLE RefEdge       : IN     BOOLEAN;
+            VARIABLE TestTime      : IN     TIME;
+            VARIABLE TestEvent     : IN     BOOLEAN;
+            VARIABLE SetupEn       : INOUT  BOOLEAN;
+            VARIABLE HoldEn        : INOUT  BOOLEAN;
+            VARIABLE CheckInfo     : INOUT  CheckInfoType;
+            CONSTANT MsgOn         : IN     BOOLEAN
+    ) IS
+        VARIABLE bias, b2 : TIME;
+    BEGIN
+        -- Check SETUP constraint
+      IF RefEdge THEN
+          IF SetupEn THEN
+            CheckInfo.ObsTime   := RefTime - TestTime;
+            CheckInfo.State     := To_X01(TestSignal);
+            CASE CheckInfo.State IS
+              WHEN '0' => CheckInfo.ExpTime := SetupLow;
+              WHEN '1' => CheckInfo.ExpTime := SetupHigh;
+              WHEN 'X' => CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow);
+            END CASE;
+            CheckInfo.Violation := CheckInfo.ObsTime < CheckInfo.ExpTime;
+            SetupEn  := FALSE;
+          ELSE
+            CheckInfo.Violation := FALSE;
+          END IF;
+  
+        -- Check HOLD constraint
+      ELSIF TestEvent THEN
+          IF HoldEn THEN
+            CheckInfo.ObsTime := TestTime - RefTime;
+            CheckInfo.State := To_X01(TestSignal);
+            CASE CheckInfo.State IS
+              WHEN '0' => CheckInfo.ExpTime := HoldHigh;
+              WHEN '1' => CheckInfo.ExpTime := HoldLow;
+              WHEN 'X' => CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow);
+            END CASE;
+            CheckInfo.Violation   := CheckInfo.ObsTime < CheckInfo.ExpTime;
+            HoldEn := NOT CheckInfo.Violation;
+          ELSE
+            CheckInfo.Violation := FALSE;
+          END IF;
+      ELSE
+          CheckInfo.Violation := FALSE;
+      END IF;
+
+      -- Adjust report values to account for internal model delays
+      -- Note: TestDelay, RefDelay, TestTime, RefTime and bias are non-negative
+      IF MsgOn AND CheckInfo.Violation THEN
+          bias := TestDelay - RefDelay;
+          IF TestTime - RefTime <= bias THEN
+            CheckInfo.CheckKind := SetupCheck;
+            b2 := TIME'HIGH - bias;
+            IF (CheckInfo.ObsTime <= b2)
+              THEN CheckInfo.ObsTime := CheckInfo.ObsTime + bias;
+              ELSE CheckInfo.ObsTime := Time'HIGH;
+            END IF;
+            IF (CheckInfo.ExpTime <= b2)
+              THEN CheckInfo.ExpTime := CheckInfo.ExpTime + bias;
+              ELSE CheckInfo.ExpTime := Time'HIGH;
+            END IF;
+            CheckInfo.DetTime := RefTime - RefDelay;
+          ELSE
+            CheckInfo.CheckKind :=  HoldCheck;
+            CheckInfo.ObsTime := CheckInfo.ObsTime - bias;
+            IF (CheckInfo.ExpTime >= 0 ns) THEN
+              CheckInfo.ExpTime := CheckInfo.ExpTime - bias;
+            END IF;
+            CheckInfo.DetTime := TestTime - TestDelay;
+          END IF;
+      END IF;
+    END InternalTimingCheck;
+
+    ---------------------------------------------------------------------------
+    ---------------------------------------------------------------------------
+    FUNCTION VitalTimingDataInit 
+            RETURN VitalTimingDataType IS
+    BEGIN
+        RETURN (FALSE,'X', 0 ns, FALSE, 'X', 0 ns, FALSE, NULL, NULL, NULL, NULL);
+    END;
+
+    ---------------------------------------------------------------------------
+    -- Procedure  : VitalSetupHoldCheck
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalSetupHoldCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_ulogic;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING  := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING
+    ) IS 
+
+        VARIABLE CheckInfo : CheckInfoType;
+        VARIABLE RefEdge, TestEvent : BOOLEAN;
+        VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay);
+        VARIABLE RefDly  : TIME := Maximum(0 ns, RefDelay);
+        VARIABLE bias : TIME;
+    BEGIN
+
+      IF (TimingData.NotFirstFlag = FALSE) THEN
+         TimingData.TestLast := To_X01(TestSignal);
+         TimingData.RefLast := To_X01(RefSignal);
+         TimingData.NotFirstFlag := TRUE;
+      END IF;
+
+      -- Detect reference edges and record the time of the last edge
+      RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+                                 RefTransition);
+      TimingData.RefLast := To_X01(RefSignal);
+      IF RefEdge THEN
+        TimingData.RefTime := NOW;
+        TimingData.HoldEn  := TRUE;
+      END IF;
+
+      -- Detect test (data) changes and record the time of the last change
+      TestEvent := TimingData.TestLast /= To_X01Z(TestSignal);
+      TimingData.TestLast := To_X01Z(TestSignal);
+      IF TestEvent THEN
+        TimingData.TestTime := NOW;
+        TimingData.SetupEn  := TRUE;
+      END IF;
+
+      -- Perform timing checks (if enabled)
+      Violation := '0';
+      IF (CheckEnabled) THEN
+         InternalTimingCheck (
+             TestSignal   => TestSignal,
+             RefSignal    => RefSignal,
+             TestDelay    => TestDly,
+             RefDelay     => RefDly,
+             SetupHigh    => SetupHigh,
+             SetupLow     => SetupLow,
+             HoldHigh     => HoldHigh,
+             HoldLow      => HoldLow,
+             RefTime      => TimingData.RefTime,
+             RefEdge      => RefEdge,
+             TestTime     => TimingData.TestTime,
+             TestEvent    => TestEvent,
+             SetupEn      => TimingData.SetupEn,
+             HoldEn       => TimingData.HoldEn,
+             CheckInfo    => CheckInfo,
+             MsgOn        => MsgOn );
+
+        -- Report any detected violations and set return violation flag
+        IF CheckInfo.Violation THEN
+            IF (MsgOn) THEN
+                ReportViolation (TestSignalName, RefSignalName,
+                                 HeaderMsg, CheckInfo, MsgSeverity );
+            END IF;
+            IF (XOn) THEN Violation := 'X'; END IF;
+        END IF;
+      END IF;
+
+    END VitalSetupHoldCheck;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalSetupHoldCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_logic_vector;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT SetupHigh     : IN     TIME := 0 ns;
+            CONSTANT SetupLow      : IN     TIME := 0 ns;
+            CONSTANT HoldHigh      : IN     TIME := 0 ns;
+            CONSTANT HoldLow       : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING
+    ) IS 
+
+        VARIABLE CheckInfo : CheckInfoType;
+        VARIABLE RefEdge : BOOLEAN;
+        VARIABLE TestEvent : VitalBoolArrayT(TestSignal'RANGE);
+        VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay);
+        VARIABLE RefDly  : TIME := Maximum(0 ns, RefDelay);
+        VARIABLE bias : TIME;
+        VARIABLE ChangedAllAtOnce : BOOLEAN := TRUE;
+        VARIABLE StrPtr1 : LINE;
+
+    BEGIN
+      -- Initialization of working area. 
+      IF (TimingData.NotFirstFlag = FALSE) THEN
+        TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE);
+        TimingData.TestTimeA := NEW  VitalTimeArrayT(TestSignal'RANGE);
+        TimingData.HoldEnA   := NEW  VitalBoolArrayT(TestSignal'RANGE);
+        TimingData.SetupEnA  := NEW  VitalBoolArrayT(TestSignal'RANGE);
+        FOR i IN TestSignal'RANGE LOOP
+          TimingData.TestLastA(i) := To_X01(TestSignal(i));
+        END LOOP;
+        TimingData.RefLast := To_X01(RefSignal);
+        TimingData.NotFirstFlag := TRUE;
+      END IF;
+
+      -- Detect reference edges and record the time of the last edge
+      RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+                                 RefTransition);
+      TimingData.RefLast := To_X01(RefSignal);
+      IF RefEdge THEN
+        TimingData.RefTime     := NOW;
+        TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE);
+      END IF;
+  
+      -- Detect test (data) changes and record the time of the last change
+      FOR i IN TestSignal'RANGE LOOP
+        TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i));
+        TimingData.TestLastA(i) := To_X01Z(TestSignal(i));
+        IF TestEvent(i) THEN
+          TimingData.TestTimeA(i) := NOW;
+          TimingData.SetupEnA(i)  := TRUE;
+          TimingData.TestTime := NOW;
+        END IF;
+      END LOOP;
+
+      -- Check to see if the Bus subelements changed all at the same time.
+      -- If so, then we can reduce the volume of error messages since we no
+      -- longer have to report every subelement individually
+      FOR i IN TestSignal'RANGE LOOP
+        IF TimingData.TestTimeA(i) /= TimingData.TestTime THEN
+            ChangedAllAtOnce := FALSE;
+            EXIT;
+        END IF;
+      END LOOP;
+  
+      -- Perform timing checks (if enabled)
+      Violation := '0';
+      IF (CheckEnabled) THEN
+        FOR i IN TestSignal'RANGE LOOP
+          InternalTimingCheck (
+              TestSignal   => TestSignal(i),
+              RefSignal    => RefSignal,
+              TestDelay    => TestDly,
+              RefDelay     => RefDly,
+              SetupHigh    => SetupHigh,
+              SetupLow     => SetupLow,
+              HoldHigh     => HoldHigh,
+              HoldLow      => HoldLow,
+              RefTime      => TimingData.RefTime,
+              RefEdge      => RefEdge,
+              TestTime     => TimingData.TestTimeA(i),
+              TestEvent    => TestEvent(i),
+              SetupEn      => TimingData.SetupEnA(i),
+              HoldEn       => TimingData.HoldEnA(i),
+              CheckInfo    => CheckInfo,
+              MsgOn        => MsgOn );
+
+          -- Report any detected violations and set return violation flag
+          IF CheckInfo.Violation THEN
+            IF (MsgOn) THEN
+              IF ( ChangedAllAtOnce AND (i = TestSignal'LEFT) ) THEN
+                ReportViolation (TestSignalName&"(...)", RefSignalName,
+                                 HeaderMsg, CheckInfo, MsgSeverity );
+              ELSIF (NOT ChangedAllAtOnce) THEN
+                Write (StrPtr1, i);
+                ReportViolation (TestSignalName & "(" & StrPtr1.ALL & ")", 
+                                 RefSignalName,
+                                 HeaderMsg, CheckInfo, MsgSeverity );
+                DEALLOCATE (StrPtr1);
+              END IF;
+            END IF;
+            IF (XOn) THEN
+              Violation := 'X';
+            END IF;
+          END IF;
+        END LOOP;
+      END IF;
+
+      DEALLOCATE (StrPtr1);
+
+    END VitalSetupHoldCheck;
+    
+    ---------------------------------------------------------------------------
+    -- Function   : VitalRecoveryRemovalCheck
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalRecoveryRemovalCheck (
+            VARIABLE Violation     : OUT    X01;
+            VARIABLE TimingData    : INOUT  VitalTimingDataType;
+            SIGNAL   TestSignal    : IN     std_ulogic;
+            CONSTANT TestSignalName: IN     STRING := "";
+            CONSTANT TestDelay     : IN     TIME := 0 ns;
+            SIGNAL   RefSignal     : IN     std_ulogic;
+            CONSTANT RefSignalName : IN     STRING := "";
+            CONSTANT RefDelay      : IN     TIME := 0 ns;
+            CONSTANT Recovery      : IN     TIME := 0 ns;
+            CONSTANT Removal       : IN     TIME := 0 ns;
+            CONSTANT ActiveLow     : IN     BOOLEAN := TRUE;
+            CONSTANT CheckEnabled  : IN     BOOLEAN := TRUE;
+            CONSTANT RefTransition : IN     VitalEdgeSymbolType;
+            CONSTANT HeaderMsg     : IN     STRING := " ";
+            CONSTANT XOn           : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn         : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity   : IN     SEVERITY_LEVEL := WARNING
+    ) IS
+        VARIABLE CheckInfo : CheckInfoType;
+        VARIABLE RefEdge, TestEvent : BOOLEAN;
+        VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay);
+        VARIABLE RefDly  : TIME := Maximum(0 ns, RefDelay);
+        VARIABLE bias : TIME;
+    BEGIN
+ 
+      IF (TimingData.NotFirstFlag = FALSE) THEN
+         TimingData.TestLast := To_X01(TestSignal);
+         TimingData.RefLast := To_X01(RefSignal);
+         TimingData.NotFirstFlag := TRUE;
+      END IF;
+
+      -- Detect reference edges and record the time of the last edge
+      RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal),
+                                 RefTransition);
+      TimingData.RefLast := To_X01(RefSignal);
+      IF RefEdge THEN
+        TimingData.RefTime := NOW;
+        TimingData.HoldEn  := TRUE;
+      END IF;
+ 
+      -- Detect test (data) changes and record the time of the last change
+      TestEvent := TimingData.TestLast /= To_X01Z(TestSignal);
+      TimingData.TestLast := To_X01Z(TestSignal);
+      IF TestEvent THEN
+        TimingData.TestTime := NOW;
+        TimingData.SetupEn  := TRUE;
+      END IF;
+ 
+      -- Perform timing checks (if enabled)
+      Violation := '0';
+      IF (CheckEnabled) THEN
+
+        IF ActiveLow THEN
+         InternalTimingCheck (
+             TestSignal, RefSignal, TestDly, RefDly,
+             Recovery, 0 ns, 0 ns, Removal,
+             TimingData.RefTime, RefEdge,
+             TimingData.TestTime, TestEvent,
+             TimingData.SetupEn, TimingData.HoldEn,
+             CheckInfo, MsgOn );
+        ELSE 
+         InternalTimingCheck (
+             TestSignal, RefSignal, TestDly, RefDly,
+             0 ns, Recovery, Removal, 0 ns,
+             TimingData.RefTime, RefEdge,
+             TimingData.TestTime, TestEvent,
+             TimingData.SetupEn, TimingData.HoldEn,
+             CheckInfo, MsgOn );
+        END IF;
+
+ 
+        -- Report any detected violations and set return violation flag
+        IF CheckInfo.Violation THEN
+            IF CheckInfo.CheckKind = SetupCheck THEN
+                CheckInfo.CheckKind := RecoveryCheck;
+            ELSE
+                CheckInfo.CheckKind := RemovalCheck;
+            END IF;
+            IF (MsgOn) THEN
+                ReportViolation (TestSignalName, RefSignalName, 
+                                 HeaderMsg, CheckInfo, MsgSeverity );
+            END IF;
+            IF (XOn) THEN Violation := 'X'; END IF;
+        END IF;
+      END IF;
+
+    END VitalRecoveryRemovalCheck;
+
+    ---------------------------------------------------------------------------
+    PROCEDURE VitalPeriodPulseCheck  (
+            VARIABLE Violation      : OUT    X01;
+            VARIABLE PeriodData     : INOUT  VitalPeriodDataType;
+            SIGNAL   TestSignal     : IN     std_ulogic;
+            CONSTANT TestSignalName : IN     STRING := "";
+            CONSTANT TestDelay      : IN     TIME := 0 ns;
+            CONSTANT Period         : IN     TIME := 0 ns;
+            CONSTANT PulseWidthHigh : IN     TIME := 0 ns;
+            CONSTANT PulseWidthLow  : IN     TIME := 0 ns;
+            CONSTANT CheckEnabled   : IN     BOOLEAN := TRUE;
+            CONSTANT HeaderMsg      : IN     STRING := " ";
+            CONSTANT XOn            : IN     BOOLEAN := TRUE;
+            CONSTANT MsgOn          : IN     BOOLEAN := TRUE;
+            CONSTANT MsgSeverity    : IN     SEVERITY_LEVEL := WARNING
+    ) IS 
+
+        VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay);
+        VARIABLE CheckInfo : CheckInfoType;
+        VARIABLE PeriodObs : TIME;
+        VARIABLE PulseTest, PeriodTest : BOOLEAN;
+        VARIABLE TestValue : X01 := To_X01(TestSignal);
+    BEGIN
+
+        IF (PeriodData.NotFirstFlag = FALSE) THEN
+           PeriodData.Rise :=
+                -maximum(Period, maximum(PulseWidthHigh, PulseWidthLow));
+           PeriodData.Fall :=
+                -maximum(Period, maximum(PulseWidthHigh, PulseWidthLow));
+           PeriodData.Last := To_X01(TestSignal);
+           PeriodData.NotFirstFlag := TRUE;
+        END IF;
+
+        -- Initialize for no violation
+        -- No violation possible if no test signal change
+        Violation := '0';
+        IF (PeriodData.Last = TestValue) THEN
+            RETURN;
+        END IF;
+
+        -- record starting pulse times
+        IF EdgeSymbolMatch(PeriodData.Last, TestValue, 'P') THEN
+            -- Compute period times, then record the High Rise Time
+            PeriodObs := NOW - PeriodData.Rise;
+            PeriodData.Rise := NOW;
+            PeriodTest := TRUE;
+        ELSIF EdgeSymbolMatch(PeriodData.Last, TestValue, 'N') THEN
+            -- Compute period times, then record the Low Fall Time
+            PeriodObs := NOW - PeriodData.Fall;
+            PeriodData.Fall := NOW;
+            PeriodTest := TRUE;
+        ELSE
+            PeriodTest := FALSE;
+	END IF;
+
+        -- do checks on pulse ends
+        IF EdgeSymbolMatch(PeriodData.Last, TestValue, 'p') THEN
+            -- Compute pulse times
+            CheckInfo.ObsTime := NOW - PeriodData.Fall;
+            CheckInfo.ExpTime := PulseWidthLow;
+            PulseTest := TRUE;
+        ELSIF EdgeSymbolMatch(PeriodData.Last, TestValue, 'n') THEN
+            -- Compute pulse times
+            CheckInfo.ObsTime := NOW - PeriodData.Rise;
+            CheckInfo.ExpTime := PulseWidthHigh;
+            PulseTest := TRUE;
+        ELSE
+            PulseTest := FALSE;
+        END IF;
+
+        IF PulseTest AND CheckEnabled THEN
+           -- Verify Pulse Width [ignore 1st edge]
+            IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN
+                IF (XOn) THEN Violation := 'X'; END IF;
+                IF (MsgOn) THEN
+                    CheckInfo.Violation := TRUE;
+                    CheckInfo.CheckKind := PulseWidCheck;
+                    CheckInfo.DetTime   := NOW - TestDly;
+                    CheckInfo.State     := PeriodData.Last;
+                    ReportViolation (TestSignalName, "", 
+                                     HeaderMsg, CheckInfo, MsgSeverity );
+                END IF; -- MsgOn
+            END IF;
+        END IF;
+
+        IF PeriodTest AND CheckEnabled THEN
+            -- Verify the Period [ignore 1st edge]
+            CheckInfo.ObsTime := PeriodObs;
+            CheckInfo.ExpTime := Period;
+            IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN
+                IF (XOn) THEN Violation := 'X'; END IF;
+                IF (MsgOn) THEN
+                    CheckInfo.Violation := TRUE;
+                    CheckInfo.CheckKind := PeriodCheck;
+                    CheckInfo.DetTime   := NOW - TestDly;
+                    CheckInfo.State     := TestValue;
+                    ReportViolation (TestSignalName, "",
+                                     HeaderMsg, CheckInfo, MsgSeverity );
+                END IF; -- MsgOn
+            END IF;
+        END IF;
+
+        PeriodData.Last := TestValue;
+
+    END VitalPeriodPulseCheck;
+
+END VITAL_Timing;
+
diff --git a/lists.adb b/lists.adb
new file mode 100644
index 000000000..dffbdc87e
--- /dev/null
+++ b/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 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 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 : 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 : 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/lists.ads b/lists.ads
new file mode 100644
index 000000000..bf3a89e49
--- /dev/null
+++ b/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 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 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/name_table.adb b/name_table.adb
new file mode 100644
index 000000000..dd1f78f2c
--- /dev/null
+++ b/name_table.adb
@@ -0,0 +1,358 @@
+--  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 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 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;
+      Names_Table.Table (Null_Identifier) := (Length => 0,
+                                              Hash => 0,
+                                              Name => 0,
+                                              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/name_table.ads b/name_table.ads
new file mode 100644
index 000000000..5659a89a4
--- /dev/null
+++ b/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 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 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/nodes.adb b/nodes.adb
new file mode 100644
index 000000000..4537d6f64
--- /dev/null
+++ b/nodes.adb
@@ -0,0 +1,412 @@
+--  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 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;
+
+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;
+
+   Init_Short  : Node_Record (Format_Short);
+   Init_Medium : Node_Record (Format_Medium);
+   Init_Fp     : Node_Record (Format_Fp);
+   Init_Int    : Node_Record (Format_Int);
+
+   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 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_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).State3;
+   end Get_State3;
+
+   procedure Set_State3 (N : Node_Type; V : Bit2_Type) is
+   begin
+      Nodet.Table (N).State3 := V;
+   end Set_State3;
+
+   function Get_State4 (N : Node_Type) return Bit2_Type is
+   begin
+      return Nodet.Table (N).State4;
+   end Get_State4;
+
+   procedure Set_State4 (N : Node_Type; V : Bit2_Type) is
+   begin
+      Nodet.Table (N).State4 := 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).Odigit2;
+   end Get_Odigit2;
+
+   procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type) is
+   begin
+      Nodet.Table (N).Odigit2 := 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/nodes.ads b/nodes.ads
new file mode 100644
index 000000000..4fc3f1398
--- /dev/null
+++ b/nodes.ads
@@ -0,0 +1,862 @@
+--  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 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;
+
+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
+   --   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
+   --   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 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_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
+
+      --  Usages of Flag1:
+      --  seen_flag for iir_kind_process_statement
+      --  seen_flag for iir_kind_sensitized_process_statement
+      --  seen_flag for iir_kinds_procedure_specification
+      --  seen_flag for iir_kinds_function_specification
+      --  seen_flag for iir_kind_design_file
+      --  deferred_declaration_flag for iir_kind_constant_declaration
+      --  loaded_flag for iir_kind_design_unit
+      --  resolved_flag for iir_kinds_type_definition
+      --  need_body for iir_kind_package_declaration
+      --  whole_association_flag for iir_kind_association_element_by_expression
+      --  has_disconnect_flag for iir_kind_signal_declaration
+      Flag1 : Boolean := False;
+
+      --  Usages of Flag2:
+      --  pure_flag for iir_kinds_function_specification
+      --  passive_flag for iir_kinds_process_statement
+      --  shared_flag for iir_kind_variable_declaration
+      --  aggr_others_flag for iir_kind_aggregate_info
+      --  signal_type_flag for iir_kinds_type_definition
+      Flag2 : Boolean := False;
+
+      --  Usages of Flag3:
+      --  (postponed_flag for iir_kinds_process_statement)
+      --  elab_flag for iir_kind_design_file
+      --  elab_flag for iir_kind_design_unit
+      --  dynamic_flag for iir_kind_aggregate_info
+      --  text_file_flag for iir_kind_file_type_definition
+      --  foreign_flag for iir_kind_architecture_declaration
+      --  foreign_flag for iir_kinds_function_specification
+      --  foreign_flag for iir_kinds_procedure_specification
+      Flag3 : Boolean := False;
+
+      --  Usages of Flag4:
+      --  visible_flag for iir_kind_type_declaration
+      --  aggr_named_flag for iir_kind_aggregate_info
+      Flag4 : Boolean := False;
+
+      --  Usages of Flag5:
+      --  is_within_flag for named entities
+      Flag5 : Boolean := False;
+
+      --  Usages of Flag6:
+      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;
+
+      -- expr_staticness for iir_kind_string_literal
+      -- expr_staticness for iir_kind_bit_string_literal
+      -- expr_staticness for iir_kind_integer_literal
+      -- expr_staticness for iir_kind_floating_point_literal
+      -- expr_staticness for iir_kind_physical_int_literal
+      -- expr_staticness for iir_kind_physical_fp_literal
+      -- expr_staticness for iir_kind_enumeration_literal
+      -- expr_staticness for iir_kind_monadic_operator
+      -- expr_staticness for iir_kind_dyadic_operator
+      -- expr_staticness for iir_kinds_name
+      -- expr_staticness for iir_kinds_alias_declaration
+      -- expr_staticness for iir_kind_constant_declaration
+      -- expr_staticness for iir_kind_iterator_declaration
+      -- expr_staticness for iir_kind_constant_interface_declaration
+      -- expr_staticness for iir_kind_aggregate
+      -- expr_staticness for iir_kind_qualified_expression
+      -- expr_staticness for iir_kind_type_conversion
+      -- expr_staticness for iir_kind_length_array_attribute
+      -- expr_staticness for iir_kind_low_type_attribute
+      -- expr_staticness for iir_kind_high_type_attribute
+      -- expr_staticness for iir_kind_left_type_attribute
+      -- expr_staticness for iir_kind_right_type_attribute
+      -- expr_staticness for iir_kind_pos_attribute
+      -- expr_staticness for iir_kind_val_attribute
+      -- expr_staticness for iir_kind_event_attribute
+      -- expr_staticness for iir_kind_last_value_attribute
+      -- expr_staticness for iir_kind_last_active_attribute
+      -- expr_staticness for iir_kind_active_attribute
+      -- expr_staticness for iir_kind_range_expression
+      -- expr_staticness for iir_kind_selected_element
+      -- expr_staticness for iir_kind_function_call
+      -- expr_staticness for iir_kind_attribute_value
+      -- expr_staticness for iir_kind_signal_declaration
+      -- expr_staticness for iir_kind_guard_signal_declaration
+      -- expr_staticness for iir_kind_variable_declaration
+      -- expr_staticness for iir_kind_file_declaration
+      -- expr_staticness for iir_kinds_discrete_type_attribute
+      -- type_staticness for iir_kinds_type_and_subtype_definition
+      State1 : Bit2_Type := 0;
+
+      -- name_staticness for iir_kinds_name
+      -- name_staticness for iir_kind_object_alias_declaration
+      -- name_staticness for iir_kind_selected_element
+      -- name_staticness for iir_kind_selected_by_all_name
+      -- choice_staticness for iir_kind_choice_by_range
+      -- choice_staticness for iir_kind_choice_by_expression
+      State2 : Bit2_Type := 0;
+
+      --  Usages of State3:
+      --  purity_state for iir_kind_process_statement
+      --  purity_state for iir_kind_sensitized_process_statement
+      --  purity_state for iir_kinds_procedure_specification
+      --  purity_state for iir_kinds_function_specification
+      State3 : Bit2_Type := 0;
+
+      --  Usages of State4:
+      --  wait_state for iir_kind_process_statement
+      --  wait_state for iir_kind_sensitized_process_statement
+      --  wait_state for iir_kinds_procedure_specification
+      --  wait_state for iir_kinds_function_specification
+      State4 : Bit2_Type := 0;
+
+      --  2bits fields (4 -> 8 bits)
+      --  Usages of State5:
+      --  passive_state for iir_kind_process_statement
+      --  passive_state for iir_kind_sensitized_process_statement
+      --  passive_state for iir_kinds_procedure_specification
+      --  passive_state for iir_kinds_function_specification
+      --  signal_kind for iir_kind_signal_declaration
+      --  signal_kind for iir_kind_guard_signal_declaration
+      --  signal_kind for iir_kind_signal_interface_declaration
+      --  direction for iir_kind_range_expression
+      --  direction for iir_kind_file_declaration
+      --  guarded_target_flag for iir_kind_concurrent_conditional_signal_assign
+      --  guarded_target_flag for iir_kind_selected_conditional_signal_assign
+      --  guarded_target_flag for iir_kind_signal_assignment_statement
+      Unused_State5 : Bit2_Type := 0;
+
+      -- 3bits fields (1 -> 3 bits)
+      --  Usages of odigit1:
+      --  lexical_layout for iir_kinds_interface_declaration
+      Odigit1 : Bit3_Type := 0;
+
+      --  Usage of odigit2:
+      -- iir_mode for iir_kind_signal_interface_declaration
+      -- iir_mode for iir_kind_constant_interface_declaration
+      -- iir_mode for iir_kind_variable_interface_declaration
+      -- iir_mode for iir_kind_file_interface_declaration
+      Odigit2 : Bit3_Type := 0;
+
+      -- Location.
+      Location: Location_Type := Location_Nil;
+
+      --  The parent node.
+      -- parent for iir_kind_if_statement
+      -- parent for iir_kind_elsif_statement
+      -- parent for iir_kind_for_loop_statement
+      -- parent for iir_kind_while_loop_statement
+      -- parent for iir_kind_case_statement
+      -- parent for iir_kind_exit_statement
+      -- parent for iir_kind_next_statement
+      -- parent (library_declaration) for iir_kind_design_file
+      -- parent (design_unit_list) for iir_kind_design_file
+      -- interface_parent for iir_kind_signal_interface_declaration
+      -- interface_parent for iir_kind_constant_interface_declaration
+      -- interface_parent for iir_kind_variable_interface_declaration
+      -- interface_parent for iir_kind_file_interface_declaration
+      Field0 : Node_Type := Null_Node;
+
+      -- usages of field1:
+      -- type for iir_kind_character_literal
+      -- type for iir_kind_type_computed_literal
+      -- type for iir_kind_integer_literal
+      -- type for iir_kind_floating_point_literal
+      -- type for iir_type_declaration.
+      -- type for iir_subtype_declaration.
+      -- type for iir_kind_identifier
+      -- type for iir_kind_string_literal
+      -- type for iir_kind_bit_string_literal
+      -- type for iir_kind_base_attribute
+      -- list_element for iir_kinds_list
+      -- port_chain for iir_kind_entity_declaration
+      -- port_chain for iir_kind_component_declaration
+      -- port_chain for iir_kind_block_header
+      -- entity for iir_kind_architecture_declaration
+      -- entity for iir_kind_configuration_declaration
+      -- entity for iir_kind_entity_aspect_entity
+      -- package for iir_kind_package_body
+      -- primary_units(iir_library_unit_list) for iir_kind_library_declaration
+      -- selected_name for iir_kind_use_clause
+      -- type_declaration for iir_kinds_type_definition
+      -- type_definition for iir_kind_signal_declaration
+      -- type_definition for iir_kind_guard_signal_declaration
+      -- type_definition for iir_kind_signal_interface_declaration.
+      -- type_definition for iir_kind_variable_declaration
+      -- type_definition for iir_kind_variable_interface_declaration.
+      -- type_definition for iir_kind_constant_declaration
+      -- type_definition for iir_kind_iterator_declaration
+      -- type_definition for iir_kind_constant_interface_declaration.
+      -- type_definition for iir_kind_file_declaration
+      -- type_definition for iir_kind_file_interface_declaration.
+      -- type_definition for iir_kind_enumeration_literal
+      -- type_definition for iir_kind_unit_declaration
+      -- type_definition for iir_kind_component_port
+      -- type_definition for iir_kind_element_declaration
+      -- type_definition for iir_kinds_attribute_declaration
+      -- type_definition for iir_kinds_attribute
+      -- type_definition for iir_kinds_name
+      -- type_definition for iir_kind_return_statement
+      -- type_definition for iir_kind_aggregate
+      -- type_definition for iir_kind_physical_int_literal
+      -- type_definition for iir_kind_physical_fp_literal
+      -- type_definition for iir_kind_object_alias_declaration
+      -- type_definition for iir_kind_null_literal
+      -- type_definition for iir_kind_qualified_expression
+      -- type_definition for iir_kind_type_conversion
+      -- type_definition for iir_kind_function_call
+      -- type_definition for iir_kind_allocator_by_expression
+      -- type_definition for iir_kind_allocator_by_subtype
+      -- type_definition for iir_kind_attribute_value
+      -- type_definition for iir_kind_selected_element
+      -- type_definition for iir_kind_implicit_dereference.
+      -- type_definition for iir_kind_disconnection_specification
+      -- type_definition for iir_kinds_monadic_operator
+      -- type_definition for iir_kinds_dyadic_operator
+      -- null_iir for iir_kind_signal_assignment_statement
+      -- null_iir for iir_kind_variable_assignment_statement
+      -- we_value for iir_kind_waveform_element
+      -- condition for iir_kind_conditional_waveform
+      -- condition for iir_kind_if_statement
+      -- condition for iir_kind_elsif
+      -- condition for iir_kind_while_loop_statement
+      -- condition for iir_kind_next_statement
+      -- condition for iir_kind_exit_statement
+      -- design_unit_chain for iir_kind_design_file
+      -- formal for iir_kinds_association_element
+      -- iterator_scheme for iir_kind_for_loop_statement
+      -- associated for iir_kinds_association_by_choice
+      -- context_items for iir_kind_design_unit
+      -- design_file_chain for iir_kind_library_declaration
+      -- proxy for iir_kind_proxy
+      -- selected_waveform_l for iir_kind_concurrent_selected_signal_assignment
+      -- block_specification for iir_kind_block_configuration
+      -- instantiation_list for iir_kind_component_configuration
+      -- instantiation_list for iir_kind_configuration_specification
+      -- component_configuration for iir_kind_component_instantiation_statement
+      -- configuration for iir_kind_entity_aspect_configuration
+      -- guard_decl for iir_kind_block_statement
+      -- entity_class_entry_chain for iir_kind_group_template_declaration
+      -- group_constituent_chain for iir_kind_group_declaration
+      -- entity_name_list for iir_kind_attribute_specification
+      -- generate_block_configuration for iir_kind_generate_statement
+      -- type_declarator for Iir_Kind_Enumeration_Type_Definition
+      -- type_declarator for Iir_Kind_Enumeration_Subtype_Definition
+      -- type_declarator for Iir_Kind_Integer_Type_Definition
+      -- type_declarator for Iir_Kind_Integer_Subtype_Definition
+      -- type_declarator for Iir_Kind_Floating_Type_Definition
+      -- type_declarator for Iir_Kind_Floating_Subtype_Definition
+      -- type_declarator for Iir_Kind_Physical_Type_Definition
+      -- type_declarator for Iir_Kind_Physical_Subtype_Definition
+      -- type_declarator for Iir_Kind_Record_Type_Definition
+      -- type_declarator for Iir_Kind_Record_Subtype_Definition
+      -- type_declarator for Iir_Kind_Array_Type_Definition
+      -- type_declarator for Iir_Kind_Array_Subtype_Definition
+      -- type_declarator for Iir_Kind_Unconstrained_Array_Subtype_Definition
+      -- type_declarator for Iir_Kind_Access_Type_Definition
+      -- type_declarator for Iir_Kind_Access_Subtype_Definition
+      -- type_declarator for Iir_Kind_Incomplete_Type_Definition
+      -- type_declarator for Iir_Kind_File_Type_Definition
+      -- return_type for iir_kind_function_specification
+      -- return_type for iir_kind_function_spec_body
+      -- return_type for iir_kind_implicit_function_declaration
+      -- default_entity_aspect for iir_kind_binding_indication
+      -- sub_aggregate_info for iir_kind_aggregate_info
+      Field1: Node_Type := Null_Node;
+
+      -- usages of field2:
+      -- concurrent_statement_list for iir_kind_architecture_declaration
+      -- concurrent_statement_list for iir_kind_block_statement
+      -- concurrent_statement_list for iir_kind_entity_declaration
+      -- concurrent_statement_list for iir_kind_generate_statement
+      -- block_configuration for iir_kind_configuration_declaration
+      -- block_configuration for iir_kind_component_configuration
+      -- subprogram_body for iir_kind_function_specification
+      -- subprogram_body for iir_kind_procedure_specification
+      -- range_constraint for iir_kind_integer_subtype_definition
+      -- range_constraint for iir_kind_floating_subtype_definition
+      -- range_constraint for iir_kind_subtype_definition
+      -- range_constraint for iir_kind_enumeration_subtype_definition
+      -- range_constraint for iir_kind_physical_subtype_definition
+      -- range_constraint for iir_kind_enumeration_type_definition
+      -- left_limit for iir_kind_range_expression
+      -- designated_type for iir_kind_access_type_definition
+      -- index_subtype for iir_array_type_definition
+      -- index_subtype for iir_array_subtype_definition
+      -- suffix for iir_kinds_attribute
+      -- suffix for iir_kind_user_attribute
+      -- suffix for iir_kind_slice_name
+      -- selected_element for iir_kind_selected_element
+      -- parameter for iir_kind_val_attribute
+      -- parameter for iir_kind_pos_attribute
+      -- parameter for iir_kind_delayed_attribute
+      -- parameter for iir_kind_stable_attribute
+      -- parameter for iir_kind_quiet_attribute
+      -- parameter for iir_kind_attribute
+      -- index_list for iir_kind_indexed_name
+      -- index_list for iir_kind_array_type_definition
+      -- index_list for iir_kind_array_subtype_definition
+      -- target for iir_kind_signal_assignment_statement
+      -- target for iir_kind_variable_assignment_statement
+      -- time for iir_kind_waveform_element
+      -- target for iir_kind_concurrent_conditional_signal_assignment
+      -- target for iir_kind_concurrent_selected_signal_assignment
+      -- assertion_condition for iir_kind_concurrent_assertion_statement
+      -- assertion_condition for iir_kind_assertion_statement
+      -- null_iir for iir_kind_conditional_waveform
+      -- sequential_statement_chain for iir_kind_if_statement
+      -- sequential_statement_chain for iir_kind_elsif
+      -- sequential_statement_chain for iir_kind_sensitized_process_statement
+      -- sequential_statement_chain for iir_kind_process_statement
+      -- sequential_statement_chain for iir_kind_for_loop_statement
+      -- sequential_statement_chain for iir_kind_while_loop_statement
+      -- sequential_statement_chain for iir_kind_function_Body
+      -- sequential_statement_chain for iir_kind_function_Spec_Body
+      -- sequential_statement_chain for iir_kind_procedure_Body
+      -- sequential_statement_chain for iir_kind_procedure_Spec_Body
+      -- name for iir_kind_object_alias_declaration
+      -- name for iir_kind_physical_int_literal
+      -- name for iir_kind_physical_fp_literal
+      -- name for iir_kind_association_choice_by_name
+      -- name for iir_kind_group_declaration
+      -- default_value for iir_kind_signal_declaration
+      -- default_value for iir_kind_guard_signal_declaration
+      -- default_value for iir_kind_variable_declaration
+      -- default_value for iir_kind_constant_declaration
+      -- default_value for iir_kind_signal_interface_declaration
+      -- default_value for iir_kind_variable_interface_declaration
+      -- default_value for iir_kind_constant_interface_declaration
+      -- default_value for iir_kind_file_interface_declaration
+      -- guard_expression for iir_kind_guard_signal_declaration
+      -- operand for iir_kinds_monadic_operator
+      -- left for iir_kinds_dyadic_operator
+      -- actual for iir_kind_association_element_by_expression
+      -- instantiated_unit for Iir_Kind_Component_Instantiation_Statement
+      -- parameter_association_chain for iir_kind_function_call
+      -- parameter_association_chain for iir_kind_procedure_call
+      -- parameter_association_chain for iir_kind_concurrent_procedure_call_st.
+      -- library_unit for iir_kind_design_unit
+      -- multiplier for iir_kind_unit_declaration
+      -- primary_unit for iir_kind_physical_type_definition
+      -- condition_clause for iir_kind_wait_statement
+      -- element_declaration_list for iir_kind_record_type_definition
+      -- loop for iir_kind_exit_statement
+      -- loop for iir_kind_next_statement
+      -- file_logical_name for iir_kind_file_declaration
+      -- configuration_item_chain for iir_kind_block_configuration
+      -- architecture for iir_kind_entity_aspect_entity
+      -- library_declaration for iir_kind_library_clause
+      -- attribute_designator for iir_kind_attribute_specification
+      -- attribute_specification for iir_kind_attribute_value
+      -- signal_list for iir_kind_disconnection_specification
+      -- generation_scheme for iir_kind_generate_statement
+      -- incomplete_type_List for iir_kind_incomplete_type_definition
+      -- file_time_stamp for iir_kind_design_file
+      -- default_generic_map_aspect_list for iir_kind_binding_indication
+      -- aggr_low_limit for iir_kind_aggregate_info
+      -- enumeration_decl for iir_kind_enumeration_literal
+      -- simple_aggregate_list for iir_kind_simple_aggregate
+      Field2: Node_Type := Null_Node;
+
+      -- Usages of field3:
+      -- dependence_list for iir_kind_design_unit
+      -- block_statement for iir_kind_signal_declaration
+      -- block_statement for iir_kind_guard_signal_declaration
+      -- subprogram_declaration for iir_kind_function_Spec_Body
+      -- subprogram_declaration for iir_kind_function_Body
+      -- subprogram_declaration for iir_kind_Procedure_Spec_Body
+      -- subprogram_declaration for iir_kind_Procedure_Body
+      -- body for iir_kind_function_specification
+      -- body for iir_kind_procedure_specification
+      -- declaration_list for iir_kind_entity_declaration
+      -- declaration_list for iir_kind_architecture_declaration
+      -- declaration_list for iir_kind_configuration_declaration
+      -- declaration_list for iir_kind_block_statement
+      -- declaration_list for iir_kind_package_declaration
+      -- declaration_list for iir_kind_package_body
+      -- declaration_list for iir_kind_sensitized_process_statement
+      -- declaration_list for iir_kind_process_statement
+      -- declaration_list for iir_kind_block_configuration
+      -- declaration_list for iir_kind_generate_statement
+      -- enumeration_literal_list for iir_enumeration_type_definition
+      -- right_limit for iir_kind_range_expression
+      -- element_subtype for iir_array_type_definition
+      -- element_subtype for iir_array_subtype_definition
+      -- report_expression for iir_kind_concurrent_assertion_statement
+      -- report_expression for iir_kind_assertion_statement
+      -- report_expression for iir_kind_report_statement
+      -- waveform_chain for iir_kind_signal_assignment_statement
+      -- conditional_waveform_chain for iir_kind_conc_conditional_signal_assign
+      -- waveform_chain for iir_kind_conditional_waveform
+      -- else_clause for iir_kind_if_statement
+      -- else_clause for iir_kind_elsif
+      -- expression of iir_kind_concurrent_selected_signal_assignment
+      -- expression of iir_kind_variable_assignment_statement
+      -- prefix for iir_kinds_attribute
+      -- prefix for iir_kind_indexed_name
+      -- prefix for iir_kind_slice_name
+      -- prefix for iir_kind_selected_name
+      -- prefix for iir_kind_selected_by_all_name
+      -- prefix for iir_kind_parenthesis_name
+      -- prefix for iir_kind_selected_element
+      -- prefix for iir_kind_implicit_dereference
+      -- port_map_aspect for Iir_Kind_Component_Instantiation_Statement
+      -- port_map_aspect for Iir_Kind_binding_indication
+      -- port_map_aspect for Iir_Kind_block_header
+      -- binding_indication for iir_kind_Component_configuration
+      -- binding_indication for Iir_Kind_Configuration_specifiation
+      -- expression for iir_kind_return_statement
+      -- expression for iir_kind_association_choice_by_expression
+      -- expression for iir_kind_case_statement
+      -- expression for iir_kind_qualified_expression
+      -- expression for iir_kind_type_conversion
+      -- expression for iir_kind_allocator_by_expression
+      -- expression for iir_kind_allocator_by_subtype
+      -- expression for iir_kind_attribute_specification
+      -- expression for iir_kind_disconnection_specification
+      -- unit_chain for iir_kind_physical_type_definition
+      -- timeout_clause for iir_kind_wait_statement
+      -- file_open_kind for iir_kind_file_declaration
+      -- designated_entity for iir_kind_attribute_value
+      -- associated_formal for iir_kinds_association_element
+      -- deferred_declaration for iir_kind_constant_declaration
+      -- literal_origin for iir_kind_character_literal
+      -- literal_origin for iir_kind_string_literal
+      -- literal_origin for iir_kind_bit_string_literal
+      -- literal_origin for iir_kind_integer_literal
+      -- literal_origin for iir_kind_floating_point_literal
+      -- literal_origin for iir_kind_physical_int_literal
+      -- literal_origin for iir_kind_physical_fp_literal
+      -- literal_origin for iir_kind_enumeration_literal
+      -- analysis_time_stamp for iir_kind_design_file
+      -- aggr_high_limit for iir_kind_aggregate_info
+      -- aggregate_info for iir_kind_aggregate
+      -- implementation for iir_kind_function_call
+      -- implementation for iir_kind_procedure_call
+      -- implementation for iir_kind_concurrent_procedure_call_statement
+      -- implementation for iir_kind_dyadic_operator
+      -- implementation for iir_kind_monadic_operator
+      Field3: Node_Type := Null_Node;
+
+      -- Usages of field4:
+      -- design_file for iir_kind_design_unit
+      -- generic_chain for iir_kind_entity_declaration
+      -- generic_chain for iir_kind_component_declaration
+      -- generic_chain for iir_kind_block_header
+      -- base_type for iir_kind_integer_type_definition
+      -- base_type for iir_kind_integer_subtype_definition
+      -- base_type for iir_kind_floating_type_definition
+      -- base_type for iir_kind_floating_subtype_definition
+      -- base_type for iir_kind_subtype_definition
+      -- base_type for iir_kind_enumeration_type_definition
+      -- base_type for iir_kind_enumeration_subtype_definition
+      -- base_type for iir_kind_array_type_definition
+      -- base_type for iir_kind_array_subtype_definition
+      -- base_type for iir_kind_unconstrained_array_subtype_definition
+      -- base_type for iir_kind_range_attribute
+      -- base_type for iir_kind_physical_type_definition
+      -- base_type for iir_kind_physical_subtype_definition
+      -- base_type for iir_kind_record_type_definition
+      -- base_type for iir_kind_record_subtype_definition
+      -- base_type for iir_kind_access_type_definition
+      -- base_type for iir_kind_access_subtype_definition
+      -- base_type for iir_kind_incomplete_type_definition
+      -- base_type for iir_kind_file_type_definition
+      -- severity_expression for iir_kind_concurrent_assertion_statement
+      -- severity_expression for iir_kind_assertion_statement
+      -- severity_expression for iir_kind_report_statement
+      -- sensitivity_list for iir_kind_sensitized_process_statement
+      -- sensitivity_list for iir_kind_wait_statement
+      -- name_value of iir_kind_simple_name
+      -- association_chain for iir_kind_association_element_by_individual
+      -- association_chain for iir_kind_parenthesis_name
+      -- association_choices_list for iir_kind_aggregate
+      -- association_choices_list for iir_kind_case_statement
+      -- guard for iir_kind_concurrent_conditional_signal_assignment
+      -- guard for iir_kind_concurrent_selected_signal_assignment
+      -- entity_aspect for iir_kind_binding_indication
+      -- default_binding_indicat for iir_kind_component_instantiation_statement
+      -- component_name for iir_kind_component_configuration
+      -- component_name for iir_kind_configuration_specification
+      -- prev_block_configuration for iir_kind_block_configuration
+      -- interface_declaration for iir_kind_function_Specification
+      -- interface_declaration for iir_kind_function_Spec_Body
+      -- interface_declaration for iir_kind_procedure_Specification
+      -- interface_declaration for iir_kind_procedure_Spec_Body
+      -- interface_declaration for iir_kind_implicit_function_declaration
+      -- interface_declaration for iir_kind_implicit_procedure_declaration
+      -- subprogram_specification for iir_kind_function_Body
+      -- subprogram_specification for iir_kind_procedure_Body
+      -- in_conversion for iir_kind_association_element_by_expression
+      -- default_configuration for iir_kind_architecture_declaration
+      -- bit_string_0 for iir_kind_bit_string_literal
+      -- base_name for iir_kind_object_alias_declaration
+      -- base_name for iir_kind_signal_declaration
+      -- base_name for iir_kind_guard_signal_declaration
+      -- base_name for iir_kind_variable_declaration
+      -- base_name for iir_kind_file_declaration
+      -- base_name for iir_kind_constant_declaration
+      -- base_name for iir_kind_iterator_declaration
+      -- base_name for iir_kind_slice_name
+      -- base_name for iir_kind_indexed_name
+      -- base_name for iir_kind_selected_element
+      -- base_name for iir_kind_selected_by_all_name
+      -- base_name for iir_kind_implicit_dereference
+      -- base_name for iir_kind_attribute_value
+      -- base_name for iir_kind_function_call
+      -- block_block_configuration for iir_kind_block_statement
+      -- right for iir_kinds_dyadic_operator
+      --Field4: Node_Type := Null_Node;
+
+      -- Usages of field5 (aka nbr1).
+      -- driver_list for iir_kind_sensitized_process_statement
+      -- driver_list for iir_kind_process_statement
+      -- driver_list for iir_kinds_function_specification
+      -- driver_list for iir_kinds_procedure_specification
+      -- guard_sensitivity_list for iir_kind_guard_signal_declaration
+      -- signal_driver for iir_kind_signal_declaration
+      -- reject_time for iir_kind_concurrent_selected_signal_assignment
+      -- reject_time for iir_kind_concurrent_conditionnal_signal_assignment
+      -- reject_time for iir_kind_signal_assignment_statement
+      -- resolution_function for iir_kind_integer_subtype_definition
+      -- resolution_function for iir_kind_floating_subtype_definition
+      -- resolution_function for iir_kind_enumeration_subtype_definition
+      -- resolution_function for iir_kind_physical_subtype_definition
+      -- resolution_function for iir_kind_array_subtype_definition
+      -- resolution_function for iir_kind_unconstrained_array_subtype_definit.
+      -- resolution_function for iir_kind_record_subtype_definition
+      -- date for iir_kind_library_declaration
+      -- date for iir_kind_design_unit
+      -- generic_map_aspect for Iir_Kind_Component_Instantiation_Statement
+      -- generic_map_aspect for Iir_Kind_block_header
+      -- generic_map_aspect for Iir_Kind_binding_indication
+      -- generation_scheme for iir_kind_generate_statement
+      -- design_unit for iir_kind_constant_declaration
+      -- design_unit for iir_kind_entity_declaration
+      -- design_unit for iir_kind_configuration_declaration
+      -- design_unit for iir_kind_package_declaration
+      -- design_unit for iir_kind_body_declaration
+      -- design_unit for iir_kind_architecture_declaration
+      -- out_conversion for iir_kind_association_element_by_expression
+      -- bit_string_1 for iir_kind_bit_string_literal
+      --Field5: Node_Type := Null_Node;
+
+      -- Usages of Field6:
+      -- offset for iir_kind_design_unit
+      -- number of element for iir_kinds_list
+      -- base for iir_kind_bit_string_literal
+      -- element_position for iir_kind_element_declaration
+      -- type_mark for iir_kind_qualified_expression
+      -- type_mark for iir_kind_file_type_definition
+      -- type_mark for iir_kind_integer_subtype_definition
+      -- type_mark for iir_kind_floating_subtype_definition
+      -- type_mark for iir_kind_enumeration_subtype_definition
+      -- type_mark for iir_kind_physical_subtype_definition
+      -- type_mark for iir_kind_access_subtype_definition
+      -- type_mark for iir_kind_record_subtype_definition
+      -- type_mark for iir_kind_unconstrained_array_subtype_definition
+      -- bit_string_base for iir_kind_bit_string_literal
+      -- default_port_map_aspect_list for iir_kind_binding_indication
+
+      -- Usages of nbr3/field7:
+      -- line for iir_kind_design_unit
+      -- max number of elements for iir_kinds_list
+      -- implicit_definition for iir_kind_implicit_function_declaration
+      -- implicit_definition for iir_kind_implicit_procedure_declaration
+      -- block_header for iir_kind_block_statement
+      -- delay_mechanism for iir_kind_concurrent_selected_signal_assignment
+      -- delay_mechanism for iir_kind_concurrent_conditionnal_signal_assignment
+      -- delay_mechanism for iir_kind_signal_assignment_statement
+      -- value for iir_kind_integer_literal
+      -- value for iir_kind_enumeration_literal
+      -- value for iir_kind_unit_declaration
+      -- value for iir_kind_physical_int_literal
+      -- fp_value for iir_kind_physical_fp_literal
+      -- fp_value for iir_kind_floating_point_literal
+      -- entity_kind for iir_kind_entity_class
+      -- entity_kind for iir_kind_attribute_specification
+      -- callees_list for iir_kind_process_declaration
+      -- callees_list for iir_kind_sensitized_process_declaration
+      -- library_directory for iir_kind_library_declaration
+      -- filename for iir_kind_design_file
+      -- directory for iir_kind_design_file
+      -- aggr_max_length for iir_kind_aggregate_info
+      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/ortho/Makefile.inc b/ortho/Makefile.inc
new file mode 100644
index 000000000..683600017
--- /dev/null
+++ b/ortho/Makefile.inc
@@ -0,0 +1,41 @@
+#  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_BASENAME).ads: $(ortho_srcdir)/ortho_nodes.common.ads \
+  $(ORTHO_BASENAME).private.ads
+	$(SED) -e '/^package/,$$d' \
+	  < $(ORTHO_BASENAME).private.ads \
+	  > tmp.prv.hdr
+	$(SED) -e '1,/^private/d' -e '/^end/d' \
+	  < $(ORTHO_BASENAME).private.ads \
+	  > tmp.prv.dcl
+	$(SED) -e '1,/^package/d' -e '/^private/,$$d' \
+	  < $(ORTHO_BASENAME).private.ads \
+	  > tmp.prv.pub
+	$(SED) \
+	  -e '/^   --- PRIVATE/r tmp.prv.dcl' \
+	  -e '/^--- PRIVATE CONTEXT CLAUSES/r tmp.prv.hdr' \
+	  -e '/^   --- PUBLIC DECLARATIONS/r tmp.prv.pub' \
+	  -e '/--- PRIVATE/d' \
+	  -e 's/ORTHO_NODES/$(ORTHO_PACKAGE)/g' < $< > $@
+	$(RM) -f tmp.prv.dcl tmp.prv.hdr tmp.prv.pub
+
diff --git a/ortho/agcc/Makefile.inc b/ortho/agcc/Makefile.inc
new file mode 100644
index 000000000..b5da6f088
--- /dev/null
+++ b/ortho/agcc/Makefile.inc
@@ -0,0 +1,112 @@
+#  -*- Makefile -*- for agcc, the Ada binding for GCC internals.
+#  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 used:
+# AGCC_GCCSRC_DIR: the gcc source base directory (ie gcc-X.Y.Z-objs/)
+# AGCC_GCCOBJ_DIR: the gcc objects base directory
+# agcc_srcdir: the agcc source directory
+# agcc_objdir: the agcc object directory
+
+AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \
+ -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config
+AGCC_CFLAGS=-g -DIN_GCC $(AGCC_INC_FLAGS)
+
+AGCC_LOCAL_OBJS=agcc-bindings.o agcc-version.o
+
+AGCC_DEPS := $(agcc_srcdir)/agcc-trees.ads \
+  $(agcc_srcdir)/agcc-hwint.ads \
+  $(agcc_srcdir)/agcc-hconfig.ads \
+  $(agcc_srcdir)/agcc-real.ads \
+  $(agcc_srcdir)/agcc-machmode.ads \
+  $(agcc_srcdir)/agcc-tm.ads \
+  $(agcc_srcdir)/agcc-options.ads \
+  $(AGCC_LOCAL_OBJS)
+AGCC_OBJS := $(AGCC_LOCAL_OBJS) \
+	$(AGCC_GCCOBJ_DIR)/gcc/toplev.o \
+	$(AGCC_GCCOBJ_DIR)/gcc/c-convert.o \
+	$(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \
+	$(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a
+
+# Set rights to prevent editing.
+GENERATE_VIA_GEN_TREE=\
+  $(RM) -f $@ && \
+  $(agcc_objdir)/gen_tree -C $(AGCC_GCCOBJ_DIR)/gcc - < $< > $@ && \
+  chmod a-w $@
+
+$(agcc_srcdir)/agcc-trees.ads: $(agcc_srcdir)/agcc-trees.ads.in \
+   $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-hwint.ads: $(agcc_srcdir)/agcc-hwint.ads.in \
+   $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-hconfig.ads: $(agcc_srcdir)/agcc-hconfig.ads.in \
+   $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-real.ads: $(agcc_srcdir)/agcc-real.ads.in \
+   $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-machmode.ads: $(agcc_srcdir)/agcc-machmode.ads.in \
+   $(agcc_objdir)/gen_tree \
+   $(AGCC_GCCOBJ_DIR)/gcc/insn-modes.h
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-tm.ads: $(agcc_srcdir)/agcc-tm.ads.in \
+ $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-options.ads: $(agcc_srcdir)/agcc-options.ads.in \
+ $(agcc_objdir)/gen_tree \
+ $(AGCC_GCCOBJ_DIR)/gcc/options.h
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_objdir)/gen_tree: $(agcc_objdir)/gen_tree.o
+	$(CC) -o $@ $<
+
+$(agcc_objdir)/gen_tree.o: $(agcc_srcdir)/gen_tree.c \
+  $(AGCC_GCCSRC_DIR)/gcc/tree.def $(AGCC_GCCSRC_DIR)/gcc/tree.h \
+  $(AGCC_GCCOBJ_DIR)/gcc/tree-check.h
+	$(CC) -c -o $@ $< $(AGCC_CFLAGS)
+
+agcc-bindings.o: $(agcc_srcdir)/agcc-bindings.c \
+ $(AGCC_GCCOBJ_DIR)/gcc/gtype-vhdl.h \
+ $(AGCC_GCCOBJ_DIR)/gcc/gt-vhdl-agcc-bindings.h
+	$(CC) -c -o $@ $< $(AGCC_CFLAGS)
+
+agcc-version.c: $(AGCC_GCCSRC_DIR)/gcc/version.c
+	-$(RM) -f $@
+	echo '#include "version.h"' > $@
+	sed  -n -e '/version_string/ s/";/ (ghdl)";/p' < $< >> $@
+	echo 'const char bug_report_url[] = "<URL:mailto:ghdl@free.fr>";' >> $@
+
+agcc-version.o: agcc-version.c
+	$(CC) -c -o $@ $< $(AGCC_CFLAGS)
+
+agcc-clean: force
+	$(RM) -f $(agcc_objdir)/gen_tree $(agcc_objdir)/gen_tree.o
+	$(RM) -f $(agcc_objdir)/*.o
+	$(RM) -f $(agcc_srcdir)/*~
+
+agcc-maintainer-clean: force
+	$(RM) -f $(AGCC_DEPS)
+
+
+.PHONY: agcc-clean agcc-maintainer-clean
diff --git a/ortho/agcc/agcc-autils.adb b/ortho/agcc/agcc-autils.adb
new file mode 100644
index 000000000..30eb1e622
--- /dev/null
+++ b/ortho/agcc/agcc-autils.adb
@@ -0,0 +1,93 @@
+--  Ada bindings for GCC internals.
+--  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.Unchecked_Conversion;
+with Agcc.Hconfig; use Agcc.Hconfig;
+with Agcc.Machmode; use Agcc.Machmode;
+
+package body Agcc.Autils is
+   Arr_Len : constant Natural := Unsigned_64'Size / HOST_WIDE_INT'Size;
+   type Arr_Conv is array (Natural range 0 .. Arr_Len - 1) of HOST_WIDE_INT;
+
+   subtype Assert_Type is Boolean range True .. True;
+   Assert_Arr_Len_Is_1_Or_2 : constant Assert_Type :=
+     Arr_Len = 1 or Arr_Len = 2;
+   pragma Unreferenced (Assert_Arr_Len_Is_1_Or_2);
+
+   procedure To_Host_Wide_Int (V : Unsigned_64; L, H : out HOST_WIDE_INT) is
+      function Unchecked_Conversion is new Ada.Unchecked_Conversion
+        (Source => Unsigned_64, Target => Arr_Conv);
+      Res : Arr_Conv;
+   begin
+      Res := Unchecked_Conversion (V);
+      if Arr_Len = 1 then
+         H := 0;
+         L := Res (0);
+      else
+         if HOST_WORDS_BIG_ENDIAN then
+            L := Res (1);
+            H := Res (0);
+         else
+            L := Res (0);
+            H := Res (1);
+         end if;
+      end if;
+   end To_Host_Wide_Int;
+
+   procedure To_Host_Wide_Int (V : Integer_64; L, H : out HOST_WIDE_INT) is
+      function Unchecked_Conversion is new Ada.Unchecked_Conversion
+        (Source => Integer_64, Target => Arr_Conv);
+      Res : Arr_Conv;
+   begin
+      Res := Unchecked_Conversion (V);
+      if Arr_Len = 1 then
+         if V < 0 then
+            H := -1;
+         else
+            H := 0;
+         end if;
+         L := Res (0);
+      else
+         if HOST_WORDS_BIG_ENDIAN then
+            L := Res (1);
+            H := Res (0);
+         else
+            L := Res (0);
+            H := Res (1);
+         end if;
+      end if;
+   end To_Host_Wide_Int;
+
+   function To_Real_Value_Type (V : IEEE_Float_64) return REAL_VALUE_TYPE
+   is
+      Mant_Size : constant Natural := 60;
+      Rfract : IEEE_Float_64;
+      Fract : Integer_64;
+      Exp : Integer;
+      L, H : HOST_WIDE_INT;
+      Mantisse : REAL_VALUE_TYPE;
+   begin
+      --  Note: this works only when REAL_ARITHMETIC is defined!!!
+      Exp := IEEE_Float_64'Exponent (V);
+      Rfract := IEEE_Float_64'Fraction (V);
+      Rfract := IEEE_Float_64'Scaling (Rfract, Mant_Size);
+      Fract := Integer_64 (Rfract);
+      To_Host_Wide_Int (Fract, L, H);
+      REAL_VALUE_FROM_INT (Mantisse'Address, L, H, DFmode);
+      return REAL_VALUE_LDEXP (Mantisse, Exp - Mant_Size);
+   end To_Real_Value_Type;
+end Agcc.Autils;
diff --git a/ortho/agcc/agcc-autils.ads b/ortho/agcc/agcc-autils.ads
new file mode 100644
index 000000000..8ca7da446
--- /dev/null
+++ b/ortho/agcc/agcc-autils.ads
@@ -0,0 +1,28 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Real; use Agcc.Real;
+with Interfaces; use Interfaces;
+
+--  Additional utils.
+package Agcc.Autils is
+   procedure To_Host_Wide_Int (V : Unsigned_64; L, H : out HOST_WIDE_INT);
+   procedure To_Host_Wide_Int (V : Integer_64; L, H : out HOST_WIDE_INT);
+   function To_Real_Value_Type (V : IEEE_Float_64) return REAL_VALUE_TYPE;
+end Agcc.Autils;
+
diff --git a/ortho/agcc/agcc-bindings.c b/ortho/agcc/agcc-bindings.c
new file mode 100644
index 000000000..2dbe33b21
--- /dev/null
+++ b/ortho/agcc/agcc-bindings.c
@@ -0,0 +1,738 @@
+/*  Ada bindings for GCC internals - Bindings for 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.
+*/
+#include <stddef.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 "real.h"
+#include "toplev.h"
+
+enum tree_code
+get_tree_code (tree t)
+{
+  return TREE_CODE (t);
+}
+
+void
+set_tree_constant (tree t, int flag)
+{
+  TREE_CONSTANT (t) = flag;
+}
+
+int
+get_tree_constant (tree t)
+{
+  return TREE_CONSTANT (t);
+}
+
+void
+set_tree_public (tree t, int flag)
+{
+  TREE_PUBLIC (t) = flag;
+}
+
+void
+set_tree_static (tree t, int flag)
+{
+  TREE_STATIC (t) = flag;
+}
+
+void
+set_tree_type (tree t, tree val)
+{
+  TREE_TYPE (t) = val;
+}
+
+tree
+get_tree_type (tree t)
+{
+  return TREE_TYPE (t);
+}
+
+void
+set_tree_chain (tree t, tree chain)
+{
+  TREE_CHAIN (t) = chain;
+}
+
+tree
+get_tree_chain (tree t)
+{
+  return TREE_CHAIN (t);
+}
+
+void
+set_tree_unsigned (tree t, int flag)
+{
+  TREE_UNSIGNED (t) = flag;
+}
+
+int
+get_tree_unsigned (tree t)
+{
+  return TREE_UNSIGNED (t);
+}
+
+void
+set_tree_addressable (tree t, int flag)
+{
+  TREE_ADDRESSABLE (t) = flag;
+}
+
+int
+get_tree_addressable (tree t)
+{
+  return TREE_ADDRESSABLE (t);
+}
+
+void
+set_tree_side_effects (tree t, int flag)
+{
+  TREE_SIDE_EFFECTS (t) = flag;
+}
+
+void
+set_tree_readonly (tree t, int flag)
+{
+  TREE_READONLY (t) = flag;
+}
+
+void
+set_tree_operand (tree t, unsigned int n, tree val)
+{
+  TREE_OPERAND (t, n) = val;
+}
+
+tree
+get_tree_operand (tree t, unsigned int n)
+{
+  return TREE_OPERAND (t, n);
+}
+
+int
+get_tree_this_volatile (tree t)
+{
+  return TREE_THIS_VOLATILE (t);
+}
+
+int
+set_tree_this_volatile (tree t, int val)
+{
+  TREE_THIS_VOLATILE (t) = val;
+}
+
+tree
+get_tree_purpose (tree l)
+{
+  return TREE_PURPOSE (l);
+}
+
+tree
+get_tree_value (tree l)
+{
+  return TREE_VALUE (l);
+}
+
+int
+get_tree_used (tree n)
+{
+  return TREE_USED (n);
+}
+
+void
+set_tree_used (tree n, int flag)
+{
+  TREE_USED (n) = flag;
+}
+
+HOST_WIDE_INT
+get_tree_int_cst_low (tree node)
+{
+  return TREE_INT_CST_LOW (node);
+}
+
+HOST_WIDE_INT
+get_tree_int_cst_high (tree node)
+{
+  return TREE_INT_CST_HIGH (node);
+}
+
+tree
+get_constructor_elts (tree c)
+{
+  return CONSTRUCTOR_ELTS (c);
+}
+
+tree
+(build_int_2) (HOST_WIDE_INT lo, HOST_WIDE_INT hi)
+{
+  return build_int_2 (lo, hi);
+}
+
+void
+set_decl_arg_type (tree decl, tree val)
+{
+  DECL_ARG_TYPE (decl) = val;
+}
+
+void
+set_decl_external (tree decl, int val)
+{
+  DECL_EXTERNAL (decl) = val;
+}
+
+int
+get_decl_external (tree decl)
+{
+  return DECL_EXTERNAL (decl);
+}
+
+void
+set_decl_arguments (tree decl, tree args)
+{
+  DECL_ARGUMENTS (decl) = args;
+}
+
+tree
+get_decl_arguments (tree decl)
+{
+  return DECL_ARGUMENTS (decl);
+}
+
+void
+set_decl_result (tree decl, tree res)
+{
+  DECL_RESULT (decl) = res;
+}
+
+tree
+get_decl_result (tree decl)
+{
+  return DECL_RESULT (decl);
+}
+
+void
+set_decl_context (tree decl, tree context)
+{
+  DECL_CONTEXT (decl) = context;
+}
+
+tree
+get_decl_context (tree decl)
+{
+  return DECL_CONTEXT (decl);
+}
+
+void
+set_decl_initial (tree decl, tree res)
+{
+  DECL_INITIAL (decl) = res;
+}
+
+tree
+get_decl_initial (tree decl)
+{
+  return DECL_INITIAL (decl);
+}
+
+tree
+get_decl_name (tree decl)
+{
+  return DECL_NAME (decl);
+}
+
+tree
+get_decl_assembler_name (tree decl)
+{
+  return DECL_ASSEMBLER_NAME (decl);
+}
+
+void
+set_DECL_ASSEMBLER_NAME (tree decl, tree name)
+{
+  SET_DECL_ASSEMBLER_NAME (decl, name);
+}
+
+void
+set_decl_built_in_class (tree decl, enum built_in_class class)
+{
+  DECL_BUILT_IN_CLASS (decl) = class;
+}
+
+void
+set_decl_function_code (tree decl, int code)
+{
+  DECL_FUNCTION_CODE (decl) = code;
+}
+
+tree
+get_decl_field_offset (tree decl)
+{
+  return DECL_FIELD_OFFSET (decl);
+}
+
+tree
+get_decl_field_bit_offset (tree decl)
+{
+  return DECL_FIELD_BIT_OFFSET (decl);
+}
+
+int
+integral_type_p (tree type)
+{
+  return INTEGRAL_TYPE_P (type);
+}
+
+void
+set_type_values (tree type, tree values)
+{
+  TYPE_VALUES (type) = values;
+}
+
+void
+set_type_name (tree type, tree name)
+{
+  TYPE_NAME (type) = name;
+}
+
+tree
+get_type_name (tree type)
+{
+  return TYPE_NAME (type);
+}
+
+void
+set_type_min_value (tree type, tree val)
+{
+  TYPE_MIN_VALUE (type) = val;
+}
+
+tree
+get_type_min_value (tree type)
+{
+  return TYPE_MIN_VALUE (type);
+}
+
+void
+set_type_max_value (tree type, tree val)
+{
+  TYPE_MAX_VALUE (type) = val;
+}
+
+tree
+get_type_max_value (tree type)
+{
+  return TYPE_MAX_VALUE (type);
+}
+
+void
+set_type_size (tree type, tree size)
+{
+  TYPE_SIZE (type) = size;
+}
+
+tree
+get_type_size (tree type)
+{
+  return TYPE_SIZE (type);
+}
+
+void
+set_type_precision (tree type, int precision)
+{
+  TYPE_PRECISION (type) = precision;
+}
+
+int
+get_type_precision (tree type)
+{
+  return TYPE_PRECISION (type);
+}
+
+void
+set_type_fields (tree type, tree fields)
+{
+  TYPE_FIELDS (type) = fields;
+}
+
+tree
+get_type_fields (tree type)
+{
+  return TYPE_FIELDS (type);
+}
+
+void
+set_type_stub_decl (tree type, tree decl)
+{
+  TYPE_STUB_DECL (type) = decl;
+}
+
+tree
+get_type_domain (tree type)
+{
+  return TYPE_DOMAIN (type);
+}
+
+void
+set_type_domain (tree type, tree domain)
+{
+  TYPE_DOMAIN (type) = domain;
+}
+
+void *
+get_type_lang_specific (tree node)
+{
+  return TYPE_LANG_SPECIFIC (node);
+}
+
+void
+set_type_lang_specific (tree node, void *val)
+{
+  TYPE_LANG_SPECIFIC (node) = val;
+}
+
+int
+get_type_is_sizetype (tree node)
+{
+  return TYPE_IS_SIZETYPE (node);
+}
+
+void
+set_type_pointer_to (tree node, tree dnode)
+{
+  TYPE_POINTER_TO (node) = dnode;
+}
+
+tree
+get_type_pointer_to (tree node)
+{
+  return TYPE_POINTER_TO (node);
+}
+
+enum machine_mode
+get_type_mode (tree node)
+{
+  return TYPE_MODE (node);
+}
+
+void
+set_type_mode (tree node, enum machine_mode mode)
+{
+  TYPE_MODE (node) = mode;
+}
+
+void
+set_current_function_decl (tree decl)
+{
+  current_function_decl = decl;
+}
+
+tree
+get_current_function_decl (void)
+{
+  return current_function_decl;
+}
+
+int
+double_type_size (void)
+{
+  return DOUBLE_TYPE_SIZE;
+}
+
+int
+bits_per_unit (void)
+{
+  return BITS_PER_UNIT;
+}
+
+tree
+(size_int) (HOST_WIDE_INT number)
+{
+  return size_int (number);
+}
+
+tree
+get_type_size_unit (tree node)
+{
+  return TYPE_SIZE_UNIT (node);
+}
+
+/* For agcc.real:  */
+REAL_VALUE_TYPE
+get_REAL_VALUE_ATOF (const char *s, enum machine_mode mode)
+{
+  return REAL_VALUE_ATOF (s, mode);
+}
+
+REAL_VALUE_TYPE
+get_REAL_VALUE_LDEXP (REAL_VALUE_TYPE x, int n)
+{
+  REAL_VALUE_TYPE res;
+  real_ldexp (&res, &x, n);
+  return res;
+}
+
+void
+get_REAL_VALUE_FROM_INT (REAL_VALUE_TYPE *d, HOST_WIDE_INT l, HOST_WIDE_INT h,
+			 enum machine_mode mode)
+{
+  REAL_VALUE_FROM_INT (*d, l, h, mode);
+}
+
+int
+get_identifier_length (tree node)
+{
+  return IDENTIFIER_LENGTH (node);
+}
+
+const char *
+get_identifier_pointer (tree node)
+{
+  return IDENTIFIER_POINTER (node);
+}
+
+tree
+get_block_supercontext (tree node)
+{
+  return BLOCK_SUPERCONTEXT (node);
+}
+
+void
+set_block_supercontext (tree block, tree sc)
+{
+  BLOCK_SUPERCONTEXT (block) = sc;
+}
+
+void
+set_block_vars (tree block, tree vars)
+{
+  BLOCK_VARS (block) = vars;
+}
+
+const int tree_identifier_size = sizeof (struct tree_identifier);
+
+#if 0
+static void
+ggc_mark_tree_ptr (void *elt)
+{
+  ggc_mark_tree (*(tree *) elt);
+}
+#endif
+
+#undef ggc_mark_tree
+void
+ggc_mark_tree (tree expr)
+{
+  gt_ggc_m_9tree_node (expr);
+}
+
+#if 0
+void
+ggc_add_tree_root (void *base, int nelt)
+{
+  ggc_add_root (base, nelt, sizeof (tree), ggc_mark_tree_ptr);
+}
+#endif
+
+int
+get_mode_bitsize (enum machine_mode mode)
+{
+  return GET_MODE_BITSIZE (mode);
+}
+
+int
+get_errorcount (void)
+{
+  return errorcount;
+}
+
+void
+set_errorcount (int c)
+{
+  errorcount = c;
+}
+
+
+/* Defined in agcc.fe  */
+extern const char language_name[];
+extern bool lang_init (void);
+extern void lang_finish (void);
+extern unsigned int lang_init_options (unsigned int argc, const char **argv);
+extern int lang_handle_option (size_t code, const char *argc, int value);
+extern bool lang_post_options (const char **);
+extern HOST_WIDE_INT lang_get_alias_set (tree t);
+extern bool mark_addressable (tree t);
+
+extern int global_bindings_p (void);
+extern int kept_level_p (void);
+extern tree getdecls (void);
+extern void pushlevel (int);
+extern tree poplevel (int, int, int);
+extern void insert_block (tree);
+extern void set_block (tree);
+extern tree pushdecl (tree);
+
+extern tree type_for_mode (enum machine_mode, int);
+extern tree type_for_size (unsigned int, int);
+extern tree unsigned_type (tree);
+extern tree signed_type (tree);
+extern tree signed_or_unsigned_type (int, tree);
+extern tree truthvalue_conversion (tree);
+extern void lang_parse_file (int);
+
+#undef LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME language_name
+#undef LANG_HOOKS_IDENTIFIER_SIZE
+#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
+#undef LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT lang_init
+#undef LANG_HOOKS_FINISH
+#define LANG_HOOKS_FINISH lang_finish
+#undef LANG_HOOKS_INIT_OPTIONS
+#define LANG_HOOKS_INIT_OPTIONS lang_init_options
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION lang_handle_option
+#undef LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS lang_post_options
+#undef LANG_HOOKS_GET_ALIAS_SET
+#define LANG_HOOKS_GET_ALIAS_SET lang_get_alias_set
+#undef LANG_HOOKS_HONOR_READONLY
+#define LANG_HOOKS_HONOR_READONLY true
+#undef LANG_HOOKS_TRUTHVALUE_CONVERSION
+#define LANG_HOOKS_TRUTHVALUE_CONVERSION truthvalue_conversion
+#undef LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE mark_addressable
+
+#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 lang_parse_file
+
+const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+/* Tree code classes.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
+
+const char tree_code_type[] = {
+#include "tree.def"
+  'x'
+};
+#undef DEFTREECODE
+
+/* Table indexed by tree code giving number of expression
+   operands beyond the fixed part of the node structure.
+   Not used for types or decls.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
+
+const unsigned char tree_code_length[] = {
+#include "tree.def"
+  0
+};
+#undef DEFTREECODE
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) NAME,
+const char * const tree_code_name[] = {
+#include "tree.def"
+  "@@dummy"
+};
+#undef DEFTREECODE
+
+union lang_tree_node 
+  GTY((desc ("0"),
+       chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+{
+  union tree_node GTY ((tag ("0"), 
+			desc ("tree_node_structure (&%h)"))) 
+    generic;
+};
+
+struct lang_decl GTY(())
+{
+};
+
+struct lang_type GTY (())
+{
+};
+
+struct language_function GTY (())
+{
+};
+ 
+tree
+c_common_truthvalue_conversion (tree expr)
+{
+  if (TREE_CODE (TREE_TYPE (expr)) == BOOLEAN_TYPE)
+    return expr;
+  if (TREE_CODE (expr) == INTEGER_CST)
+    return integer_zerop (expr) ? integer_zero_node : integer_one_node;
+  
+  abort ();
+}
+
+int
+get_PROMOTE_PROTOTYPES (void)
+{
+  return PROMOTE_PROTOTYPES;
+}
+
+struct binding_level GTY(())
+{
+  tree names;
+  tree blocks;
+  tree block_created_by_back_end;
+  struct binding_level *level_chain;
+};
+
+extern GTY(()) struct binding_level *current_binding_level;
+extern GTY((deletable (""))) struct binding_level *old_binding_level;
+
+struct binding_level *
+alloc_binding_level (void)
+{
+  return (struct binding_level *)ggc_alloc (sizeof (struct binding_level));
+}
+
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD  BITS_PER_WORD
+#endif
+
+extern GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
+
+#include "debug.h"
+#include "gt-vhdl-agcc-bindings.h"
+#include "gtype-vhdl.h"
+
diff --git a/ortho/agcc/agcc-convert.ads b/ortho/agcc/agcc-convert.ads
new file mode 100644
index 000000000..964dd81a6
--- /dev/null
+++ b/ortho/agcc/agcc-convert.ads
@@ -0,0 +1,26 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Trees; use Agcc.Trees;
+
+package Agcc.Convert is
+   function Convert_To_Integer (Atype : Tree; Expr : Tree) return Tree;
+   function Convert_To_Pointer (Atype : Tree; Expr : Tree) return Tree;
+private
+   pragma Import (C, Convert_To_Integer);
+   pragma Import (C, Convert_To_Pointer);
+end Agcc.Convert;
diff --git a/ortho/agcc/agcc-diagnostic.ads b/ortho/agcc/agcc-diagnostic.ads
new file mode 100644
index 000000000..4558896a6
--- /dev/null
+++ b/ortho/agcc/agcc-diagnostic.ads
@@ -0,0 +1,24 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Diagnostic is
+   function Get_Errorcount return Integer;
+   procedure Set_Errorcount (Cnt : Integer);
+private
+   pragma Import (C, Get_Errorcount);
+   pragma Import (C, Set_Errorcount);
+end Agcc.Diagnostic;
diff --git a/ortho/agcc/agcc-fe.ads b/ortho/agcc/agcc-fe.ads
new file mode 100644
index 000000000..7c2b11001
--- /dev/null
+++ b/ortho/agcc/agcc-fe.ads
@@ -0,0 +1,238 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Trees; use Agcc.Trees;
+with Agcc.Machmode; use Agcc.Machmode;
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Options; use Agcc.Options;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
+with C; use C;
+
+package Agcc.Fe is
+   --  Subprograms that must be defined by the front-end.
+
+   --  Defined in langhooks.h
+   function Lang_Init_Options (Argc : Integer; Argv : C_String_Array)
+     return Integer;
+
+   --  Front-end function expected by GCC.
+   function Lang_Handle_Option (Code : Opt_Code;
+                                Arg : C_String;
+                                Value : Integer)
+                               return Integer;
+
+   type C_String_Acc is access C_String;
+   pragma Convention (C, C_String_Acc);
+
+   function Lang_Post_Options (Filename : C_String_Acc) return C_Bool;
+
+   function Lang_Init return C_Bool;
+
+   procedure Lang_Finish;
+
+   --procedure Lang_Clear_Binding_Stack;
+
+   --  Return the typed-based alias set for T, which may be an expression
+   --  or a type.  Return -1 if we don't do anything special.
+   --  O means can alias everything.
+   function Lang_Get_Alias_Set (T : Tree) return HOST_WIDE_INT;
+
+   --function Lang_Expand_Constant (N : Tree) return Tree;
+
+   --function Lang_Safe_From_P (Target : Rtx; Exp : Tree) return C_Bool;
+
+   procedure Lang_Parse_File (Debug : C_Bool);
+
+   --  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.
+   function Mark_Addressable (Exp : Tree) return C_Bool;
+
+   --  Possibly apply default attributes to function FUNC represented by
+   --  a FUNCTION_DECL.
+   procedure Insert_Default_Attributes (Func : Tree);
+
+   --  Lexical scopes.
+   --  Roughly speaking, it is used to mark declarations regions.
+
+   --  Enter in a new lexical scope.  INSIDE should be FALSE (TRUE iff called
+   --  from the inside of the front end, ie from gcc internal code).
+   procedure Pushlevel (Inside : C_Bool);
+
+   --  Add a declaration to the current scope.
+   --  Note: GCC backend expect PUSHDECL to return its argument; however,
+   --  it is only seldom used.  Both forms exist and are aliased with a third
+   --  one which is exported under the C name.
+   --  (Unfortunatly, it is not possible to export the function and to import
+   --   the procedure).
+   procedure Pushdecl (Decl : Tree);
+   function Pushdecl (Decl : Tree) return Tree;
+
+   --  This function has to be defined.
+   function Exported_Pushdecl (Decl : Tree) return Tree;
+
+   --  Get the declarations of the current scope.
+   function Getdecls return Tree;
+
+   procedure Set_Block (Block : Tree);
+
+   -- Return non-zero if we are currently in the global binding level.
+   function Global_Bindings_P return Integer;
+
+   --  Insert BLOCK at the end of the list of subblocks of the
+   --  current binding level.  This is used when a BIND_EXPR is expanded,
+   --  to handle the BLOCK node inside the BIND_EXPR.
+   procedure Insert_Block (Block : Tree);
+
+   --  Exit the current scope.
+   --  FUNCTIONBODY is TRUE iff the scope corresponds to a subprogram scope.
+   --  Used forms (both imported).
+   procedure Poplevel (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool);
+   function Poplevel (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool)
+     return Tree;
+
+   --  Exported form.
+   function Exported_Poplevel
+     (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool)
+     return Tree;
+
+   --  Perform all the initialization steps that are language-specific.
+   --procedure Lang_Init;
+
+   --  Perform all the finalization steps that are language-specific.
+   --procedure Lang_Finish;
+
+   --  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.
+   function Type_For_Size (Precision : Natural; Unsignedp : C_Bool)
+     return Tree;
+
+   --  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+   --  an unsigned type; otherwise a signed type is returned.
+   function Type_For_Mode (Mode : Machine_Mode; Unsignedp : C_Bool)
+     return Tree;
+
+   --  Return the unsigned version of a TYPE_NODE, a scalar type.
+   function Unsigned_Type (Type_Node : Tree) return Tree;
+
+   --  Return the signed version of a TYPE_NODE, a scalar type.
+   function Signed_Type (Type_Node : Tree) return Tree;
+
+   --  Return a type the same as TYPE except unsigned or signed according to
+   --  UNSIGNEDP.
+   function Signed_Or_Unsigned_Type (Unsignedp : C_Bool; Atype : Tree)
+     return Tree;
+
+   --  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.
+   function Builtin_Function
+     (Name: System.Address;
+      Ftype : Tree;
+      Function_Code : Built_In_Function;
+      Class : Built_In_Class;
+      Library_Name : System.Address)
+     return Tree;
+
+   --  Set debug flag of the parser.
+   procedure Set_Yydebug (Flag : C_Bool);
+
+
+   --  Hooks for print-tree.c:
+   procedure Print_Lang_Decl (File : FILEs; Node : Tree; Indent : natural);
+   procedure Print_Lang_Type (File : FILEs; Node : Tree; Indent : Natural);
+   procedure Print_Lang_Identifier
+     (File : FILEs; Node : Tree; Indent : Natural);
+   procedure Lang_Print_Xnode (File : FILEs; Node : Tree; Indent : Natural);
+
+   --  Print any language-specific compilation statistics.
+   procedure Print_Lang_Statistics;
+
+
+   --  Finish to copy a ..._DECL node (the LANG_DECL_SPECIFIC field).
+   procedure Copy_Lang_Decl (Node : Tree);
+
+   --  Normalize boolean value EXPR.
+   function Truthvalue_Conversion (Expr : Tree) return Tree;
+
+   --  Procedure called in case of sizeof applied to an incomplete type.
+   procedure Incomplete_Type_Error (Value : Tree; Atype : Tree);
+
+   --  This function must be defined in the language-specific files.
+   --  expand_expr calls it to build the cleanup-expression for a TARGET_EXPR.
+   function Maybe_Build_Cleanup (Decl : Tree) return Tree;
+
+   --Language_String : constant Chars;
+   Flag_Traditional : Integer := 0;
+private
+   pragma Export (C, Lang_Init_Options);
+   pragma Export (C, Lang_Handle_Option);
+   pragma Export (C, Lang_Post_Options);
+   pragma Export (C, Lang_Init);
+   pragma Export (C, Lang_Finish);
+   pragma Export (C, Lang_Get_Alias_Set);
+
+   pragma Export (C, Lang_Parse_File);
+
+   pragma Export (C, Mark_Addressable);
+   pragma Export (C, Insert_Default_Attributes);
+
+   pragma Import (C, Pushdecl);
+   pragma Export (C, Exported_Pushdecl, "pushdecl");
+   pragma Export (C, Pushlevel);
+   pragma Export (C, Set_Block);
+   pragma Export (C, Insert_Block);
+   pragma Export (C, Global_Bindings_P);
+   pragma Import (C, Poplevel);
+   pragma Export (C, Exported_Poplevel, "poplevel");
+   pragma Export (C, Getdecls);
+
+   pragma Export (C, Type_For_Size);
+   pragma Export (C, Type_For_Mode);
+   pragma Export (C, Unsigned_Type);
+   pragma Export (C, Signed_Type);
+   pragma Export (C, Signed_Or_Unsigned_Type);
+
+   pragma Export (C, Builtin_Function);
+
+
+   pragma Export (C, Set_Yydebug);
+
+   pragma Export (C, Print_Lang_Decl);
+   pragma Export (C, Print_Lang_Type);
+   pragma Export (C, Print_Lang_Identifier);
+   pragma Export (C, Lang_Print_Xnode);
+
+   pragma Export (C, Print_Lang_Statistics);
+   pragma Export (C, Copy_Lang_Decl);
+
+   pragma Export (C, Truthvalue_Conversion);
+   pragma Export (C, Incomplete_Type_Error);
+   pragma Export (C, Maybe_Build_Cleanup);
+
+   pragma Export (C, Flag_Traditional);
+end Agcc.Fe;
+
diff --git a/ortho/agcc/agcc-ggc.ads b/ortho/agcc/agcc-ggc.ads
new file mode 100644
index 000000000..4892d59b3
--- /dev/null
+++ b/ortho/agcc/agcc-ggc.ads
@@ -0,0 +1,33 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Trees; use Agcc.Trees;
+
+package Agcc.Ggc is
+   procedure Ggc_Add_Root (Base : System.Address;
+                           Nelt : Natural;
+                           Size : Natural;
+                           Func : System.Address);
+
+   procedure Ggc_Add_Tree_Root (Base : System.Address; Nelt : Natural);
+
+   procedure Ggc_Mark_Tree (Expr : Tree);
+private
+   pragma Import (C, Ggc_Add_Root);
+   pragma Import (C, Ggc_Mark_Tree);
+   pragma Import (C, Ggc_Add_Tree_Root);
+end Agcc.Ggc;
diff --git a/ortho/agcc/agcc-ghdl.c b/ortho/agcc/agcc-ghdl.c
new file mode 100644
index 000000000..211d5e093
--- /dev/null
+++ b/ortho/agcc/agcc-ghdl.c
@@ -0,0 +1,658 @@
+/*  Ada bindings for GCC internals.
+    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 "config.h"
+#include "system.h"
+#include "tree.h"
+#include "flags.h"
+#include <stdio.h>
+
+#if 0
+const char *const language_string = "ghdl";
+int flag_traditional;
+#endif
+
+/* Convertion from a C string to the corresponding cannonical
+   Ada (GNAT) String.  */
+struct str_template
+{
+  int first;
+  int last;
+};
+
+struct str_fatptr
+{
+  const char *array;
+  struct str_template *tpl;
+};
+
+#if 0
+/* Called by toplev.c, to initialize the parser.  */
+const char *
+init_parse (const char *filename)
+{
+  struct str_template temp1 = {1, strlen (filename)};
+  struct str_fatptr   fp = {filename, &temp1};
+
+  ghdl1__init_parse (fp);
+  return filename;
+}
+#endif
+
+void
+lang_init_options (void)
+{
+  extern int gnat_argc;
+  extern const char **gnat_argv;
+  extern const char *progname;
+
+  /* Initialize ada.command_line.  */
+  gnat_argc = 1;
+  gnat_argv = &progname;
+
+  adainit ();
+}
+
+#if 0
+/* Decode all the language specific options that cannot be decoded by GCC. The
+   option decoding phase of GCC calls this routine on the flags that it cannot
+   decode.  Return 1 if successful, otherwise return 0. */
+
+int
+lang_decode_option (argc, argv)
+     int argc;
+     char **argv;
+{
+  return 0;
+}
+
+void
+lang_print_xnode(file, t, i)
+     FILE *file;
+     tree t;
+     int i;
+{
+     return;
+}
+
+/* Routines Expected by gcc:  */
+
+/* These are used to build types for various sizes.  The code below
+   is a simplified version of that of GNAT.  */
+
+#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 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.  */
+
+tree
+type_for_size (precision, unsignedp)
+     unsigned precision;
+     int unsignedp;
+{
+  tree t;
+
+  if (precision <= MAX_BITS_PER_WORD
+      && signed_and_unsigned_types[precision][unsignedp] != 0)
+    return signed_and_unsigned_types[precision][unsignedp];
+
+ if (unsignedp)
+    t = signed_and_unsigned_types[precision][1]
+      = make_unsigned_type (precision);
+  else
+    t = signed_and_unsigned_types[precision][0]
+      = make_signed_type (precision);
+
+  return t;
+}
+
+
+/* Return a data type that has machine mode MODE.  UNSIGNEDP selects
+   an unsigned type; otherwise a signed type is returned.  */
+
+tree
+type_for_mode (mode, unsignedp)
+     enum machine_mode mode;
+     int unsignedp;
+{
+  return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
+}
+
+/* Return the unsigned version of a TYPE_NODE, a scalar type.  */
+
+tree
+unsigned_type (type_node)
+     tree type_node;
+{
+  return type_for_size (TYPE_PRECISION (type_node), 1);
+}
+
+/* Return the signed version of a TYPE_NODE, a scalar type.  */
+
+tree
+signed_type (type_node)
+     tree type_node;
+{
+  return type_for_size (TYPE_PRECISION (type_node), 0);
+}
+
+/* Return a type the same as TYPE except unsigned or signed according to
+   UNSIGNEDP.  */
+
+tree
+signed_or_unsigned_type (unsignedp, type)
+     int unsignedp;
+     tree type;
+{
+  if (! INTEGRAL_TYPE_P (type) || TREE_UNSIGNED (type) == unsignedp)
+    return type;
+  else
+    return type_for_size (TYPE_PRECISION (type), unsignedp);
+}
+
+void
+init_type_for_size (void)
+{
+  ggc_add_tree_root (signed_and_unsigned_types,
+		     sizeof (signed_and_unsigned_types) / sizeof (tree));
+}
+#endif
+
+
+#if 0
+/* These functions and variables deal with binding contours.  We only
+   need these functions for the list of PARM_DECLs, but we leave the
+   functions more general; these are a simplified version of the
+   functions from GNAT.  */
+
+/* For each binding contour we allocate a binding_level structure which records
+   the entities defined or declared in that contour. Contours include:
+
+        the global one
+        one for each subprogram definition
+        one for each compound statement (declare block)
+
+   Binding contours are used to create GCC tree BLOCK nodes.  */
+
+struct binding_level
+{
+  /* A chain of ..._DECL nodes for all variables, constants, functions,
+     parameters and type declarations.  These ..._DECL nodes are chained
+     through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
+     in the reverse of the order supplied to be compatible with the
+     back-end.  */
+  tree names;
+  /* For each level (except the global one), a chain of BLOCK nodes for all
+     the levels that were entered and exited one level down from this one.  */
+  tree blocks;
+  /* The back end may need, for its own internal processing, to create a BLOCK
+     node. This field is set aside for this purpose. If this field is non-null
+     when the level is popped, i.e. when poplevel is invoked, we will use such
+     block instead of creating a new one from the 'names' field, that is the
+     ..._DECL nodes accumulated so far.  Typically the routine 'pushlevel'
+     will be called before setting this field, so that if the front-end had
+     inserted ..._DECL nodes in the current block they will not be lost.   */
+  tree block_created_by_back_end;
+  /* The binding level containing this one (the enclosing binding level). */
+  struct binding_level *level_chain;
+};
+
+/* The binding level currently in effect.  */
+static struct binding_level *current_binding_level = NULL;
+
+/* The outermost binding level. This binding level is created when the
+   compiler is started and it will exist through the entire compilation.  */
+static struct binding_level *global_binding_level;
+
+/* Binding level structures are initialized by copying this one.  */
+static struct binding_level clear_binding_level = {NULL, NULL, NULL, NULL};
+
+/* Return non-zero if we are currently in the global binding level.  */
+
+int
+global_bindings_p ()
+{
+  return current_binding_level == global_binding_level ? -1 : 0;
+}
+
+/* Return the list of declarations in the current level. Note that this list
+   is in reverse order (it has to be so for back-end compatibility).  */
+
+tree
+getdecls ()
+{
+  return current_binding_level->names;
+}
+
+/* Nonzero if the current level needs to have a BLOCK made.  */
+
+int
+kept_level_p ()
+{
+  return (current_binding_level->names != 0);
+}
+
+/* Enter a new binding level. The input parameter is ignored, but has to be
+   specified for back-end compatibility.  */
+
+void
+pushlevel (ignore)
+     int ignore;
+{
+  struct binding_level *newlevel
+    = (struct binding_level *) xmalloc (sizeof (struct binding_level));
+
+  *newlevel = clear_binding_level;
+
+  /* Add this level to the front of the chain (stack) of levels that are
+     active.  */
+  newlevel->level_chain = current_binding_level;
+  current_binding_level = newlevel;
+}
+
+/* Exit a binding level.
+   Pop the level off, and restore the state of the identifier-decl mappings
+   that were in effect when this level was entered.
+
+   If KEEP is nonzero, this level had explicit declarations, so
+   and create a "block" (a BLOCK node) for the level
+   to record its declarations and subblocks for symbol table output.
+
+   If FUNCTIONBODY is nonzero, this level is the body of a function,
+   so create a block as if KEEP were set and also clear out all
+   label names.
+
+   If REVERSE is nonzero, reverse the order of decls before putting
+   them into the BLOCK.  */
+
+tree
+poplevel (keep, reverse, functionbody)
+     int keep;
+     int reverse;
+     int functionbody;
+{
+  /* Points to a BLOCK tree node. This is the BLOCK node construted for the
+     binding level that we are about to exit and which is returned by this
+     routine.  */
+  tree block_node = NULL_TREE;
+  tree decl_chain;
+  tree decl_node;
+  tree subblock_chain = current_binding_level->blocks;
+  tree subblock_node;
+  tree block_created_by_back_end;
+
+  /* Reverse the list of XXXX_DECL nodes if desired.  Note that the ..._DECL
+     nodes chained through the `names' field of current_binding_level are in
+     reverse order except for PARM_DECL node, which are explicitely stored in
+     the right order.  */
+  decl_chain = (reverse) ? nreverse (current_binding_level->names)
+                         : current_binding_level->names;
+
+  block_created_by_back_end = current_binding_level->block_created_by_back_end;
+  if (block_created_by_back_end != 0)
+    {
+      block_node = block_created_by_back_end;
+
+      /* Check if we are about to discard some information that was gathered
+         by the front-end. Nameley check if the back-end created a new block
+         without calling pushlevel first. To understand why things are lost
+         just look at the next case (i.e. no block created by back-end.  */
+      if ((keep || functionbody) && (decl_chain || subblock_chain))
+        abort ();
+    }
+
+  /* If there were any declarations in the current binding level, or if this
+     binding level is a function body, or if there are any nested blocks then
+     create a BLOCK node to record them for the life of this function.  */
+  else if (keep || functionbody)
+    block_node = build_block (keep ? decl_chain : 0, 0, subblock_chain, 0, 0);
+
+  /* Record the BLOCK node just built as the subblock its enclosing scope.  */
+  for (subblock_node = subblock_chain; subblock_node;
+       subblock_node = TREE_CHAIN (subblock_node))
+    BLOCK_SUPERCONTEXT (subblock_node) = block_node;
+
+  /* Clear out the meanings of the local variables of this level.  */
+
+  for (subblock_node = decl_chain; subblock_node;
+       subblock_node = TREE_CHAIN (subblock_node))
+    if (DECL_NAME (subblock_node) != 0)
+      /* If the identifier was used or addressed via a local extern decl,
+         don't forget that fact.   */
+      if (DECL_EXTERNAL (subblock_node))
+        {
+          if (TREE_USED (subblock_node))
+            TREE_USED (DECL_NAME (subblock_node)) = 1;
+          if (TREE_ADDRESSABLE (subblock_node))
+            TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
+        }
+
+  /* Pop the current level.  */
+  current_binding_level = current_binding_level->level_chain;
+
+  if (functionbody)
+    {
+      /* This is the top level block of a function. The ..._DECL chain stored
+         in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
+         leave them in the BLOCK because they are found in the FUNCTION_DECL
+         instead.  */
+      DECL_INITIAL (current_function_decl) = block_node;
+      BLOCK_VARS (block_node) = 0;
+    }
+  else if (block_node)
+    {
+      if (block_created_by_back_end == NULL)
+        current_binding_level->blocks
+          = chainon (current_binding_level->blocks, block_node);
+    }
+
+  /* If we did not make a block for the level just exited, any blocks made for
+     inner levels (since they cannot be recorded as subblocks in that level)
+     must be carried forward so they will later become subblocks of something
+     else.  */
+  else if (subblock_chain)
+    current_binding_level->blocks
+      = chainon (current_binding_level->blocks, subblock_chain);
+  if (block_node)
+    TREE_USED (block_node) = 1;
+
+  return block_node;
+}
+
+/* Insert BLOCK at the end of the list of subblocks of the
+   current binding level.  This is used when a BIND_EXPR is expanded,
+   to handle the BLOCK node inside the BIND_EXPR.  */
+
+void
+insert_block (block)
+     tree block;
+{
+  TREE_USED (block) = 1;
+  current_binding_level->blocks
+    = chainon (current_binding_level->blocks, block);
+}
+
+/* Set the BLOCK node for the innermost scope
+   (the one we are currently in).  */
+
+void
+set_block (block)
+     tree block;
+{
+  current_binding_level->block_created_by_back_end = block;
+}
+
+/* Records a ..._DECL node DECL as belonging to the current lexical scope.
+   Returns the ..._DECL node. */
+
+tree
+pushdecl (decl)
+     tree decl;
+{
+  /* External objects aren't nested, other objects may be.  */
+  if (DECL_EXTERNAL (decl))
+    DECL_CONTEXT (decl) = 0;
+  else
+    DECL_CONTEXT (decl) = current_function_decl;
+
+  /* Put the declaration on the list.  The list of declarations is in reverse
+     order. The list will be reversed later if necessary.  This needs to be
+     this way for compatibility with the back-end.  */
+
+  TREE_CHAIN (decl) = current_binding_level->names;
+  current_binding_level->names = decl;
+
+  /* For the declaration of a type, set its name if it is not already set. */
+
+  if (TREE_CODE (decl) == TYPE_DECL
+      && TYPE_NAME (TREE_TYPE (decl)) == 0)
+    TYPE_NAME (TREE_TYPE (decl)) = decl; /* DECL_NAME (decl); */
+
+  return decl;
+}
+#endif
+
+#ifndef CHAR_TYPE_SIZE
+#define CHAR_TYPE_SIZE BITS_PER_UNIT
+#endif
+
+#ifndef INT_TYPE_SIZE
+#define INT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#undef SIZE_TYPE
+#define SIZE_TYPE "long unsigned int"
+
+#if 0
+/* Create the predefined scalar types such as `integer_type_node' needed
+   in the gcc back-end and initialize the global binding level.  */
+
+void
+init_decl_processing ()
+{
+  tree endlink;
+
+  error_mark_node = make_node (ERROR_MARK);
+  TREE_TYPE (error_mark_node) = error_mark_node;
+
+  initialize_sizetypes ();
+
+  /* The structure `tree_identifier' is the GCC tree data structure that holds
+     IDENTIFIER_NODE nodes. We need to call `set_identifier_size' to tell GCC
+     that we have not added any language specific fields to IDENTIFIER_NODE
+     nodes.  */
+  set_identifier_size (sizeof (struct tree_identifier));
+  lineno = 0;
+
+  /* Make the binding_level structure for global names.  */
+  pushlevel (0);
+  global_binding_level = current_binding_level;
+
+  build_common_tree_nodes (0);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("int"),
+                        integer_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("char"),
+                        char_type_node));
+  set_sizetype (unsigned_type_node);
+  build_common_tree_nodes_2 (0);
+
+}
+#endif
+
+
+#if 0
+/* Perform all the initialization steps that are language-specific.  */
+
+void
+lang_init ()
+{}
+
+/* Perform all the finalization steps that are language-specific.  */
+
+void
+lang_finish ()
+{}
+
+/* Return a short string identifying this language to the debugger.  */
+
+const char *
+lang_identify ()
+{
+  return "vhdl";
+}
+
+/* If DECL has a cleanup, build and return that cleanup here.
+   This is a callback called by expand_expr.  */
+
+tree
+maybe_build_cleanup (decl)
+     tree decl;
+{ return NULL_TREE; }
+
+/* Print an error message for invalid use of an incomplete type.  */
+
+void
+incomplete_type_error (dont_care_1, dont_care_2)
+     tree dont_care_1, dont_care_2;
+{ abort (); }
+
+tree
+truthvalue_conversion (expr)
+     tree expr;
+{ return expr;}
+
+int
+mark_addressable (expr)
+     tree expr;
+{return 0;}
+#endif
+
+#if 0
+/* Print any language-specific compilation statistics.  */
+
+void
+print_lang_statistics ()
+{}
+
+/* Since we don't use the DECL_LANG_SPECIFIC field, this is a no-op.  */
+
+void
+copy_lang_decl (node)
+     tree node;
+{}
+
+/* Hooks for print-tree.c:  */
+
+void
+print_lang_decl (file, node, indent)
+     FILE *file;
+     tree node;
+     int indent;
+{}
+
+void
+print_lang_type (file, node, indent)
+     FILE *file;
+     tree node;
+     int indent;
+{}
+
+void
+print_lang_identifier (file, node, indent)
+     FILE *file;
+     tree node;
+     int indent;
+{}
+#endif
+
+#if 0
+/* Performs whatever initialization steps are needed by the language-dependent
+   lexical analyzer.  */
+
+void
+init_lex ()
+{}
+
+
+/* Sets some debug flags for the parser. It does nothing here.  */
+
+void
+set_yydebug (value)
+     int value;
+{}
+#endif
+
+#if 0
+/* Routine to print parse error message.  */
+void
+yyerror (str)
+     char *str;
+{
+  fprintf (stderr, "%s\n", str);
+}
+#endif
+
+#if 0
+/* Return the typed-based alias set for T, which may be an expression
+   or a type.  Return -1 if we don't do anything special.  */
+
+HOST_WIDE_INT
+lang_get_alias_set (t)
+     tree t ATTRIBUTE_UNUSED;
+{
+  return -1;
+}
+#endif
+
+#if 0
+/* 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.  */
+
+tree
+builtin_function (name, type, function_code, class, library_name)
+     const char *name;
+     tree type;
+     int function_code;
+     enum built_in_class class;
+     const char *library_name;
+{
+  tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  if (library_name)
+    DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name);
+  make_decl_rtl (decl, NULL_PTR, 1);
+  pushdecl (decl);
+  DECL_BUILT_IN_CLASS (decl) = class;
+  DECL_FUNCTION_CODE (decl) = function_code;
+  return decl;
+}
+#endif
+
+#if 0
+/* Mark language-specific parts of T for garbage-collection.  */
+
+void
+lang_mark_tree (t)
+     tree t ATTRIBUTE_UNUSED;
+{
+}
+#endif
+
+void
+print_chain (tree t)
+{
+  while (t != NULL)
+    {
+      print_node_brief (stdout, "", t, 0);
+      fprintf (stdout, "\n");
+      t = TREE_CHAIN (t);
+    }
+}
diff --git a/ortho/agcc/agcc-hconfig.ads.in b/ortho/agcc/agcc-hconfig.ads.in
new file mode 100644
index 000000000..3662c953c
--- /dev/null
+++ b/ortho/agcc/agcc-hconfig.ads.in
@@ -0,0 +1,21 @@
+--  Ada bindings for GCC internals. -*- 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 Agcc.Hconfig is
+@host_big_endian
+end Agcc.Hconfig;
diff --git a/ortho/agcc/agcc-hwint.ads.in b/ortho/agcc/agcc-hwint.ads.in
new file mode 100644
index 000000000..245f211dc
--- /dev/null
+++ b/ortho/agcc/agcc-hwint.ads.in
@@ -0,0 +1,23 @@
+--  Ada bindings for GCC internals. -*- 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.
+with Interfaces;
+
+package Agcc.Hwint is
+   pragma Preelaborate (Agcc.Hwint);
+@host_wide_int
+end Agcc.Hwint;
diff --git a/ortho/agcc/agcc-input.ads b/ortho/agcc/agcc-input.ads
new file mode 100644
index 000000000..d7ff5ec5a
--- /dev/null
+++ b/ortho/agcc/agcc-input.ads
@@ -0,0 +1,29 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Input is
+   type Location_T is record
+      File : Chars;
+      Line : Integer;
+   end record;
+   pragma Convention (C_Pass_By_Copy, Location_T);
+
+   Input_Location : Location_T;
+   pragma Import (C, Input_Location);
+end Agcc.Input;
+
+
diff --git a/ortho/agcc/agcc-libiberty.ads b/ortho/agcc/agcc-libiberty.ads
new file mode 100644
index 000000000..89784b7e0
--- /dev/null
+++ b/ortho/agcc/agcc-libiberty.ads
@@ -0,0 +1,21 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Libiberty is
+   function Xmalloc (Size : Size_T) return Chars;
+   pragma Import (C, Xmalloc);
+end Agcc.Libiberty;
diff --git a/ortho/agcc/agcc-machmode.ads.in b/ortho/agcc/agcc-machmode.ads.in
new file mode 100644
index 000000000..ccc6980ab
--- /dev/null
+++ b/ortho/agcc/agcc-machmode.ads.in
@@ -0,0 +1,35 @@
+--  Ada bindings for GCC internals. -*- 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 Agcc.Machmode is
+   pragma Preelaborate (Agcc.Machmode);
+
+   type Machine_Mode is
+     (
+@machmode
+      );
+   pragma Convention (C, Machine_Mode);
+
+   function GET_MODE_BITSIZE (Mode : Machine_Mode) return Natural;
+   Ptr_Mode : Machine_Mode;
+
+private
+   pragma Import (C, GET_MODE_BITSIZE);
+   pragma Import (C, Ptr_Mode);
+end Agcc.Machmode;
+
diff --git a/ortho/agcc/agcc-options.ads.in b/ortho/agcc/agcc-options.ads.in
new file mode 100644
index 000000000..8931edde4
--- /dev/null
+++ b/ortho/agcc/agcc-options.ads.in
@@ -0,0 +1,31 @@
+--  Ada bindings for GCC internals. -*- 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.
+
+-- This file is preprocessed by gen_tree to create agcc-options.ads
+
+package Agcc.Options is
+
+@options_CL
+
+   type Opt_Code is
+     (
+@options_OPTs
+     );
+
+   pragma Convention (C, Opt_Code);
+end Agcc.Options;
diff --git a/ortho/agcc/agcc-output.ads b/ortho/agcc/agcc-output.ads
new file mode 100644
index 000000000..6ecab6e33
--- /dev/null
+++ b/ortho/agcc/agcc-output.ads
@@ -0,0 +1,24 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Trees; use Agcc.Trees;
+
+package Agcc.Output is
+   procedure Make_Function_Rtl (Func : Tree);
+private
+   pragma Import (C, Make_Function_Rtl);
+end Agcc.Output;
diff --git a/ortho/agcc/agcc-real.ads.in b/ortho/agcc/agcc-real.ads.in
new file mode 100644
index 000000000..ec6b080bd
--- /dev/null
+++ b/ortho/agcc/agcc-real.ads.in
@@ -0,0 +1,42 @@
+--  Ada bindings for GCC internals. -*- 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.
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Machmode; use Agcc.Machmode;
+
+package Agcc.Real is
+   pragma Preelaborate (Agcc.Real);
+
+   type REAL_VALUE_TYPE is private;
+
+   function REAL_VALUE_ATOF (S : System.Address; M : Machine_Mode)
+     return REAL_VALUE_TYPE;
+
+   function REAL_VALUE_LDEXP (X : REAL_VALUE_TYPE; N : Integer)
+     return REAL_VALUE_TYPE;
+
+   procedure REAL_VALUE_FROM_INT (D : System.Address;
+                                  Lo, Hi : HOST_WIDE_INT;
+                                  Mode : Machine_Mode);
+private
+@real
+   --  FIXME: check about the convention on other machines.
+   pragma Convention (C_Pass_By_Copy, REAL_VALUE_TYPE);
+   pragma Import (C, REAL_VALUE_ATOF, "get_REAL_VALUE_ATOF");
+   pragma Import (C, REAL_VALUE_LDEXP, "get_REAL_VALUE_LDEXP");
+   pragma Import (C, REAL_VALUE_FROM_INT, "get_REAL_VALUE_FROM_INT");
+end Agcc.Real;
diff --git a/ortho/agcc/agcc-rtl.ads b/ortho/agcc/agcc-rtl.ads
new file mode 100644
index 000000000..e45143a8f
--- /dev/null
+++ b/ortho/agcc/agcc-rtl.ads
@@ -0,0 +1,31 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Input; use Agcc.Input;
+with System;
+
+package Agcc.Rtl is
+   --  Defines RTX as an opaque type.
+   type Rtx is new System.Address;
+
+   procedure Emit_Line_Note (Loc : Location_T);
+   function Emit_Line_Note (Loc : Location_T) return Rtx;
+   procedure Emit_Nop;
+private
+   pragma Import (C, Emit_Line_Note);
+   pragma Import (C, Emit_Nop);
+end Agcc.Rtl;
diff --git a/ortho/agcc/agcc-stor_layout.ads b/ortho/agcc/agcc-stor_layout.ads
new file mode 100644
index 000000000..aeaa4d74e
--- /dev/null
+++ b/ortho/agcc/agcc-stor_layout.ads
@@ -0,0 +1,24 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Trees; use Agcc.Trees;
+
+package Agcc.Stor_Layout is
+   procedure Fixup_Unsigned_Type (Atype : Tree);
+private
+   pragma Import (C, Fixup_Unsigned_Type);
+end Agcc.Stor_Layout;
diff --git a/ortho/agcc/agcc-tm.ads.in b/ortho/agcc/agcc-tm.ads.in
new file mode 100644
index 000000000..7fea03cd2
--- /dev/null
+++ b/ortho/agcc/agcc-tm.ads.in
@@ -0,0 +1,37 @@
+--  Ada bindings for GCC internals. -*- 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.
+
+--  Definitions about target machine.
+
+package Agcc.Tm is
+   pragma Preelaborate (Agcc.Tm);
+
+   function DOUBLE_TYPE_SIZE return Natural;
+   function LONG_DOUBLE_TYPE_SIZE return Natural;
+   function BITS_PER_UNIT return Natural;
+   function BITS_PER_WORD return Natural;
+   function PROMOTE_PROTOTYPES return C_Bool;
+@tm
+private
+   pragma Import (C, DOUBLE_TYPE_SIZE);
+   pragma Import (C, LONG_DOUBLE_TYPE_SIZE);
+   pragma Import (C, BITS_PER_UNIT);
+   pragma Import (C, BITS_PER_WORD);
+   pragma Import (C, PROMOTE_PROTOTYPES, "get_PROMOTE_PROTOTYPES");
+end Agcc.Tm;
+
diff --git a/ortho/agcc/agcc-toplev.ads b/ortho/agcc/agcc-toplev.ads
new file mode 100644
index 000000000..a816f54f2
--- /dev/null
+++ b/ortho/agcc/agcc-toplev.ads
@@ -0,0 +1,51 @@
+--  Ada bindings for GCC internals.
+--  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 Agcc.Trees; use Agcc.Trees;
+with System;
+with Agcc.Hwint; use Agcc.Hwint;
+
+package Agcc.Toplev is
+   procedure Rest_Of_Decl_Compilation (Decl : Tree;
+                                       Asmspec : System.Address;
+                                       Top_Level : C_Bool;
+                                       At_End : C_Bool);
+   procedure Rest_Of_Type_Compilation (Decl : Tree; Toplevel : C_Bool);
+   procedure Rest_Of_Compilation (Decl : Tree);
+
+   function Exact_Log2_Wide (X : HOST_WIDE_INT) return Integer;
+   function Floor_Log2_Wide (X : HOST_WIDE_INT) return Integer;
+
+   procedure Error (Msg : System.Address);
+
+   procedure Announce_Function (Func : Tree);
+
+   function Toplev_Main (Argc : Integer; Argv : System.Address)
+     return Integer;
+private
+   pragma Import (C, Rest_Of_Decl_Compilation);
+   pragma Import (C, Rest_Of_Type_Compilation);
+   pragma Import (C, Rest_Of_Compilation);
+
+   pragma Import (C, Exact_Log2_Wide);
+   pragma Import (C, Floor_Log2_Wide);
+
+   pragma Import (C, Error);
+
+   pragma Import (C, Announce_Function);
+   pragma Import (C, Toplev_Main);
+end Agcc.Toplev;
diff --git a/ortho/agcc/agcc-trees.adb b/ortho/agcc/agcc-trees.adb
new file mode 100644
index 000000000..a13aba346
--- /dev/null
+++ b/ortho/agcc/agcc-trees.adb
@@ -0,0 +1,33 @@
+--  Ada bindings for GCC internals.
+--  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 body Agcc.Trees is
+   function Build_Int (Low : HOST_WIDE_INT) return Tree is
+   begin
+      if Low < 0 then
+         return Build_Int_2_Wide (Low, -1);
+      else
+         return Build_Int_2_Wide (Low, 0);
+      end if;
+   end Build_Int;
+
+   procedure Expand_Start_Bindings (Flags : Integer) is
+   begin
+      Expand_Start_Bindings_And_Block (Flags, NULL_TREE);
+   end Expand_Start_Bindings;
+
+end Agcc.Trees;
diff --git a/ortho/agcc/agcc-trees.ads.in b/ortho/agcc/agcc-trees.ads.in
new file mode 100644
index 000000000..5eb2d5844
--- /dev/null
+++ b/ortho/agcc/agcc-trees.ads.in
@@ -0,0 +1,514 @@
+--  Ada bindings for GCC internals. -*- 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.
+
+-- This file is preprocessed by gen_tree to create agcc-trees.ads
+-- gen_tree adds enumerations from GCC C files.
+
+with System; use System;
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Real; use Agcc.Real;
+with Agcc.Machmode; use Agcc.Machmode;
+
+package Agcc.Trees is
+   --pragma No_Elaboration_Code (Agcc.Trees);
+
+   type Tree is new System.Address;
+
+   NULL_TREE : constant Tree;
+
+   type Tree_Code is
+     (
+@tree_code
+     );
+   pragma Convention (C, Tree_Code);
+
+   type Built_In_Class is
+     (NOT_BUILT_IN, BUILT_IN_FRONTEND, BUILT_IN_MD, BUILT_IN_NORMAL);
+   pragma Convention (C, Built_In_Class);
+
+   type Built_In_Function is
+     (
+@built_in_function
+     );
+   pragma Convention (C, Built_In_Function);
+
+   type Tree_Index is
+     (
+@tree_index
+     );
+
+   type Type_Qual_Type is new Integer;
+@type_qual
+
+   type Global_Trees_Array is array (Tree_Index) of Tree;
+   pragma Convention (C, Global_Trees_Array);
+   Global_Trees : Global_Trees_Array;
+   pragma Import (C, Global_Trees);
+
+   Error_Mark_Node : Tree renames Global_Trees (TI_ERROR_MARK);
+   Void_Type_Node : Tree renames Global_Trees (TI_VOID_TYPE);
+   Ptr_Type_Node : Tree renames Global_Trees (TI_PTR_TYPE);
+   Const_Ptr_Type_Node : Tree renames Global_Trees (TI_CONST_PTR_TYPE);
+   Integer_Zero_Node : Tree renames Global_Trees (TI_INTEGER_ZERO);
+   Integer_One_Node : Tree renames Global_Trees (TI_INTEGER_ONE);
+   Size_Zero_Node : Tree renames Global_Trees (TI_SIZE_ZERO);
+
+   type Size_Type_Kind is
+     (
+@size_type_kind
+      );
+
+   type Sizetype_Tab_Array is array (Size_Type_Kind) of Tree;
+   pragma Convention (C, Sizetype_Tab_Array);
+   Sizetype_Tab : Sizetype_Tab_Array;
+   pragma Import (C, Sizetype_Tab);
+
+   Bitsizetype : Tree renames Sizetype_Tab (TK_BITSIZETYPE);
+   Sizetype : Tree renames Sizetype_Tab (TK_SIZETYPE);
+
+   type Integer_Types_Kind is
+     (
+@integer_types
+      );
+
+   type Integer_Types_Array is array (Integer_Types_Kind) of Tree;
+   pragma Convention (C, Integer_Types_Array);
+   Integer_Types : Integer_Types_Array;
+   pragma Import (C, Integer_Types);
+
+   Integer_Type_Node : Tree renames Integer_Types (itk_int);
+   Unsigned_Type_Node : Tree renames Integer_Types (itk_unsigned_int);
+   Char_Type_Node : Tree renames Integer_Types (itk_char);
+
+   function Build (Code: Tree_Code; T: Tree; O0, O1: Tree) return Tree;
+   function Build (Code: Tree_Code; T: Tree; O0, O1, O2: Tree) return Tree;
+   function Build1 (Code: Tree_Code; T: Tree; O: Tree) return Tree;
+   function Build_Constructor (T : Tree; V : Tree) return Tree;
+   function Build_Block (Vars : Tree;
+                         Tags : Tree;
+                         Subblocks : Tree;
+                         Supercontext : Tree;
+                         Chain : Tree)
+     return Tree;
+   function Build_Decl (Code : Tree_Code; T1 : Tree; T2: Tree) return Tree;
+   function Build_Int_2 (Low, Hi: HOST_WIDE_INT) return Tree;
+   function Build_Int_2_Wide (Low, Hi: HOST_WIDE_INT) return Tree;
+   function Build_Real (Rtype : Tree; D : REAL_VALUE_TYPE) return Tree;
+   function Build_Function_Type (Value_Type : Tree; Arg_Type : Tree)
+     return Tree;
+   function Build_Pointer_Type (Atype : Tree) return Tree;
+   function Get_Identifier (Str : System.Address) return Tree;
+   function Build_String (Len : Integer; Str : System.Address) return Tree;
+   function Build_Index_Type (Max : Tree) return Tree;
+   function Build_Range_Type (Basetype : Tree; Low : Tree; High : Tree)
+     return Tree;
+   function Build_Array_Type (El_Type : Tree; Domain : Tree) return Tree;
+   function Make_Node (Code : Tree_Code) return Tree;
+   function Build_Qualified_Type (Atype : Tree; Qual : Type_Qual_Type)
+     return Tree;
+
+   function Build_Save_Expr (Expr : Tree) return Tree;
+
+   function Make_Signed_Type (Precision : Natural) return Tree;
+   function Make_Unsigned_Type (Precision : Natural) return Tree;
+   procedure Initialize_Sizetypes;
+   procedure Set_Sizetype (Atype : Tree);
+
+   function Host_Integerp (T : Tree; Pos : Integer) return Integer;
+
+   function Chainon (Op1, Op2 : Tree) return Tree;
+   function Listify (Node : Tree) return Tree;
+   function Tree_Cons (Purpose : Tree; Value : Tree; Chain : Tree)
+     return Tree;
+   function Nreverse (Chain : Tree) return Tree;
+   function Build_Tree_List (Purpose : Tree; Value : Tree) return Tree;
+
+   function Size_In_Bytes (Decl : Tree) return Tree;
+   procedure Set_Identifier_Size (Size : Natural);
+
+   function Get_Inner_Reference
+     (Exp : Tree;
+      Pbitsize : Address; --  HOST_WIDE_INT pointer
+      Pbitpos : Address; -- HOST_WIDE_INT pointer
+      Poffset : Address; -- Tree pointer
+      Pmode : Address; -- MACHINE_MODE pointer
+      Punsignedp : Address; -- int pointer
+      Pvolatilep : Address) -- int pointer
+     return Tree;
+
+   Current_Function_Decl : Tree;
+
+   function Integer_Zerop (Expr : Tree) return C_Bool;
+   function Integer_Onep (Expr : Tree) return C_Bool;
+   function Real_Zerop (Expr : Tree) return C_Bool;
+
+   procedure Layout_Type (Atype : Tree);
+   procedure Layout_Decl (Decl : Tree; Align : Natural);
+
+   procedure Expand_Start_Bindings_And_Block (Flags : Integer; Block : Tree);
+   procedure Expand_Start_Bindings (Flags : Integer);
+   procedure Expand_End_Bindings
+     (Vars : Tree; Mark_Ends: C_Bool; Dont_Jump_In : C_Bool);
+
+   procedure Init_Function_Start
+     (Subr : Tree; Filename : Chars; Line : Integer);
+   procedure Expand_Function_Start
+     (Subr : Tree; Parms_Have_Cleanups : C_Bool);
+   procedure Expand_Function_End
+     (Filename : Chars; Line : Integer; End_Bindings : C_Bool);
+   procedure Push_Function_Context;
+   procedure Pop_Function_Context;
+   procedure Put_Var_Into_Stack (Expr : Tree; Rescan : C_Bool);
+   procedure Expand_Null_Return;
+   procedure Expand_Return (Expr : Tree);
+   procedure Expand_Expr_Stmt (Expr : Tree);
+   procedure Expand_Decl (Decl : Tree);
+   procedure Expand_Decl_Init (Decl : Tree);
+
+   function Expand_Exit_Something return Integer;
+
+   --  Conditions (IF).
+   procedure Expand_Start_Cond (Cond : Tree; Has_Exit : C_Bool);
+   procedure Expand_Start_Elseif (Cond : Tree);
+   procedure Expand_Start_Else;
+   procedure Expand_End_Cond;
+
+   --  Loops (FOR, WHILE, DO-WHILE, CONTINUE, EXIT ...)
+   type Nesting is private;
+   Nesting_Null : constant Nesting;
+   function Expand_Start_Loop (Exit_Flag : C_Bool) return Nesting;
+   procedure Expand_Continue_Loop (Which_Loop: Nesting);
+   procedure Expand_End_Loop;
+   function Expand_Start_Loop_Continue_Elsewhere (Exit_Flag : C_Bool)
+     return Nesting;
+   procedure Expand_Loop_Continue_Here;
+   procedure Expand_Exit_Loop (Which_Loop : Nesting);
+   function Expand_Exit_Loop_If_False (Which_Loop : Nesting; Cond : Tree)
+     return Integer;
+
+   --  multibranch (SWITCH).
+   procedure Expand_Start_Case
+     (Exit_Flag : C_Bool; Expr : Tree; Etype : Tree; Printname : Chars);
+   function Pushcase
+     (Value : Tree; Converter : Address; Label : Tree; Duplicate : Address)
+     return Integer;
+   function Pushcase_Range
+     (Low, High : Tree; Converter : Address; Label : Tree; Duplicate : Address)
+     return Integer;
+   function Add_Case_Node (Low, High : Tree; Label : Tree; Duplicate : Address)
+     return Integer;
+   procedure Expand_End_Case_Type (Orig_Index : Tree; Orig_Type : Tree);
+
+   procedure Debug_Tree (T: Tree);
+
+   function Fold (Atree : Tree) return Tree;
+   function Size_Binop (Code : Tree_Code; arg0, Arg1 : Tree) return Tree;
+   function Size_Int (Number : HOST_WIDE_INT) return Tree;
+
+   function Convert (Atype : Tree; Expr : Tree) return Tree;
+
+   --  Create an INTEGER_CST whose value is LOW signed extended to
+   --  2 HOST_WIDE_INT.
+   function Build_Int (Low : HOST_WIDE_INT) return Tree;
+
+   function Get_TREE_CODE (T : Tree) return Tree_Code;
+   procedure Set_TREE_CONSTANT (T : Tree; Val : C_Bool);
+   function Get_TREE_CONSTANT (T : Tree) return C_Bool;
+   procedure Set_TREE_PUBLIC (Decl: Tree; Val : C_Bool);
+   procedure Set_TREE_STATIC (Decl : Tree; Val : C_Bool);
+   procedure Set_TREE_TYPE (Decl : Tree; T : Tree);
+   function Get_TREE_TYPE (Decl : Tree) return Tree;
+   procedure Set_TREE_CHAIN (Decl : Tree; Chain : Tree);
+   function Get_TREE_CHAIN (Decl : Tree) return Tree;
+   procedure Set_TREE_UNSIGNED (Decl : Tree; Val: C_Bool);
+   function Get_TREE_UNSIGNED (Decl : Tree) return C_Bool;
+   procedure Set_TREE_ADDRESSABLE (Decl : Tree; Val: C_Bool);
+   function Get_TREE_ADDRESSABLE (Decl : Tree) return C_Bool;
+   procedure Set_TREE_SIDE_EFFECTS (Decl : Tree; Val: C_Bool);
+   procedure Set_TREE_READONLY (Decl : Tree; Val: C_Bool);
+   procedure Set_TREE_OPERAND (T : Tree; N : Natural; Val : Tree);
+   function Get_TREE_OPERAND (T : Tree; N : Natural) return Tree;
+   procedure Set_TREE_THIS_VOLATILE (T : Tree; Val : C_Bool);
+   function Get_TREE_THIS_VOLATILE (T : Tree) return C_Bool;
+   function Get_TREE_VALUE (Decl : Tree) return Tree;
+   function Get_TREE_PURPOSE (Decl : Tree) return Tree;
+   function Get_TREE_USED (Decl : Tree) return C_Bool;
+   procedure Set_TREE_USED (Decl : Tree; Flag : C_Bool);
+
+   function Get_TREE_INT_CST_LOW (Node : Tree) return HOST_WIDE_INT;
+   function Get_TREE_INT_CST_HIGH (Node : Tree) return HOST_WIDE_INT;
+
+   function Get_CONSTRUCTOR_ELTS (Cons : Tree) return Tree;
+
+   procedure Set_DECL_ARG_TYPE (Decl : Tree; Val : Tree);
+   procedure Set_DECL_EXTERNAL (Decl : Tree; Val : C_Bool);
+   function Get_DECL_EXTERNAL (Decl : Tree) return C_Bool;
+   procedure Set_DECL_ARGUMENTS (Decl : Tree; Args : Tree);
+   function Get_DECL_ARGUMENTS (Decl : Tree) return Tree;
+   procedure Set_DECL_RESULT (Decl : Tree; Res : Tree);
+   function Get_DECL_RESULT (Decl : Tree) return Tree;
+   procedure Set_DECL_CONTEXT (Decl : Tree; Context : Tree);
+   function Get_DECL_CONTEXT (Decl : Tree) return Tree;
+   function Get_DECL_INITIAL (Decl : Tree) return Tree;
+   procedure Set_DECL_INITIAL (Decl : Tree; Init : Tree);
+   function Get_DECL_NAME (Decl : Tree) return Tree;
+   function Get_DECL_ASSEMBLER_NAME (Decl : Tree) return Tree;
+   procedure Set_DECL_ASSEMBLER_NAME (Decl : Tree; Name : Tree);
+   procedure Set_DECL_BUILT_IN_CLASS (Decl : Tree; Class : Built_In_Class);
+   procedure Set_DECL_FUNCTION_CODE (Decl : Tree; Code : Built_In_Function);
+   function Get_DECL_FIELD_OFFSET (Decl : Tree) return Tree;
+   function Get_DECL_FIELD_BIT_OFFSET (Decl : Tree) return Tree;
+
+   procedure Set_TYPE_VALUES (Atype : Tree; Values: Tree);
+   procedure Set_TYPE_NAME (Atype : Tree; Name: Tree);
+   function Get_TYPE_NAME (Atype : Tree) return Tree;
+   procedure Set_TYPE_MIN_VALUE (Atype : Tree; Val: Tree);
+   function Get_TYPE_MIN_VALUE (Atype : Tree) return Tree;
+   procedure Set_TYPE_MAX_VALUE (Atype : Tree; Val: Tree);
+   function Get_TYPE_MAX_VALUE (Atype : Tree) return Tree;
+   procedure Set_TYPE_SIZE (Atype : Tree; Size: Tree);
+   function Get_TYPE_SIZE (Atype : Tree) return Tree;
+   procedure Set_TYPE_PRECISION (Atype : Tree; Precision : Integer);
+   function Get_TYPE_PRECISION (Atype : Tree) return Integer;
+   procedure Set_TYPE_FIELDS (Atype : Tree; Fields : Tree);
+   function Get_TYPE_FIELDS (Atype : Tree) return Tree;
+   procedure Set_TYPE_STUB_DECL (Atype : Tree; Decl : Tree);
+   procedure Set_TYPE_LANG_SPECIFIC (Atype : Tree; Val : System.Address);
+   function Get_TYPE_LANG_SPECIFIC (Atype : Tree) return System.Address;
+   function Get_TYPE_IS_SIZETYPE (Atype : Tree) return C_Bool;
+   function Get_TYPE_DOMAIN (Atype : Tree) return Tree;
+   procedure Set_TYPE_DOMAIN (Atype : Tree; Domain : Tree);
+   function Get_TYPE_SIZE_UNIT (Atype : Tree) return Tree;
+   function Get_TYPE_POINTER_TO (Atype : Tree) return Tree;
+   procedure Set_TYPE_POINTER_TO (Atype : Tree; Dtype : Tree);
+   function INTEGRAL_TYPE_P (Atype : Tree) return C_Bool;
+   procedure Set_TYPE_MODE (Atype : Tree; Mode : Machine_Mode);
+   function Get_TYPE_MODE (Atype : Tree) return Machine_Mode;
+
+   function Get_BLOCK_SUPERCONTEXT (Ablock : Tree) return Tree;
+   procedure Set_BLOCK_SUPERCONTEXT (Ablock : Tree; Sc : Tree);
+   procedure Set_BLOCK_VARS (Ablock : Tree; Vars : Tree);
+
+   function Get_IDENTIFIER_LENGTH (N : Tree) return Integer;
+   function Get_IDENTIFIER_POINTER (N : Tree) return Chars;
+
+   procedure Build_Common_Tree_Nodes (Signed_Char : C_Bool);
+   procedure Build_Common_Tree_Nodes_2 (Short_Double : C_Bool);
+
+   --  Points to the name of the input file from which the current input
+   --  being parsed originally came (before it went into cpp).
+   Input_Filename : Chars;
+
+   Main_Input_Filename : Chars;
+
+   -- Current line number in input file.
+   Lineno : Integer;
+
+   --  sizeof (struct tree_identifier).
+   Tree_Identifier_Size : Natural;
+
+   --  Create DECL_RTL for a declaration for a static or external variable or
+   --  static or external function.
+   procedure Make_Decl_Rtl (Decl : Tree; Asmspec : Chars; Top_Level : C_Bool);
+
+private
+   NULL_TREE : constant Tree := Tree (System.Null_Address);
+
+   type Nesting is new System.Address;
+   Nesting_Null : constant Nesting := Nesting (Null_Address);
+
+   pragma Import (C, Current_Function_Decl);
+   pragma Import (C, Set_Identifier_Size);
+
+   pragma Import (C, Build);
+   pragma Import (C, Build1);
+   pragma Import (C, Build_Constructor);
+   pragma Import (C, Build_Block);
+   pragma Import (C, Build_Decl);
+   pragma Import (C, Build_Int_2);
+   pragma Import (C, Build_Int_2_Wide);
+   pragma Import (C, Build_Real);
+   pragma Import (C, Build_Function_Type);
+   pragma Import (C, Build_Pointer_Type);
+   pragma Import (C, Get_Identifier);
+   pragma Import (C, Build_String);
+   pragma Import (C, Make_Node);
+   pragma Import (C, Build_Index_Type);
+   pragma Import (C, Build_Range_Type);
+   pragma Import (C, Build_Array_Type);
+   pragma Import (C, Build_Qualified_Type);
+   pragma Import (C, Build_Save_Expr, "save_expr");
+
+   pragma Import (C, Make_Signed_Type);
+   pragma Import (C, Make_Unsigned_Type);
+   pragma Import (C, Initialize_Sizetypes);
+   pragma Import (C, Set_Sizetype);
+   pragma Import (C, Host_Integerp);
+
+   pragma Import (C, Chainon);
+   pragma Import (C, Listify);
+   pragma Import (C, Tree_Cons);
+   pragma Import (C, Nreverse);
+   pragma Import (C, Build_Tree_List);
+
+   pragma Import (C, Size_In_Bytes);
+   pragma Import (C, Get_Inner_Reference);
+
+   pragma Import (C, Integer_Zerop);
+   pragma Import (C, Integer_Onep);
+   pragma Import (C, Real_Zerop);
+
+   pragma Import (C, Layout_Type);
+   pragma Import (C, Layout_Decl);
+
+   pragma Import (C, Expand_Start_Bindings_And_Block);
+   pragma Import (C, Expand_End_Bindings);
+
+   pragma Import (C, Init_Function_Start);
+   pragma Import (C, Expand_Function_Start);
+   pragma Import (C, Expand_Function_End);
+   pragma Import (C, Push_Function_Context);
+   pragma Import (C, Pop_Function_Context);
+   pragma Import (C, Put_Var_Into_Stack);
+
+   pragma Import (C, Expand_Null_Return);
+   pragma Import (C, Expand_Return);
+   pragma Import (C, Expand_Expr_Stmt);
+   pragma Import (C, Expand_Decl);
+   pragma Import (C, Expand_Decl_Init);
+
+   pragma Import (C, Expand_Exit_Something);
+
+   pragma Import (C, Expand_Start_Cond);
+   pragma Import (C, Expand_Start_Elseif);
+   pragma Import (C, Expand_Start_Else);
+   pragma Import (C, Expand_End_Cond);
+
+   pragma Import (C, Expand_Start_Loop);
+   pragma Import (C, Expand_Continue_Loop);
+   pragma Import (C, Expand_End_Loop);
+   pragma Import (C, Expand_Start_Loop_Continue_Elsewhere);
+   pragma Import (C, Expand_Loop_Continue_Here);
+   pragma Import (C, Expand_Exit_Loop);
+   pragma Import (C, Expand_Exit_Loop_If_False);
+
+   pragma Import (C, Expand_Start_Case);
+   pragma Import (C, Pushcase);
+   pragma Import (C, Pushcase_Range);
+   pragma Import (C, Add_Case_Node);
+   pragma Import (C, Expand_End_Case_Type);
+
+   pragma Import (C, Debug_Tree);
+
+   pragma Import (C, Fold);
+   pragma Import (C, Size_Binop);
+   pragma Import (C, Size_Int);
+   pragma Import (C, Convert);
+
+   -- Import pragma clauses for C MACROs.
+   pragma Import (C, Get_TREE_CODE);
+   pragma Import (C, Set_TREE_CONSTANT);
+   pragma Import (C, Get_TREE_CONSTANT);
+   pragma Import (C, Set_TREE_PUBLIC);
+   pragma Import (C, Set_TREE_STATIC);
+   pragma Import (C, Set_TREE_TYPE);
+   pragma Import (C, Get_TREE_TYPE);
+   pragma Import (C, Set_TREE_CHAIN);
+   pragma Import (C, Get_TREE_CHAIN);
+   pragma Import (C, Set_TREE_UNSIGNED);
+   pragma Import (C, Get_TREE_UNSIGNED);
+   pragma Import (C, Set_TREE_ADDRESSABLE);
+   pragma Import (C, Get_TREE_ADDRESSABLE);
+   pragma Import (C, Set_TREE_SIDE_EFFECTS);
+   pragma Import (C, Set_TREE_READONLY);
+   pragma Import (C, Get_TREE_OPERAND);
+   pragma Import (C, Set_TREE_OPERAND);
+   pragma Import (C, Get_TREE_THIS_VOLATILE);
+   pragma Import (C, Set_TREE_THIS_VOLATILE);
+   pragma Import (C, Get_TREE_PURPOSE);
+   pragma Import (C, Get_TREE_VALUE);
+   pragma Import (C, Get_TREE_USED);
+   pragma Import (C, Set_TREE_USED);
+
+   pragma Import (C, Get_TREE_INT_CST_LOW);
+   pragma Import (C, Get_TREE_INT_CST_HIGH);
+
+   pragma Import (C, Get_CONSTRUCTOR_ELTS);
+   pragma Import (C, Set_TYPE_VALUES);
+   pragma Import (C, Set_TYPE_NAME);
+   pragma Import (C, Get_TYPE_NAME);
+   pragma Import (C, Set_TYPE_MIN_VALUE);
+   pragma Import (C, Get_TYPE_MIN_VALUE);
+   pragma Import (C, Set_TYPE_MAX_VALUE);
+   pragma Import (C, Get_TYPE_MAX_VALUE);
+   pragma Import (C, Set_TYPE_SIZE);
+   pragma Import (C, Get_TYPE_SIZE);
+   pragma Import (C, Set_TYPE_PRECISION);
+   pragma Import (C, Get_TYPE_PRECISION);
+   pragma Import (C, Set_TYPE_FIELDS);
+   pragma Import (C, Get_TYPE_FIELDS);
+   pragma Import (C, Set_TYPE_STUB_DECL);
+   pragma Import (C, Set_TYPE_LANG_SPECIFIC);
+   pragma Import (C, Get_TYPE_LANG_SPECIFIC);
+   pragma Import (C, Get_TYPE_IS_SIZETYPE);
+   pragma Import (C, Get_TYPE_DOMAIN);
+   pragma Import (C, Set_TYPE_DOMAIN);
+   pragma Import (C, Get_TYPE_POINTER_TO);
+   pragma Import (C, Set_TYPE_POINTER_TO);
+   pragma Import (C, Get_TYPE_SIZE_UNIT);
+   pragma Import (C, INTEGRAL_TYPE_P);
+   pragma Import (C, Set_TYPE_MODE);
+   pragma Import (C, Get_TYPE_MODE);
+
+   pragma Import (C, Set_DECL_ARG_TYPE);
+   pragma Import (C, Set_DECL_EXTERNAL);
+   pragma Import (C, Get_DECL_EXTERNAL);
+   pragma Import (C, Set_DECL_ARGUMENTS);
+   pragma Import (C, Get_DECL_ARGUMENTS);
+   pragma Import (C, Set_DECL_RESULT);
+   pragma Import (C, Get_DECL_RESULT);
+   pragma Import (C, Set_DECL_CONTEXT);
+   pragma Import (C, Get_DECL_CONTEXT);
+   pragma Import (C, Get_DECL_INITIAL);
+   pragma Import (C, Set_DECL_INITIAL);
+   pragma Import (C, Get_DECL_NAME);
+   pragma Import (C, Set_DECL_ASSEMBLER_NAME, "set_DECL_ASSEMBLER_NAME");
+   pragma Import (C, Get_DECL_ASSEMBLER_NAME);
+   pragma Import (C, Set_DECL_BUILT_IN_CLASS);
+   pragma Import (C, Set_DECL_FUNCTION_CODE);
+   pragma Import (C, Get_DECL_FIELD_OFFSET);
+   pragma Import (C, Get_DECL_FIELD_BIT_OFFSET);
+
+   pragma Import (C, Get_BLOCK_SUPERCONTEXT);
+   pragma Import (C, Set_BLOCK_SUPERCONTEXT);
+   pragma Import (C, Set_BLOCK_VARS);
+
+   pragma Import (C, Get_IDENTIFIER_LENGTH);
+   pragma Import (C, Get_IDENTIFIER_POINTER);
+
+   pragma Import (C, Build_Common_Tree_Nodes);
+   pragma Import (C, Build_Common_Tree_Nodes_2);
+
+   pragma Import (C, Input_Filename);
+   pragma Import (C, Main_Input_Filename);
+   pragma Import (C, Lineno);
+
+   pragma Import (C, Tree_Identifier_Size);
+
+   pragma Import (C, Make_Decl_Rtl);
+end Agcc.Trees;
diff --git a/ortho/agcc/agcc.adb b/ortho/agcc/agcc.adb
new file mode 100644
index 000000000..da2fe437e
--- /dev/null
+++ b/ortho/agcc/agcc.adb
@@ -0,0 +1,23 @@
+--  Ada bindings for GCC internals.
+--  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 body Agcc is
+   function "+" (B : C_Bool) return Boolean is
+   begin
+      return B /= C_False;
+   end "+";
+end Agcc;
diff --git a/ortho/agcc/agcc.ads b/ortho/agcc/agcc.ads
new file mode 100644
index 000000000..c21745c03
--- /dev/null
+++ b/ortho/agcc/agcc.ads
@@ -0,0 +1,45 @@
+--  Ada bindings for GCC internals.
+--  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 System;
+with Interfaces.C;
+
+package Agcc is
+   pragma Pure (Agcc);
+
+   subtype Chars is System.Address;
+   NULL_Chars : Chars renames System.Null_Address;
+
+   Nul : constant Character := Character'Val (0);
+
+   --  Names size_t.
+   type Size_T is new Interfaces.C.size_t;
+
+   --  Ada representation of boolean type in C.
+   --  Never compare with C_TRUE, since in C any value different from 0 is
+   --  considered as true.
+   type C_Bool is new Integer;
+   pragma Convention (C, C_Bool);
+
+   subtype C_Boolean is C_Bool range 0 .. 1;
+
+   C_False : constant C_Bool := 0;
+   C_True : constant C_Bool := 1;
+
+   function "+" (B : C_Bool) return Boolean;
+   pragma Inline ("+");
+end Agcc;
diff --git a/ortho/agcc/agcc.sed b/ortho/agcc/agcc.sed
new file mode 100644
index 000000000..9252e4a45
--- /dev/null
+++ b/ortho/agcc/agcc.sed
@@ -0,0 +1,23 @@
+# SED script used to extract lines enclosed in /* BEGIN ... END  */ of a
+# gnatbind C generated files.
+# Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+
+# If the current line starts with /* BEGIN, read next line and go to keep.
+\@/* BEGIN@ {
+ n
+ b keep
+}
+# The current line is discarded, and a the cycle is restarted.
+d
+
+# keep the lines.
+: keep
+# If the current line starts with END, then it is removed and a new cycle is
+# started.
+\@  END@ d
+# Print the current line
+p
+# Read the next line
+n
+# Go to keep.
+b keep
diff --git a/ortho/agcc/c.adb b/ortho/agcc/c.adb
new file mode 100644
index 000000000..1b8863600
--- /dev/null
+++ b/ortho/agcc/c.adb
@@ -0,0 +1,55 @@
+--  Ada bindings for GCC internals.
+--  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.Unchecked_Conversion;
+with System;
+
+package body C is
+   function C_String_Len (Str : C_String) return Natural is
+   begin
+      if Str = null then
+         return 0;
+      end if;
+      for I in Str'Range loop
+         if Str (I) = Character'Val (0) then
+            return I - 1;
+         end if;
+      end loop;
+      raise Program_Error;
+   end C_String_Len;
+
+   function Image (Str : C_Str_Len) return String is
+   begin
+      if Str.Str = null then
+         return ''' & Character'Val (Str.Len) & ''';
+      else
+         return Str.Str (1 .. Str.Len);
+      end if;
+   end Image;
+
+   function To_C_String (Acc : access String) return C_String
+   is
+      function Unchecked_Conversion is new Ada.Unchecked_Conversion
+        (Source => System.Address, Target => C_String);
+   begin
+      --  Check ACC is nul-terminated.
+      if Acc (Acc.all'Last) /= Character'Val (0) then
+         raise Program_Error;
+      end if;
+      return Unchecked_Conversion (Acc (Acc.all'First)'Address);
+   end To_C_String;
+end C;
diff --git a/ortho/agcc/c.ads b/ortho/agcc/c.ads
new file mode 100644
index 000000000..01ff03078
--- /dev/null
+++ b/ortho/agcc/c.ads
@@ -0,0 +1,64 @@
+--  Ada bindings for GCC internals.
+--  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.Unchecked_Conversion;
+with System;
+
+package C is
+   pragma Preelaborate (C);
+
+   --  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);
+
+   --  Convert an address to a C_STRING.
+   function To_C_String is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => C_String);
+
+   --  NULL for a string.
+   C_String_Null : constant C_String;
+
+   --  Convert an Ada access string to a C_String.
+   --  This simply takes the address of the first character of ACC.  This
+   --  is unchecked, so be careful with the life of ACC.
+   --  The last element of the string designated by ACC must be the NUL-char.
+   --  This is a little bit more restrictive than being only NUL-terminated.
+   function To_C_String (Acc : access String) return C_String;
+
+   --  Return the length of a C String (ie, the number of characters before
+   --  the Nul).
+   function C_String_Len (Str : C_String) return Natural;
+
+   --  An (very large) array of C String.  This is the type of ARGV.
+   type C_String_Array is array (Natural) of C_String;
+   pragma Convention (C, C_String_Array);
+
+   --  A structure for a string (len and address).
+   type C_Str_Len is record
+      Len : Natural;
+      Str : C_String;
+   end record;
+   pragma Convention (C_Pass_By_Copy, C_Str_Len);
+
+   type C_Str_Len_Acc is access C_Str_Len;
+
+   function Image (Str : C_Str_Len) return String;
+private
+   C_String_Null : constant C_String := null;
+end C;
diff --git a/ortho/agcc/gen_tree.c b/ortho/agcc/gen_tree.c
new file mode 100644
index 000000000..ff826b408
--- /dev/null
+++ b/ortho/agcc/gen_tree.c
@@ -0,0 +1,575 @@
+/*  Ada bindings for GCC internals - generate Ada 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 GCC; see the file COPYING.  If not, write to the Free
+    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+*/
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "flags.h"
+#include "tree.h"
+#include "real.h"
+#include "options.h"
+#undef abort
+
+static const char *progname;
+
+/* Taken from tree.h.  */
+
+
+#define XSTR(X) #X
+#define STR(X) XSTR(X)
+static const char *treecode_sym[] =
+{
+#define DEFTREECODE(SYM, STRING, TYPE, NARGS)   #SYM,
+#include "tree.def"
+#undef DEFTREECODE
+  NULL
+};
+
+static const char *treecode_string[] =
+{
+#define DEFTREECODE(SYM, STRING, TYPE, NARGS)   STRING,
+#include "tree.def"
+#undef DEFTREECODE
+  NULL
+};
+
+void
+gen_tree_code (void)
+{
+  int i, j;
+  size_t len;
+  const size_t indent = 24;
+
+  for (i = 0; treecode_sym[i] != NULL; i++)
+    {
+      len = strlen (treecode_sym[i]);
+      printf ("      %s, ", treecode_sym[i]);
+      for (j = len; j < indent; j++)
+        putchar (' ');
+      printf ("-- %s\n", treecode_string[i]);
+    }
+  printf ("      LAST_AND_UNUSED_TREE_CODE\n");
+}
+
+static const char *built_in_function_sym[] =
+{
+#if 0
+#define DEF_BUILTIN(x) #x,
+#else
+#define DEF_BUILTIN(ENUM, N, C, T, LT, B, F, NA, ATTR, IMP) #ENUM,
+#endif
+#include "builtins.def"
+#undef DEF_BUILTIN
+  NULL
+};
+
+static void
+print_underscore (const char *sym)
+{
+  for (; *sym != 0; sym++)
+    {
+      if (sym[0] == '_' && (sym[1] == '_' || sym[1] == 0))
+	fputs ("_u", stdout);
+      else
+	fputc (sym[0], stdout);
+    }
+}
+
+void
+gen_built_in_function (void)
+{
+  int i;
+  
+  for (i = 0; built_in_function_sym[i] != NULL; i++)
+    {
+      fputs ("      ", stdout);
+      print_underscore (built_in_function_sym[i]);
+      fputs (",\n", stdout);
+    }
+
+  printf ("      END_BUILTINS\n");
+}
+
+#if 0
+static const char *machmode_sym[] =
+{
+#if 0
+#define DEF_MACHMODE(SYM, NAME, TYPE, BITSIZE, SIZE, UNIT, WIDER)  #SYM,
+#else
+#define DEF_MACHMODE(SYM, NAME, TYPE, BITSIZE, SIZE, UNIT, WIDER, INNER) \
+  #SYM,
+#endif
+#include "machmode.def"
+#undef DEF_MACHMODE
+  NULL
+};
+#endif
+
+static void
+gen_machmode (void)
+{
+  int i;
+  char line[128];
+  FILE *f;
+  int do_emit;
+  char *p;
+
+  f = fopen ("insn-modes.h", "r");
+  if (f == NULL)
+    {
+      fprintf (stderr, "cannot open insn-modes\n");
+      exit (1);
+    }
+
+  do_emit = 0;
+  while (1)
+    {
+      if (fgets (line, sizeof (line), f) == NULL)
+	break;
+      if (!do_emit)
+	{
+	  if (strncmp (line, "enum machine_mode", 17) == 0)
+	    do_emit = 1;
+	}
+      else if (memcmp (line, "  MAX_MACHINE_MODE,", 19) == 0)
+	{
+	  fclose (f);
+	  break;
+	}
+      else	  
+	{
+	  /* Search for "  [A-Z0-9_]*mode,".  */
+	  p = line;
+	  if (p[0] != ' ' || p[1] != ' ')
+	    continue;
+	  p += 2;
+	  while ((*p >= 'A' && *p <= 'Z')
+		 || (*p >= '0' && *p <= '9')
+		 || (*p == '_'))
+	    p++;
+	  if (memcmp (p, "mode,", 5) == 0)
+	    {
+	      p[4] = 0;
+	      printf ("      %s,\n", line + 2);
+	    }
+	}
+
+    }
+  printf ("      MAX_MACHINE_MODE\n");
+}
+
+static void
+gen_options_CL (void)
+{
+  printf ("   CL_C : constant Integer := %d;\n", CL_C);
+  printf ("   CL_vhdl : constant Integer := %d;\n", CL_vhdl);
+}
+
+static void
+gen_options_OPTs (void)
+{
+  char line[128];
+  FILE *f;
+  int do_emit;
+  char *p;
+
+  f = fopen ("options.h", "r");
+  if (f == NULL)
+    {
+      fprintf (stderr, "cannot open options.h\n");
+      exit (1);
+    }
+
+  do_emit = 0;
+  while (1)
+    {
+      if (fgets (line, sizeof (line), f) == NULL)
+	break;
+      if (!do_emit)
+	{
+	  if (strncmp (line, "enum opt_code", 13) == 0)
+	    do_emit = 1;
+	}
+      else if (memcmp (line, "  N_OPTS", 9) == 0)
+	{
+	  fclose (f);
+	  break;
+	}
+      else	  
+	{
+	  /* Search for "  [A-Z0-9]*mode,".  */
+	  p = line;
+	  if (memcmp (p, "  OPT_", 6) != 0)
+	    continue;
+	  printf ("      OPT");
+	  for (p = line + 5; *p != ','; p++)
+	    {
+	      if (p[0] == '_' && (p[1] == ',' || p[1] == '_'))
+		fputs ("_U", stdout);
+	      else
+		{
+		  if (p[0] >= 'A' && p[0] <= 'Z')
+		    putchar ('U');
+		  putchar (p[0]);
+		}
+	    }
+	  printf (",\n");
+	}
+
+    }
+  printf ("       N_OPTS\n");
+}
+
+struct xtab_t
+{
+  int val;
+  const char *name;
+};
+
+void
+gen_enumeration (const struct xtab_t *xtab, int max, const char *max_name)
+{
+  int i;
+
+  for (i = 0; i < max; i++)
+    {
+      const struct xtab_t *t;
+
+      for (t = xtab; t->name; t++)
+        if (t->val == i)
+          break;
+
+      if (t->name == NULL)
+        {
+          fprintf (stderr, "gen_enumeration: kind %d unknown (max is %s)\n",
+		   i, max_name);
+          exit (1);
+        }
+
+      printf ("       %s,\n", t->name);
+    }
+  printf ("      %s\n", max_name);
+}
+
+const struct xtab_t size_type_names[] =
+{
+  { SIZETYPE, "TK_SIZETYPE" },
+  { SSIZETYPE, "TK_SSIZETYPE" },
+  { USIZETYPE, "TK_USIZETYPE" },
+  { BITSIZETYPE, "TK_BITSIZETYPE" },
+  { SBITSIZETYPE, "TK_SBITSIZETYPE" },
+  { UBITSIZETYPE, "TK_UBITSIZETYPE" },
+  { 0, NULL}
+};
+
+static void
+gen_size_type (void)
+{
+  gen_enumeration (size_type_names, TYPE_KIND_LAST, "TYPE_KIND_LAST");
+}
+
+
+const struct xtab_t type_qual_tab[] =
+{
+  { TYPE_UNQUALIFIED, "TYPE_UNQUALIFIED" },
+  { TYPE_QUAL_CONST, "TYPE_QUAL_CONST" },
+  { TYPE_QUAL_VOLATILE, "TYPE_QUAL_VOLATILE" },
+  { TYPE_QUAL_RESTRICT, "TYPE_QUAL_RESTRICT" },
+  { 0, NULL}
+};
+
+void
+gen_type_qual (void)
+{
+  const struct xtab_t *t;
+  for (t = type_qual_tab; t->name; t++)
+    printf ("   %s : constant Type_Qual_Type := %d;\n", t->name, t->val);
+}
+
+const struct xtab_t tree_index_tab[] =
+{
+  /* Defined in tree.h  */
+  { TI_ERROR_MARK, "TI_ERROR_MARK" },
+  { TI_INTQI_TYPE, "TI_INTQI_TYPE" },
+  { TI_INTHI_TYPE, "TI_INTHI_TYPE" },
+  { TI_INTSI_TYPE, "TI_INTSI_TYPE" },
+  { TI_INTDI_TYPE, "TI_INTDI_TYPE" },
+  { TI_INTTI_TYPE, "TI_INTTI_TYPE" },
+
+  { TI_UINTQI_TYPE, "TI_UINTQI_TYPE" },
+  { TI_UINTHI_TYPE, "TI_UINTHI_TYPE" },
+  { TI_UINTSI_TYPE, "TI_UINTSI_TYPE" },
+  { TI_UINTDI_TYPE, "TI_UINTDI_TYPE" },
+  { TI_UINTTI_TYPE, "TI_UINTTI_TYPE" },
+
+  { TI_INTEGER_ZERO, "TI_INTEGER_ZERO" },
+  { TI_INTEGER_ONE, "TI_INTEGER_ONE" },
+  { TI_INTEGER_MINUS_ONE, "TI_INTEGER_MINUS_ONE" },
+  { TI_NULL_POINTER, "TI_NULL_POINTER" },
+
+  { TI_SIZE_ZERO, "TI_SIZE_ZERO" },
+  { TI_SIZE_ONE, "TI_SIZE_ONE" },
+
+  { TI_BITSIZE_ZERO, "TI_BITSIZE_ZERO" },
+  { TI_BITSIZE_ONE, "TI_BITSIZE_ONE" },
+  { TI_BITSIZE_UNIT, "TI_BITSIZE_UNIT" },
+
+  { TI_PUBLIC, "TI_PUBLIC" },
+  { TI_PROTECTED, "TI_PROTECTED" },
+  { TI_PRIVATE, "TI_PRIVATE" },
+
+  { TI_BOOLEAN_FALSE, "TI_BOOLEAN_FALSE" },
+  { TI_BOOLEAN_TRUE, "TI_BOOLEAN_TRUE" },
+
+  { TI_COMPLEX_INTEGER_TYPE, "TI_COMPLEX_INTEGER_TYPE" },
+  { TI_COMPLEX_FLOAT_TYPE, "TI_COMPLEX_FLOAT_TYPE" },
+  { TI_COMPLEX_DOUBLE_TYPE, "TI_COMPLEX_DOUBLE_TYPE" },
+  { TI_COMPLEX_LONG_DOUBLE_TYPE, "TI_COMPLEX_LONG_DOUBLE_TYPE" },
+
+  { TI_FLOAT_TYPE, "TI_FLOAT_TYPE" },
+  { TI_DOUBLE_TYPE, "TI_DOUBLE_TYPE" },
+  { TI_LONG_DOUBLE_TYPE, "TI_LONG_DOUBLE_TYPE" },
+
+  { TI_FLOAT_PTR_TYPE, "TI_FLOAT_PTR_TYPE" },
+  { TI_DOUBLE_PTR_TYPE, "TI_DOUBLE_PTR_TYPE" },
+  { TI_LONG_DOUBLE_PTR_TYPE, "TI_LONG_DOUBLE_PTR_TYPE" },
+  { TI_INTEGER_PTR_TYPE, "TI_INTEGER_PTR_TYPE" },
+
+  { TI_VOID_TYPE, "TI_VOID_TYPE" },
+  { TI_PTR_TYPE, "TI_PTR_TYPE" },
+  { TI_CONST_PTR_TYPE, "TI_CONST_PTR_TYPE" },
+  { TI_SIZE_TYPE, "TI_SIZE_TYPE" },
+  { TI_PTRDIFF_TYPE, "TI_PTRDIFF_TYPE" },
+  { TI_VA_LIST_TYPE, "TI_VA_LIST_TYPE" },
+  { TI_BOOLEAN_TYPE, "TI_BOOLEAN_TYPE" },
+
+  { TI_VOID_LIST_NODE, "TI_VOID_LIST_NODE" },
+
+  { TI_UV4SF_TYPE, "TI_UV4SF_TYPE" },
+  { TI_UV4SI_TYPE, "TI_UV4SI_TYPE" },
+  { TI_UV8HI_TYPE, "TI_UV8HI_TYPE" },
+  { TI_UV8QI_TYPE, "TI_UV8QI_TYPE" },
+  { TI_UV4HI_TYPE, "TI_UV4HI_TYPE" },
+  { TI_UV2HI_TYPE, "TI_UV2HI_TYPE" },
+  { TI_UV2SI_TYPE, "TI_UV2SI_TYPE" },
+  { TI_UV2SF_TYPE, "TI_UV2SF_TYPE" },
+  { TI_UV2DI_TYPE, "TI_UV2DI_TYPE" },
+  { TI_UV1DI_TYPE, "TI_UV1DI_TYPE" },
+  { TI_UV16QI_TYPE, "TI_UV16QI_TYPE" },
+
+  { TI_V4SF_TYPE, "TI_V4SF_TYPE" },
+  { TI_V16SF_TYPE, "TI_V16SF_TYPE" },
+  { TI_V4SI_TYPE, "TI_V4SI_TYPE" },
+  { TI_V8HI_TYPE, "TI_V8HI_TYPE" },
+  { TI_V8QI_TYPE, "TI_V8QI_TYPE" },
+  { TI_V4HI_TYPE, "TI_V4HI_TYPE" },
+  { TI_V2HI_TYPE, "TI_V2HI_TYPE" },
+  { TI_V2SI_TYPE, "TI_V2SI_TYPE" },
+  { TI_V2SF_TYPE, "TI_V2SF_TYPE" },
+  { TI_V2DF_TYPE, "TI_V2DF_TYPE" },
+  { TI_V2DI_TYPE, "TI_V2DI_TYPE" },
+  { TI_V1DI_TYPE, "TI_V1DI_TYPE" },
+  { TI_V16QI_TYPE, "TI_V16QI_TYPE" },
+  { TI_V4DF_TYPE, "TI_V4DF_TYPE" },
+
+  { TI_MAIN_IDENTIFIER, "TI_MAIN_IDENTIFIER" },
+
+  { 0, NULL }
+};
+
+const struct xtab_t integer_types_tab[] =
+{
+  { itk_char, "itk_char" },
+  { itk_signed_char, "itk_signed_char" },
+  { itk_unsigned_char, "itk_unsigned_char" },
+  { itk_short, "itk_short" },
+  { itk_unsigned_short, "itk_unsigned_short" },
+  { itk_int, "itk_int" },
+  { itk_unsigned_int, "itk_unsigned_int" },
+  { itk_long, "itk_long" },
+  { itk_unsigned_long, "itk_unsigned_long" },
+  { itk_long_long, "itk_long_long" },
+  { itk_unsigned_long_long, "itk_unsigned_long_long" },
+  { 0, NULL }
+};
+
+
+void
+gen_tree_index (void)
+{
+  gen_enumeration (tree_index_tab, TI_MAX, "TI_MAX");
+}
+
+void
+gen_integer_types (void)
+{
+  gen_enumeration (integer_types_tab, itk_none, "itk_none");
+}
+
+static void
+gen_host_wide_int_decl (void)
+{
+  int l;
+  switch (sizeof (HOST_WIDE_INT))
+    {
+    case 4:
+      l = 32;
+      break;
+    case 8:
+      l = 64;
+      break;
+    default:
+      fprintf (stderr, "%s: cannot handle sizeof (HOST_WIDE_INT) %d\n",
+	       progname, sizeof (HOST_WIDE_INT));
+      exit (1);
+    }
+  printf ("   type HOST_WIDE_INT is new Interfaces.Integer_%d;\n", l);
+  printf ("   type UNSIGNED_HOST_WIDE_INT is new Interfaces.Unsigned_%d;\n",
+	  l);
+}
+
+static void
+gen_host_big_endian (void)
+{
+#ifdef HOST_WORDS_BIG_ENDIAN
+  printf ("   HOST_WORDS_BIG_ENDIAN : constant Boolean := True;\n");
+#else
+  printf ("   HOST_WORDS_BIG_ENDIAN : constant Boolean := False;\n");
+#endif
+}
+
+static void
+gen_real (void)
+{
+  printf ("   type Real_Value_Type_Arr is array (0 .. %d) of HOST_WIDE_INT;\n",
+	  (sizeof (REAL_VALUE_TYPE) / sizeof (HOST_WIDE_INT)) - 1);
+  printf ("   type REAL_VALUE_TYPE is record\n"
+	  "      r : Real_Value_Type_Arr;\n"
+	  "   end record;\n");
+}
+
+static void
+gen_tm (void)
+{
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD  BITS_PER_WORD
+#endif
+  /* This is a constant.  */
+  printf ("   MAX_BITS_PER_WORD : constant Natural := %d;\n",
+	  MAX_BITS_PER_WORD);
+}
+
+int
+main (int argc, char *argv[])
+{
+  FILE *infile;
+  char line[2048];
+  const char *filename;
+  int c;
+
+  progname = argv[0];
+
+  while ((c = getopt (argc, argv, "C:")) != -1)
+    switch (c)
+      {
+      case 'C':
+	chdir (optarg);
+	break;
+      case '?':
+	fprintf (stderr, "%s: unknown option '%s'\n", progname, optopt);
+	exit (1);
+      default:
+	abort ();
+      }
+
+  if (argc - optind != 1)
+    {
+      fprintf (stderr, "usage: %s FILENAME\n", progname);
+      exit (1);
+    }
+  filename = argv[optind];
+  if (strcmp (filename, "-") == 0)
+    infile = stdin;
+  else
+    infile = fopen (filename, "r");
+  if (infile == NULL)
+    {
+      fprintf (stderr, "%s: cannot open %s (%s)\n", progname, filename,
+               strerror (errno));
+      exit (1);
+    }
+#if 0
+#ifdef REAL_IS_NOT_DOUBLE
+  printf ("-- REAL_IS_NOT_DOUBLE is not yet implemented\n");
+  printf ("You loose\n");
+  return 1;
+#endif
+#endif
+  printf ("--  Automatically generated by %s\n", progname);
+  printf ("--    from %s\n", filename);
+  printf ("--  DO NOT EDIT THIS FILE\n");
+
+  while (fgets (line, sizeof (line), infile) != NULL)
+    {
+      if (line[0] != '@')
+        fputs (line, stdout);
+      else
+        {
+          char *p;
+
+          for (p = line + 1; isalpha (*p) || *p == '_'; p++)
+            ;
+          *p = 0;
+
+          if (!strcmp (line, "@tree_code"))
+            gen_tree_code ();
+	  else if (!strcmp (line, "@built_in_function"))
+	    gen_built_in_function ();
+          else if (!strcmp (line, "@size_type_kind"))
+            gen_size_type ();
+          else if (!strcmp (line, "@type_qual"))
+            gen_type_qual ();
+          else if (!strcmp (line, "@host_wide_int"))
+            gen_host_wide_int_decl ();
+          else if (!strcmp (line, "@tree_index"))
+            gen_tree_index ();
+          else if (!strcmp (line, "@integer_types"))
+            gen_integer_types ();
+          else if (!strcmp (line, "@host_big_endian"))
+	    gen_host_big_endian ();
+          else if (!strcmp (line, "@real"))
+	    gen_real ();
+          else if (!strcmp (line, "@machmode"))
+	    gen_machmode ();
+          else if (!strcmp (line, "@tm"))
+	    gen_tm ();
+	  else if (!strcmp (line, "@options_CL"))
+	    gen_options_CL ();
+	  else if (!strcmp (line, "@options_OPTs"))
+	    gen_options_OPTs ();
+          else
+            {
+              fprintf (stderr, "unknown code `%s'\n", line);
+              exit (1);
+            }
+        }
+    }
+  return 0;
+}
diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile
new file mode 100644
index 000000000..9f8b327a8
--- /dev/null
+++ b/ortho/gcc/Makefile
@@ -0,0 +1,50 @@
+#  Makefile of ortho implementation 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.
+ortho_srcdir=..
+orthobe_srcdir=$(ortho_srcdir)/gcc
+agcc_srcdir=$(ortho_srcdir)/agcc
+agcc_objdir=.
+AGCC_GCCSRC_DIR:=$(HOME)/dist/gcc-3.4.3
+AGCC_GCCOBJ_DIR:=$(AGCC_GCCSRC_DIR)-objs
+SED=sed
+
+all: $(ortho_exec)
+
+include $(agcc_srcdir)/Makefile.inc
+
+ORTHO_BASENAME=$(orthobe_srcdir)/ortho_gcc
+ORTHO_PACKAGE=Ortho_Gcc
+
+include $(ortho_srcdir)/Makefile.inc
+
+$(ortho_exec): $(AGCC_DEPS) $(ORTHO_BASENAME).ads force
+	gnatmake -m -o $@ -g -aI$(agcc_srcdir) -aI$(ortho_srcdir) \
+	 -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \
+	 -bargs -E -largs $(AGCC_OBJS) #-static
+
+clean: agcc-clean
+	$(RM) -f *.o *.ali ortho_nodes-main
+	$(RM) b~*.ad? *~
+
+distclean: clean agcc-clean
+
+
+force:
+
+.PHONY: force all clean
+
diff --git a/ortho/gcc/agcc-fe.adb b/ortho/gcc/agcc-fe.adb
new file mode 100644
index 000000000..75ba79549
--- /dev/null
+++ b/ortho/gcc/agcc-fe.adb
@@ -0,0 +1,776 @@
+--  Ortho implementation 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 Ada.Unchecked_Deallocation;
+--with Agcc.Ggc; use Agcc.Ggc;
+with Agcc.Tm; use Agcc.Tm;
+with Agcc.Machmode; use Agcc.Machmode;
+with Agcc.Diagnostic;
+with Agcc.Input; use Agcc.Input;
+with Agcc.Options; use Agcc.Options;
+with Ortho_Gcc;
+with Ortho_Gcc_Front; use Ortho_Gcc_Front;
+
+package body Agcc.Fe is
+   File_Name : String_Acc;
+
+   Stdin_Filename : String_Acc := new String'("*stdin*" & Nul);
+
+   function Lang_Init_Options (Argc : Integer; Argv : C_String_Array)
+                              return Integer
+   is
+      pragma Unreferenced (Argc);
+      pragma Unreferenced (Argv);
+   begin
+      return CL_vhdl;
+   end Lang_Init_Options;
+
+   function Lang_Handle_Option (Code : Opt_Code;
+                                Arg : C_String;
+                                Value : Integer)
+     return Integer
+   is
+      pragma Unreferenced (Value);
+      --type String_Acc_Array_Acc is access String_Acc_Array;
+
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Name => String_Acc, Object => String);
+      --procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+      --  (Name => String_Acc_Array_Acc, Object => String_Acc_Array);
+
+      --C_Opt : C_String := Argv (0);
+      --C_Arg : C_String;
+      --Opt : String := C_Opt (1 .. C_String_Len (C_Opt));
+      Res : Natural;
+      Opt : String_Acc;
+      Opt_Arg : String_Acc;
+      Len : Natural;
+   begin
+      if Arg /= C_String_Null then
+         Len := C_String_Len (Arg);
+      else
+         Len := 0;
+      end if;
+      Opt_Arg := null;
+      case Code is
+         when OPT_U_std_U =>
+            Opt := new String'("--std=" & Arg (1 .. Len));
+         when OPT_U_compile_standard =>
+            Opt := new String'("--compile-standard");
+         when OPT_U_bootstrap =>
+            Opt := new String'("--bootstrap");
+         when OPT_U_work_U =>
+            Opt := new String'("--work=" & Arg (1 .. Len));
+         when OPT_U_workdir_U =>
+            Opt := new String'("--workdir=" & Arg (1 .. Len));
+         when OPT_UP =>
+            Opt := new String'("-P" & Arg (1 .. Len));
+         when OPT_U_elab =>
+            Opt := new String'("--elab");
+            Opt_Arg := new String'(Arg (1 .. Len));
+         when OPT_U_anaelab =>
+            Opt := new String'("--anaelab");
+            Opt_Arg := new String'(Arg (1 .. Len));
+         when OPT_l =>
+            Opt := new String'("-l");
+            Opt_Arg := new String'(Arg (1 .. Len));
+         when OPT_c =>
+            Opt := new String'("-c");
+            Opt_Arg := new String'(Arg (1 .. Len));
+         when OPT_U_ghdl  =>
+            Opt := new String'(Arg (1 .. Len));
+         when OPT_U_warn_U  =>
+            Opt := new String'("--warn-" & Arg (1 .. Len));
+         when OPT_U_expect_failure =>
+            Opt := new String'("--expect-failure");
+         when OPT_U_no_vital_checks =>
+            Opt := new String'("--no-vital-checks");
+         when OPT_U_vital_checks =>
+            Opt := new String'("--vital-checks");
+         when OPT_fexplicit =>
+            Opt := new String'("-fexplicit");
+         when OPT_v =>
+            Opt := new String'("-v");
+         when others =>
+            return 0;
+      end case;
+      Res := Ortho_Gcc_Front.Decode_Option (Opt, Opt_Arg);
+      Unchecked_Deallocation (Opt);
+      Unchecked_Deallocation (Opt_Arg);
+      return Res;
+   end Lang_Handle_Option;
+
+   function Lang_Post_Options (Filename : C_String_Acc) return C_Bool
+   is
+      Filename_Len : Natural;
+   begin
+      if Filename.all = C_String_Null then
+         File_Name := null;
+         Filename.all := To_C_String (Stdin_Filename);
+      else
+         Filename_Len := C_String_Len (Filename.all);
+         File_Name := new String'(Filename.all (1 .. Filename_Len));
+      end if;
+
+      --  Run the back-end.
+      return C_False;
+   end Lang_Post_Options;
+
+
+   procedure Lang_Parse_File (Debug : C_Bool)
+   is
+      pragma Unreferenced (Debug);
+   begin
+      if not Ortho_Gcc_Front.Parse (File_Name) then
+         Agcc.Diagnostic.Set_Errorcount (1);
+      end if;
+   end Lang_Parse_File;
+
+   function Lang_Get_Alias_Set (T : Tree) return HOST_WIDE_INT
+   is
+      pragma Unreferenced (T);
+   begin
+      return -1;
+   end Lang_Get_Alias_Set;
+
+   --function Lang_Safe_From_P (Target : Rtx; Exp : Tree) return Boolean;
+
+   function Mark_Addressable (Exp : Tree) return C_Bool
+   is
+      N : Tree;
+      Code : Tree_Code;
+   begin
+      N := Exp;
+      loop
+         Code := Get_TREE_CODE (N);
+         case Code is
+            when VAR_DECL
+              | CONST_DECL
+              | PARM_DECL
+              | RESULT_DECL =>
+               Put_Var_Into_Stack (N, C_True);
+               Set_TREE_ADDRESSABLE (N, C_True);
+               return C_True;
+
+            when COMPONENT_REF
+              | ARRAY_REF =>
+               N := Get_TREE_OPERAND (N, 0);
+
+            when FUNCTION_DECL
+              | CONSTRUCTOR =>
+               Set_TREE_ADDRESSABLE (N, C_True);
+               return C_True;
+
+            when INDIRECT_REF =>
+               return C_True;
+
+            when others =>
+               raise Program_Error;
+         end case;
+      end loop;
+   end Mark_Addressable;
+
+   procedure Insert_Default_Attributes (Func : Tree)
+   is
+      pragma Unreferenced (Func);
+   begin
+      null;
+   end Insert_Default_Attributes;
+
+   --  These functions and variables deal with binding contours.
+
+   --  For each binding contour we allocate a binding_level structure which
+   --  records the entities defined or declared in that contour.
+   --  Contours include:
+   --
+   --     the global one
+   --     one for each subprogram definition
+   --     one for each compound statement (declare block)
+   --
+   --  Binding contours are used to create GCC tree BLOCK nodes.
+
+   --  BE CAREFUL: this structure is also declared in agcc-bindings.c
+   type Binding_Level;
+   type Binding_Level_Acc is access Binding_Level;
+   type Binding_Level is record
+      --  A chain of ..._DECL nodes for all variables, constants, functions,
+      --  parameters and type declarations.  These ..._DECL nodes are chained
+      --  through the TREE_CHAIN field. Note that these ..._DECL nodes are
+      --  stored in the reverse of the order supplied to be compatible with
+      --  the back-end.
+      Names : Tree;
+
+      --  For each level (except the global one), a chain of BLOCK nodes for
+      --  all the levels that were entered and exited one level down from this
+      --  one.
+      Blocks : Tree;
+
+      --  The back end may need, for its own internal processing, to create a
+      --  BLOCK node. This field is set aside for this purpose. If this field
+      --  is non-null when the level is popped, i.e. when poplevel is invoked,
+      --  we will use such block instead of creating a new one from the
+      --  'names' field, that is the ..._DECL nodes accumulated so far.
+      --  Typically the routine 'pushlevel' will be called before setting this
+      --  field, so that if the front-end had inserted ..._DECL nodes in the
+      --  current block they will not be lost.
+      Block_Created_By_Back_End : Tree;
+
+      --  The binding level containing this one (the enclosing binding level).
+      Level_Chain : Binding_Level_Acc;
+   end record;
+   pragma Convention (C, Binding_Level_Acc);
+   pragma Convention (C, Binding_Level);
+
+   --  The binding level currently in effect.
+   Current_Binding_Level : Binding_Level_Acc := null;
+   pragma Export (C, Current_Binding_Level);
+
+   --  The outermost binding level. This binding level is created when the
+   --  compiler is started and it will exist through the entire compilation.
+   Global_Binding_Level : Binding_Level_Acc;
+
+   --  Chain of unused binding levels, since they are never deallocated.
+   Old_Binding_Level : Binding_Level_Acc := null;
+   pragma Export (C, Old_Binding_Level);
+
+   function Alloc_Binding_Level return Binding_Level_Acc;
+   pragma Import (C, Alloc_Binding_Level);
+
+   -- Binding level structures are initialized by copying this one.
+   Clear_Binding_Level : constant Binding_Level :=
+     (Names => NULL_TREE,
+      Blocks => NULL_TREE,
+      Block_Created_By_Back_End => NULL_TREE,
+      Level_Chain => null);
+
+   -- Return non-zero if we are currently in the global binding level.
+   function Global_Bindings_P return Integer is
+   begin
+      if Current_Binding_Level = Global_Binding_Level then
+         return 1;
+      else
+         return 0;
+      end if;
+   end Global_Bindings_P;
+
+   --  Return the list of declarations in the current level. Note that this
+   --  list is in reverse order (it has to be so for back-end compatibility).
+   function Getdecls return Tree is
+   begin
+      return Current_Binding_Level.Names;
+   end Getdecls;
+
+   --  Nonzero if the current level needs to have a BLOCK made.
+--    function Kept_Level_P return Boolean is
+--    begin
+--       return Current_Binding_Level.Names /= NULL_TREE;
+--    end Kept_Level_P;
+
+   --  Enter a new binding level. The input parameter is ignored, but has to
+   --  be specified for back-end compatibility.
+   procedure Pushlevel (Inside : C_Bool)
+   is
+      pragma Unreferenced (Inside);
+      Newlevel : Binding_Level_Acc;
+
+   begin
+      if Old_Binding_Level /= null then
+         Newlevel := Old_Binding_Level;
+         Old_Binding_Level := Old_Binding_Level.Level_Chain;
+      else
+         Newlevel := Alloc_Binding_Level;
+      end if;
+      Newlevel.all := Clear_Binding_Level;
+
+      --  Add this level to the front of the chain (stack) of levels that are
+      --  active.
+      Newlevel.Level_Chain := Current_Binding_Level;
+      Current_Binding_Level := Newlevel;
+   end Pushlevel;
+
+   --  Exit a binding level.
+   --  Pop the level off, and restore the state of the identifier-decl mappings
+   --  that were in effect when this level was entered.
+   --
+   --  If KEEP is nonzero, this level had explicit declarations, so
+   --  and create a "block" (a BLOCK node) for the level
+   --  to record its declarations and subblocks for symbol table output.
+   --
+   --  If FUNCTIONBODY is nonzero, this level is the body of a function,
+   --  so create a block as if KEEP were set and also clear out all
+   --  label names.
+   --
+   --  If REVERSE is nonzero, reverse the order of decls before putting
+   --  them into the BLOCK.
+   function Exported_Poplevel
+     (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool)
+     return Tree
+   is
+      --  Points to a BLOCK tree node. This is the BLOCK node construted for
+      --  the binding level that we are about to exit and which is returned
+      --  by this routine.
+      Block_Node : Tree := NULL_TREE;
+
+      Decl_Chain : Tree;
+      Subblock_Chain : Tree;
+      Subblock_Node : Tree;
+      Block_Created_By_Back_End : Tree;
+
+      N : Tree;
+      Tmp : Binding_Level_Acc;
+   begin
+      Decl_Chain := Current_Binding_Level.Names;
+      Block_Created_By_Back_End :=
+        Current_Binding_Level.Block_Created_By_Back_End;
+      Subblock_Chain := Current_Binding_Level.Blocks;
+
+      --  Pop the current level, and save it on the chain of old binding
+      --  levels.
+      Tmp := Current_Binding_Level;
+      Current_Binding_Level := Tmp.Level_Chain;
+      Tmp.Level_Chain := Old_Binding_Level;
+      Old_Binding_Level := Tmp;
+
+      --  Reverse the list of XXXX_DECL nodes if desired.  Note that
+      --  the ..._DECL nodes chained through the `names' field of
+      --  current_binding_level are in reverse order except for PARM_DECL node,
+      --  which are explicitely stored in the right order.
+      if Revers /= C_False then
+         Decl_Chain := Nreverse (Decl_Chain);
+      end if;
+
+      if Block_Created_By_Back_End /= NULL_TREE then
+         Block_Node := Block_Created_By_Back_End;
+
+         --  Check if we are about to discard some information that was
+         --  gathered by the front-end. Nameley check if the back-end created
+         --  a new block without calling pushlevel first. To understand why
+         --  things are lost just look at the next case (i.e. no block
+         --  created by back-end.  */
+         if (Keep /= C_False or Functionbody /= C_False)
+           and then (Decl_Chain /= NULL_TREE or Subblock_Chain /= NULL_TREE)
+         then
+            raise Program_Error;
+         end if;
+      elsif Keep /= C_False or Functionbody /= C_False then
+         --  If there were any declarations in the current binding level, or if
+         --  this binding level is a function body, or if there are any nested
+         --  blocks then create a BLOCK node to record them for the life of
+         --  this function.
+         if Keep /= C_False then
+            N := Decl_Chain;
+         else
+            N := NULL_TREE;
+         end if;
+         Block_Node := Build_Block
+           (N, NULL_TREE, Subblock_Chain, NULL_TREE, NULL_TREE);
+      end if;
+
+      --  Record the BLOCK node just built as the subblock its enclosing scope.
+      Subblock_Node := Subblock_Chain;
+      while Subblock_Node /= NULL_TREE loop
+         Set_BLOCK_SUPERCONTEXT (Subblock_Node, Block_Node);
+         Subblock_Node := Get_TREE_CHAIN (Subblock_Node);
+      end loop;
+
+      --  Clear out the meanings of the local variables of this level.
+      Subblock_Node := Decl_Chain;
+      while Subblock_Node /= NULL_TREE loop
+
+         if Get_DECL_NAME (Subblock_Node) /= NULL_TREE then
+            --  If the identifier was used or addressed via a local
+            --  extern decl, don't forget that fact.
+            if Get_DECL_EXTERNAL (Subblock_Node) /= C_False then
+               if Get_TREE_USED (Subblock_Node) /= C_False then
+                  Set_TREE_USED (Get_DECL_NAME (Subblock_Node), C_True);
+               end if;
+               if Get_TREE_ADDRESSABLE (Subblock_Node) /= C_False then
+                  Set_TREE_ADDRESSABLE
+                    (Get_DECL_ASSEMBLER_NAME (Subblock_Node), C_True);
+               end if;
+            end if;
+         end if;
+         Subblock_Node := Get_TREE_CHAIN (Subblock_Node);
+      end loop;
+
+      if Functionbody /= C_False then
+         --  This is the top level block of a function. The ..._DECL chain
+         --  stored in BLOCK_VARS are the function's parameters (PARM_DECL
+         --  nodes). Don't leave them in the BLOCK because they are found
+         --  in the FUNCTION_DECL instead.
+         Set_DECL_INITIAL (Current_Function_Decl, Block_Node);
+         Set_BLOCK_VARS (Block_Node, NULL_TREE);
+      elsif Block_Node /= NULL_TREE then
+         if Block_Created_By_Back_End = NULL_TREE then
+            Current_Binding_Level.Blocks
+              := Chainon (Current_Binding_Level.Blocks, Block_Node);
+         end if;
+      elsif Subblock_Chain /= NULL_TREE then
+         --  If we did not make a block for the level just exited, any blocks
+         --  made for inner levels (since they cannot be recorded as subblocks
+         --  in that level) must be carried forward so they will later become
+         --  subblocks of something else.
+         Current_Binding_Level.Blocks
+           := Chainon (Current_Binding_Level.Blocks, Subblock_Chain);
+      end if;
+
+      if Block_Node /= NULL_TREE then
+         Set_TREE_USED (Block_Node, C_True);
+      end if;
+
+      return Block_Node;
+   end Exported_Poplevel;
+
+   --  Insert BLOCK at the end of the list of subblocks of the
+   --  current binding level.  This is used when a BIND_EXPR is expanded,
+   --  to handle the BLOCK node inside the BIND_EXPR.
+   procedure Insert_Block (Block : Tree) is
+   begin
+      Set_TREE_USED (Block, C_True);
+      Current_Binding_Level.Blocks
+        := Chainon (Current_Binding_Level.Blocks, Block);
+   end Insert_Block;
+
+   --  Set the BLOCK node for the innermost scope (the one we are
+   --  currently in).
+   procedure Set_Block (Block : Tree) is
+   begin
+      Current_Binding_Level.Block_Created_By_Back_End := Block;
+   end Set_Block;
+
+   --  Records a ..._DECL node DECL as belonging to the current lexical scope.
+   --  Returns the ..._DECL node.
+   function Exported_Pushdecl (Decl : Tree) return Tree
+   is
+   begin
+      --  External objects aren't nested, other objects may be.
+      if Get_DECL_EXTERNAL (Decl) /= C_False then
+         Set_DECL_CONTEXT (Decl, NULL_TREE);
+      else
+         Set_DECL_CONTEXT (Decl, Current_Function_Decl);
+      end if;
+
+      --  Put the declaration on the list.  The list of declarations is in
+      --  reverse order. The list will be reversed later if necessary.  This
+      --  needs to be this way for compatibility with the back-end.
+      Set_TREE_CHAIN (Decl, Current_Binding_Level.Names);
+      Current_Binding_Level.Names := Decl;
+
+      -- For the declaration of a type, set its name if it is not already set.
+      if Get_TREE_CODE (Decl) = TYPE_DECL
+        and then Get_TYPE_NAME (Get_TREE_TYPE (Decl)) = NULL_TREE
+      then
+         Set_TYPE_NAME (Get_TREE_TYPE (Decl), Decl); -- DECL_NAME (decl);
+      end if;
+
+      return Decl;
+   end Exported_Pushdecl;
+
+   --  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.
+   type Signed_And_Unsigned_Types_Array_Type is
+     array (Natural range 0 .. MAX_BITS_PER_WORD, C_Boolean) of Tree;
+   Signed_And_Unsigned_Types : Signed_And_Unsigned_Types_Array_Type :=
+     (others => (others => NULL_TREE));
+   pragma Export (C, Signed_And_Unsigned_Types);
+
+   --  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.
+   function Type_For_Size (Precision : Natural; Unsignedp : C_Bool)
+     return Tree
+   is
+      T : Tree;
+   begin
+      if Precision <= MAX_BITS_PER_WORD
+        and then Signed_And_Unsigned_Types (Precision, Unsignedp) /= NULL_TREE
+      then
+         return Signed_And_Unsigned_Types (Precision, Unsignedp);
+      end if;
+
+      if Unsignedp /= C_False then
+         T := Make_Unsigned_Type (Precision);
+      else
+         T := Make_Signed_Type (Precision);
+      end if;
+      if Precision <= MAX_BITS_PER_WORD then
+         Signed_And_Unsigned_Types (Precision, Unsignedp) := T;
+      end if;
+      return T;
+   end Type_For_Size;
+
+   --  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+   --  an unsigned type; otherwise a signed type is returned.
+   function Type_For_Mode (Mode : Machine_Mode; Unsignedp : C_Bool)
+     return Tree
+   is
+   begin
+      return Type_For_Size (GET_MODE_BITSIZE (Mode), Unsignedp);
+   end Type_For_Mode;
+
+   --  Return the unsigned version of a TYPE_NODE, a scalar type.
+   function Unsigned_Type (Type_Node : Tree) return Tree
+   is
+   begin
+      return Type_For_Size (Get_TYPE_PRECISION (Type_Node), C_True);
+   end Unsigned_Type;
+
+   --  Return the signed version of a TYPE_NODE, a scalar type.
+   function Signed_Type (Type_Node : Tree) return Tree
+   is
+   begin
+      return Type_For_Size (Get_TYPE_PRECISION (Type_Node), C_False);
+   end Signed_Type;
+
+   --  Return a type the same as TYPE except unsigned or signed according to
+   --  UNSIGNEDP.
+   function Signed_Or_Unsigned_Type (Unsignedp : C_Bool; Atype : Tree)
+     return Tree
+   is
+   begin
+      if INTEGRAL_TYPE_P (Atype) = C_False
+        or else Get_TREE_UNSIGNED (Atype) = Unsignedp
+      then
+         return Atype;
+      else
+         return Type_For_Size (Get_TYPE_PRECISION (Atype), Unsignedp);
+      end if;
+   end Signed_Or_Unsigned_Type;
+
+
+   --procedure Init_Type_For_Size;
+   --pragma Import (C, Init_Type_For_Size);
+
+   Int_Str : constant String := "int" & Nul;
+   Char_Str : constant String := "char" & Nul;
+
+   Builtin_Alloca_Str : constant String := "__builtin_alloca" & Nul;
+
+   function Lang_Init return C_Bool
+   is
+      --File : String renames Filename (1 .. Filename_Len);
+      Ptr_Ftype_Sizetype : Tree;
+      Alloca_Function : Tree;
+   begin
+      --Error_Mark_Node := Make_Node (ERROR_MARK);
+      --Set_TREE_TYPE (Error_Mark_Node, Error_Mark_Node);
+
+      --Initialize_Sizetypes;
+
+      --  The structure `tree_identifier' is the GCC tree data structure that
+      --  holds IDENTIFIER_NODE nodes. We need to call `set_identifier_size'
+      --  to tell GCC that we have not added any language specific fields to
+      --  IDENTIFIER_NODE nodes.
+      --Set_Identifier_Size (Tree_Identifier_Size);
+      Input_Location.Line := 0;
+
+      -- Make the binding_level structure for global names.
+      Pushlevel (C_False);
+      Global_Binding_Level := Current_Binding_Level;
+
+      Build_Common_Tree_Nodes (C_False);
+      Pushdecl (Build_Decl (TYPE_DECL, Get_Identifier (Int_Str'Address),
+                            Integer_Type_Node));
+      Pushdecl (Build_Decl (TYPE_DECL, Get_Identifier (Char_Str'Address),
+                            Char_Type_Node));
+      Set_Sizetype (Unsigned_Type_Node);
+      Build_Common_Tree_Nodes_2 (C_False);
+
+      --Init_Type_For_Size;
+
+      --  Create alloc builtin.
+      Ptr_Ftype_Sizetype := Build_Function_Type
+        (Ptr_Type_Node,
+         Tree_Cons (NULL_TREE, Get_TYPE_DOMAIN (Sizetype), NULL_TREE));
+      Alloca_Function := Builtin_Function
+        (Builtin_Alloca_Str'Address, Ptr_Ftype_Sizetype,
+         BUILT_IN_ALLOCA, BUILT_IN_NORMAL, System.Null_Address);
+      Ortho_Gcc.Alloca_Function_Ptr := Build1
+        (ADDR_EXPR, Build_Pointer_Type (Ptr_Ftype_Sizetype), Alloca_Function);
+--        Ggc_Add_Tree_Root (Ortho_Gcc.Alloca_Function_Ptr'Address, 1);
+
+      Ortho_Gcc.Init;
+
+      --  Continue.
+      return C_True;
+   end Lang_Init;
+
+   procedure Lang_Finish is
+   begin
+      null;
+   end Lang_Finish;
+
+   --  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.
+   function Builtin_Function
+     (Name: System.Address;
+      Ftype : Tree;
+      Function_Code : Built_In_Function;
+      Class : Built_In_Class;
+      Library_Name : System.Address)
+     return Tree
+   is
+      use System;
+      Decl : Tree;
+   begin
+      Decl := Build_Decl (FUNCTION_DECL, Get_Identifier (Name), Ftype);
+      Set_DECL_EXTERNAL (Decl, C_True);
+      Set_TREE_PUBLIC (Decl, C_True);
+      if Library_Name /= Null_Address then
+         Set_DECL_ASSEMBLER_NAME (Decl, Get_Identifier (Library_Name));
+      end if;
+      Make_Decl_Rtl (Decl, NULL_Chars, C_True);
+      Pushdecl (Decl);
+      Set_DECL_BUILT_IN_CLASS (Decl, Class);
+      Set_DECL_FUNCTION_CODE (Decl, Function_Code);
+      return Decl;
+   end Builtin_Function;
+
+   procedure Set_Yydebug (Flag : C_Bool)
+   is
+      pragma Unreferenced (Flag);
+   begin
+      null;
+   end Set_Yydebug;
+
+   procedure Print_Lang_Decl (File : FILEs; Node : Tree; Indent : natural)
+   is
+      pragma Unreferenced (File);
+      pragma Unreferenced (Node);
+      pragma Unreferenced (Indent);
+   begin
+      null;
+   end Print_Lang_Decl;
+
+   procedure Print_Lang_Type (File : FILEs; Node : Tree; Indent : Natural)
+   is
+      pragma Unreferenced (File);
+      pragma Unreferenced (Node);
+      pragma Unreferenced (Indent);
+   begin
+      null;
+   end Print_Lang_Type;
+
+   procedure Print_Lang_Identifier
+     (File : FILEs; Node : Tree; Indent : Natural)
+   is
+      pragma Unreferenced (File);
+      pragma Unreferenced (Node);
+      pragma Unreferenced (Indent);
+   begin
+      null;
+   end Print_Lang_Identifier;
+
+   procedure Lang_Print_Xnode (File : FILEs; Node : Tree; Indent : Natural)
+   is
+      pragma Unreferenced (File);
+      pragma Unreferenced (Node);
+      pragma Unreferenced (Indent);
+   begin
+      --  There is no X nodes.
+      raise Program_Error;
+   end Lang_Print_Xnode;
+
+   procedure Print_Lang_Statistics is
+   begin
+      null;
+   end Print_Lang_Statistics;
+
+   procedure Copy_Lang_Decl (Node : Tree)
+   is
+      pragma Unreferenced (Node);
+   begin
+      null;
+   end Copy_Lang_Decl;
+
+   function Truthvalue_Conversion (Expr : Tree) return Tree
+   is
+      Expr_Type : Tree;
+      type Conv_Array is array (Boolean) of Tree;
+      Conv : Conv_Array;
+   begin
+      Expr_Type := Get_TREE_TYPE (Expr);
+      if Get_TREE_CODE (Expr_Type) /= BOOLEAN_TYPE then
+         Conv := (True => Integer_One_Node,
+                  False => Integer_Zero_Node);
+      else
+         Conv := (False => Get_TYPE_MIN_VALUE (Expr_Type),
+                  True => Get_TYPE_MAX_VALUE (Expr_Type));
+      end if;
+
+      --  From java/decl.c
+      --  It is simpler and generates better code to have only TRUTH_*_EXPR
+      --  or comparison expressions as truth values at this level.
+
+      case Get_TREE_CODE (Expr) is
+         when EQ_EXPR
+           | NE_EXPR
+           | LE_EXPR
+           | GE_EXPR
+           | LT_EXPR
+           | GT_EXPR
+           | TRUTH_ANDIF_EXPR
+           | TRUTH_ORIF_EXPR
+           | TRUTH_AND_EXPR
+           | TRUTH_OR_EXPR
+           | ERROR_MARK =>
+            return Expr;
+
+         when INTEGER_CST =>
+            if Integer_Zerop (Expr) = C_False then
+               --  EXPR is not 0, so EXPR is interpreted as TRUE.
+               return Conv (True);
+            else
+               return Conv (False);
+            end if;
+
+         when REAL_CST =>
+            if Real_Zerop (Expr) = C_False then
+               return Conv (True);
+            else
+               return Conv (False);
+            end if;
+
+         when others =>
+            raise Program_Error;
+      end case;
+   end Truthvalue_Conversion;
+
+   procedure Incomplete_Type_Error (Value : Tree; Atype : Tree)
+   is
+      pragma Unreferenced (Value);
+      pragma Unreferenced (Atype);
+   begin
+      --  Can never happen.
+      raise Program_Error;
+   end Incomplete_Type_Error;
+
+   function Maybe_Build_Cleanup (Decl : Tree) return Tree
+   is
+      pragma Unreferenced (Decl);
+   begin
+      return NULL_TREE;
+   end Maybe_Build_Cleanup;
+
+   Language_Name : constant String := "GNU vhdl" & Nul;
+   pragma Export (C, Language_Name);
+end Agcc.Fe;
diff --git a/ortho/gcc/lang.opt b/ortho/gcc/lang.opt
new file mode 100644
index 000000000..b2f650aa0
--- /dev/null
+++ b/ortho/gcc/lang.opt
@@ -0,0 +1,88 @@
+;  Options for the VHDL front-end.
+;  Copyright (C) 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.
+
+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 Joined
+-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
+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 functions override implicit functions
+
+l
+vhdl Joined Separate
+-l<filename>	Put list of files for link in <filename>
diff --git a/ortho/gcc/ortho_gcc-main.adb b/ortho/gcc/ortho_gcc-main.adb
new file mode 100644
index 000000000..5ee7a76fc
--- /dev/null
+++ b/ortho/gcc/ortho_gcc-main.adb
@@ -0,0 +1,44 @@
+--  Ortho implementation 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 System;
+with Ortho_Gcc_Front;
+with Agcc.Toplev;
+with Ada.Command_Line; use Ada.Command_Line;
+
+procedure Ortho_Gcc.Main
+is
+   gnat_argc : Integer;
+   gnat_argv : System.Address;
+   gnat_envp : System.Address;
+
+   pragma Import (C, gnat_argc);
+   pragma Import (C, gnat_argv);
+   pragma Import (C, gnat_envp);
+
+   Status : Exit_Status;
+begin
+   Ortho_Gcc_Front.Init;
+
+   --  Note: GCC set signal handlers...
+   Status := Exit_Status (Agcc.Toplev.Toplev_Main (gnat_argc, gnat_argv));
+   Set_Exit_Status (Status);
+exception
+   when others =>
+      Set_Exit_Status (2);
+      return;
+end Ortho_Gcc.Main;
diff --git a/ortho/gcc/ortho_gcc-main.ads b/ortho/gcc/ortho_gcc-main.ads
new file mode 100644
index 000000000..fd79cf42c
--- /dev/null
+++ b/ortho/gcc/ortho_gcc-main.ads
@@ -0,0 +1,18 @@
+--  Ortho implementation 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.
+procedure Ortho_Gcc.Main;
diff --git a/ortho/gcc/ortho_gcc.adb b/ortho/gcc/ortho_gcc.adb
new file mode 100644
index 000000000..66a3f1af0
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.adb
@@ -0,0 +1,1362 @@
+--  Ortho implementation 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 Ada.Unchecked_Conversion;
+with Agcc; use Agcc;
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Toplev; use Agcc.Toplev;
+with Agcc.Tm; use Agcc.Tm;
+with Agcc.Stor_Layout; use Agcc.Stor_Layout;
+with Agcc.Machmode;
+with System;
+with Agcc.Autils; use Agcc.Autils;
+with Agcc.Real; use Agcc.Real;
+with Agcc.Fe; use Agcc.Fe;
+with Agcc.Rtl; use Agcc.Rtl;
+with Agcc.Input; use Agcc.Input;
+with Agcc.Machmode;
+
+package body Ortho_Gcc is
+   type ON_Op_To_Tree_Code_Type is array (ON_Op_Kind) of Tree_Code;
+   ON_Op_To_Tree_Code : constant ON_Op_To_Tree_Code_Type :=
+     (
+      --  Dyadic operations.
+      ON_Add_Ov => PLUS_EXPR,
+      ON_Sub_Ov => MINUS_EXPR,
+      ON_Mul_Ov => MULT_EXPR,
+      ON_Div_Ov => ERROR_MARK,
+      ON_Rem_Ov => TRUNC_MOD_EXPR,
+      ON_Mod_Ov => FLOOR_MOD_EXPR,
+
+      --  Binary operations.
+      ON_And => TRUTH_AND_EXPR,
+      ON_Or => TRUTH_OR_EXPR,
+      ON_Xor => TRUTH_XOR_EXPR,
+      ON_And_Then => TRUTH_ANDIF_EXPR,
+      ON_Or_Else => TRUTH_ORIF_EXPR,
+
+      --  Monadic operations.
+      ON_Not => TRUTH_NOT_EXPR,
+      ON_Neg_Ov => NEGATE_EXPR,
+      ON_Abs_Ov => ABS_EXPR,
+
+      --  Comparaisons
+      ON_Eq => EQ_EXPR,
+      ON_Neq => NE_EXPR,
+      ON_Le => LE_EXPR,
+      ON_Lt => LT_EXPR,
+      ON_Ge => GE_EXPR,
+      ON_Gt => GT_EXPR,
+
+      ON_Nil => ERROR_MARK
+      );
+
+   --  Constants used for FP rounding.
+   Fp_Const_P5 : REAL_VALUE_TYPE;   -- 0.5
+   Fp_Const_M_P5 : REAL_VALUE_TYPE; -- -0.5
+   Fp_Const_Zero : REAL_VALUE_TYPE; -- 0.0
+
+   procedure Init
+   is
+      use Agcc.Machmode;
+
+      L, H : HOST_WIDE_INT;
+      V : REAL_VALUE_TYPE;
+   begin
+      To_Host_Wide_Int (Integer_64'(1), L, H);
+      REAL_VALUE_FROM_INT (V'Address, L, H, DFmode);
+      Fp_Const_P5 := REAL_VALUE_LDEXP (V, -1);
+
+      To_Host_Wide_Int (Integer_64'(-1), L, H);
+      REAL_VALUE_FROM_INT (V'Address, L, H, DFmode);
+      Fp_Const_M_P5 := REAL_VALUE_LDEXP (V, -1);
+
+      To_Host_Wide_Int (Integer_64'(0), L, H);
+      REAL_VALUE_FROM_INT (Fp_Const_Zero'Address, L, H, DFmode);
+   end Init;
+
+   procedure Chain_Init (Constr : out Chain_Constr_Type) is
+   begin
+      Constr.First := NULL_TREE;
+      Constr.Last := NULL_TREE;
+   end Chain_Init;
+
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree)
+   is
+   begin
+      if Constr.First = NULL_TREE then
+         if Constr.Last /= NULL_TREE then
+            raise Program_Error;
+         end if;
+         Constr.First := El;
+      else
+         Set_TREE_CHAIN (Constr.Last, El);
+      end if;
+      Constr.Last := El;
+   end Chain_Append;
+
+
+   procedure List_Init (Constr : out List_Constr_Type) is
+   begin
+      Constr := (First => NULL_TREE, Last => NULL_TREE);
+   end List_Init;
+
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree)
+   is
+      Res : Tree;
+   begin
+      Res := Tree_Cons (NULL_TREE, El, NULL_TREE);
+      if Constr.First = NULL_TREE then
+         Constr.First := Res;
+      else
+         Set_TREE_CHAIN (Constr.Last, Res);
+      end if;
+      Constr.Last := Res;
+   end List_Append;
+
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode
+   is
+      Left_Type : Tree;
+      Code : Tree_Code;
+   begin
+      Left_Type := Get_TREE_TYPE (Tree (Left));
+      if Left_Type /= Get_TREE_TYPE (Tree (Right)) then
+         raise Type_Error;
+      end if;
+      case Kind is
+         when ON_Div_Ov =>
+            if Get_TREE_CODE (Left_Type) = REAL_TYPE then
+               Code := RDIV_EXPR;
+            else
+               Code := TRUNC_DIV_EXPR;
+            end if;
+         when others =>
+            Code := ON_Op_To_Tree_Code (Kind);
+      end case;
+      return O_Enode (Build (Code, Left_Type, Tree (Left), Tree (Right)));
+   end New_Dyadic_Op;
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode
+   is
+   begin
+      return Build1 (ON_Op_To_Tree_Code (Kind),
+                     Get_TREE_TYPE (Operand), 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
+      if Get_TREE_CODE (Ntype) /= BOOLEAN_TYPE then
+         raise Type_Error;
+      end if;
+      if Get_TREE_TYPE (Left) /= Get_TREE_TYPE (Right) then
+         raise Type_Error;
+      end if;
+      return O_Enode (Build (ON_Op_To_Tree_Code (Kind),
+                             Tree (Ntype), Tree (Left), Tree (Right)));
+   end New_Compare_Op;
+
+--   function Unchecked_Conversion is new
+--   Ada.Unchecked_Conversion (Source => Unsigned_32, Target => HOST_WIDE_INT);
+
+--    function High_Part (V : Unsigned_64) return HOST_WIDE_INT
+--    is
+--    begin
+--       return Unchecked_Conversion (Unsigned_32 (Shift_Left (V, 32)));
+--    end High_Part;
+
+--    function Low_Part (V : Unsigned_64) return HOST_WIDE_INT
+--    is
+--    begin
+--       return Unchecked_Conversion
+--         (Unsigned_32 (V and (Unsigned_32'Modulus - 1)));
+--    end Low_Part;
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode
+   is
+      L, H : HOST_WIDE_INT;
+      Res : Tree;
+   begin
+      To_Host_Wide_Int (Value, L, H);
+      Res := Build_Int_2 (L, H);
+      Set_TREE_TYPE (Res, Tree (Ltype));
+      return O_Cnode (Res);
+   end New_Signed_Literal;
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode
+   is
+      Res : Tree;
+      L, H : HOST_WIDE_INT;
+   begin
+      To_Host_Wide_Int (Value, L, H);
+      Res := Build_Int_2 (L, H);
+      Set_TREE_TYPE (Res, Tree (Ltype));
+      return O_Cnode (Res);
+   end New_Unsigned_Literal;
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode
+   is
+      Res : Tree;
+   begin
+      Res := Build_Int_2 (0, 0);
+      Set_TREE_TYPE (Res, Tree (Ltype));
+      return O_Cnode (Res);
+   end New_Null_Access;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode
+   is
+      Res : REAL_VALUE_TYPE;
+   begin
+      Res := To_Real_Value_Type (Value);
+      return O_Cnode (Build_Real (Tree (Ltype), Res));
+   end New_Float_Literal;
+
+   procedure Check_Constrained_Type (Atype : O_Tnode)
+   is
+      pragma Unreferenced (Atype);
+   begin
+      null;
+   end Check_Constrained_Type;
+
+   procedure Finish_Type_Def (Atype : O_Tnode) is
+   begin
+      Layout_Type (Atype);
+      --Rest_Of_Type_Compilation (Tree (Atype), True);
+   end Finish_Type_Def;
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      Res := Make_Node (RECORD_TYPE);
+   end New_Uncomplete_Record_Type;
+
+   procedure Start_Record_Type (Elements : out O_Element_List) is
+   begin
+      Elements.Res := Make_Node (RECORD_TYPE);
+      Chain_Init (Elements.Chain);
+   end Start_Record_Type;
+
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List) is
+   begin
+      Elements.Res := Tree (Res);
+      Chain_Init (Elements.Chain);
+   end Start_Uncomplete_Record_Type;
+
+   procedure New_Record_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+   is
+      Res : Tree;
+   begin
+      Check_Constrained_Type (Etype);
+      Res := Build_Decl (FIELD_DECL, Ident, Tree (Etype));
+      Set_DECL_CONTEXT (Res, Elements.Res);
+      Chain_Append (Elements.Chain, Res);
+      El := O_Fnode (Res);
+   end New_Record_Union_Field;
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+     renames New_Record_Union_Field;
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Set_TYPE_FIELDS (Elements.Res, Elements.Chain.First);
+      Finish_Type_Def (O_Tnode (Elements.Res));
+      Res := O_Tnode (Elements.Res);
+      if Get_TYPE_NAME (Elements.Res) /= NULL_TREE then
+         --  The type was completed.
+         Rest_Of_Type_Compilation (Elements.Res, C_True);
+      end if;
+   end Finish_Record_Type;
+
+   procedure Start_Union_Type (Elements : out O_Element_List) is
+   begin
+      Elements.Res := Make_Node (UNION_TYPE);
+      Chain_Init (Elements.Chain);
+   end Start_Union_Type;
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+     renames New_Record_Union_Field;
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Set_TYPE_FIELDS (Elements.Res, Elements.Chain.First);
+      Finish_Type_Def (O_Tnode (Elements.Res));
+      Res := O_Tnode (Elements.Res);
+   end Finish_Union_Type;
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode
+   is
+      Res : Tree;
+   begin
+      if Dtype = O_Tnode_Null then
+         Res := Make_Node (POINTER_TYPE);
+         Set_TREE_TYPE (Res, NULL_TREE);
+         Set_TYPE_MODE (Res, Machmode.Ptr_Mode);
+         Layout_Type (Res);
+         return O_Tnode (Res);
+      else
+         return Build_Pointer_Type (Dtype);
+      end if;
+   end New_Access_Type;
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) is
+   begin
+      if Get_TREE_CODE (Atype) /= POINTER_TYPE
+        or else Get_TREE_TYPE (Atype) /= O_Tnode_Null
+      then
+         raise Syntax_Error;
+      end if;
+      Set_TREE_TYPE (Atype, Dtype);
+   end Finish_Access_Type;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode
+   is
+   begin
+      Check_Constrained_Type (El_Type);
+      return Build_Array_Type (El_Type, Index_Type);
+   end New_Array_Type;
+
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode
+   is
+      Range_Type : Tree;
+      Index_Type : Tree;
+      Len : Tree;
+      One : Tree;
+   begin
+      --if Atype.Kind /= ON_Array_Type then
+      --   raise Type_Error;
+      --end if;
+      Index_Type := Get_TYPE_DOMAIN (Tree (Atype));
+      if +Integer_Zerop (Tree (Length)) then
+         --  Handle null array, by creating a one-length array...
+         Len := Size_Zero_Node;
+      else
+         One := Build_Int_2 (1, 0);
+         Set_TREE_TYPE (One, Index_Type);
+         Len := Build (MINUS_EXPR, Index_Type, Tree (Length), One);
+         Len := Fold (Len);
+      end if;
+      Range_Type := Build_Range_Type (Index_Type, Size_Zero_Node, Len);
+      return O_Tnode (Build_Array_Type (Get_TREE_TYPE (Tree (Atype)),
+                                        Range_Type));
+   end New_Constrained_Array_Type;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode
+   is
+   begin
+      return Make_Unsigned_Type (Size);
+   end New_Unsigned_Type;
+
+   function New_Signed_Type (Size : Natural) return O_Tnode
+   is
+   begin
+      return Make_Signed_Type (Size);
+   end New_Signed_Type;
+
+   function New_Float_Type return O_Tnode is
+      Res : O_Tnode;
+   begin
+      Res := Make_Node (REAL_TYPE);
+      Set_TYPE_PRECISION (Res, DOUBLE_TYPE_SIZE);
+      Layout_Type (Res);
+      return Res;
+   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
+      pragma Unreferenced (False_Id);
+      pragma Unreferenced (True_Id);
+   begin
+      --  see java/decl.c
+      Res := O_Tnode'(Make_Node (BOOLEAN_TYPE));
+      Set_TYPE_PRECISION (Tree (Res), 1);
+      Fixup_Unsigned_Type (Tree (Res));
+      False_E := O_Cnode (Get_TYPE_MIN_VALUE (Tree (Res)));
+      True_E := O_Cnode (Get_TYPE_MAX_VALUE (Tree (Res)));
+   end New_Boolean_Type;
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+   begin
+      List.Res := Make_Node (ENUMERAL_TYPE);
+      Chain_Init (List.Chain);
+      List.Num := 0;
+      List.Size := Size;
+   end Start_Enum_Type;
+
+   procedure New_Enum_Literal
+     (List : in out O_Enum_List; Ident : O_Ident; Res : out O_Cnode)
+   is
+   begin
+      Res := Build_Int_2 (HOST_WIDE_INT (List.Num), 0);
+      Set_TREE_TYPE (Tree (Res), List.Res);
+      Chain_Append (List.Chain, Tree_Cons (Ident, Tree (Res), NULL_TREE));
+      List.Num := List.Num + 1;
+   end New_Enum_Literal;
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := O_Tnode (List.Res);
+      Set_TYPE_VALUES (List.Res, List.Chain.First);
+      Set_TYPE_MIN_VALUE (List.Res, Get_TREE_VALUE (List.Chain.First));
+      Set_TYPE_MAX_VALUE (List.Res, Get_TREE_VALUE (List.Chain.Last));
+      Set_TREE_UNSIGNED (List.Res, C_True);
+      Set_TYPE_PRECISION (List.Res, Integer (List.Size));
+      Finish_Type_Def (Res);
+   end Finish_Enum_Type;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List; Atype : O_Tnode)
+   is
+   begin
+      List.Atype := Tree (Atype);
+      Chain_Init (List.Chain);
+   end Start_Record_Aggr;
+
+   procedure New_Record_Aggr_El
+     (List : in out O_Record_Aggr_List; Value : O_Cnode)
+   is
+   begin
+      --  FIXME: should check type of value.
+      Chain_Append (List.Chain,
+                    Build_Tree_List (NULL_TREE, Tree (Value)));
+   end New_Record_Aggr_El;
+
+   procedure Finish_Record_Aggr
+     (List : in out O_Record_Aggr_List; Res : out O_Cnode)
+   is
+   begin
+      Res := O_Cnode (Build_Constructor (List.Atype, List.Chain.First));
+   end Finish_Record_Aggr;
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode)
+   is
+   begin
+      List.Atype := Tree (Atype);
+      Chain_Init (List.Chain);
+   end Start_Array_Aggr;
+
+   procedure New_Array_Aggr_El
+     (List : in out O_Array_Aggr_List; Value : O_Cnode)
+   is
+   begin
+      --  FIXME: should check type of value.
+      Chain_Append (List.Chain,
+                    Build_Tree_List (NULL_TREE, Tree (Value)));
+   end New_Array_Aggr_El;
+
+   procedure Finish_Array_Aggr
+     (List : in out O_Array_Aggr_List; Res : out O_Cnode)
+   is
+   begin
+      Res := O_Cnode (Build_Constructor (List.Atype, List.Chain.First));
+   end Finish_Array_Aggr;
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      El : Tree;
+      Res : Tree;
+   begin
+      El := Build_Tree_List (Tree (Field), Tree (Value));
+      Res := Build_Constructor (Tree (Atype), El);
+      Set_TREE_CONSTANT (Res, C_True);
+      return O_Cnode (Res);
+   end New_Union_Aggr;
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode
+   is
+      Res : Tree;
+      V : C_Bool;
+   begin
+      V := Mark_Addressable (Tree (Arr));
+      Res := Build (ARRAY_REF, Get_TREE_TYPE (Get_TREE_TYPE (Tree (Arr))),
+                    Tree (Arr), Tree (Index));
+      return O_Lnode (Res);
+   end New_Indexed_Element;
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode
+   is
+      Res : Tree;
+      Ptr_Type : Tree;
+      V : C_Bool;
+   begin
+      --  *((RES_TYPE *)(&ARR[INDEX]))
+      --  convert ARR to a pointer, add index, and reconvert to array ?
+      if Get_TREE_CODE (Res_Type) /= ARRAY_TYPE then
+         raise Type_Error;
+      end if;
+      V := Mark_Addressable (Tree (Arr));
+      Ptr_Type := Build_Pointer_Type (Tree (Res_Type));
+      Res := Build (ARRAY_REF, Get_TREE_TYPE (Get_TREE_TYPE (Tree (Arr))),
+                    Tree (Arr), Tree (Index));
+      Res := Build1 (ADDR_EXPR, Ptr_Type, Res);
+      Res := Build1 (INDIRECT_REF, Tree (Res_Type), Res);
+      return O_Lnode (Res);
+   end New_Slice;
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode
+   is
+   begin
+      if Get_TREE_CODE (Get_TREE_TYPE (Rec)) /= RECORD_TYPE then
+         raise Type_Error;
+      end if;
+      return O_Lnode (Build (COMPONENT_REF, Get_TREE_TYPE (Tree (El)),
+                             Tree (Rec), Tree (El)));
+   end New_Selected_Element;
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      Acc_Type : Tree;
+   begin
+      Acc_Type := Get_TREE_TYPE (Tree (Acc));
+      if Get_TREE_CODE (Acc_Type) /= POINTER_TYPE then
+         raise Type_Error;
+      end if;
+      return O_Lnode (Build1 (INDIRECT_REF, Get_TREE_TYPE (Acc_Type),
+                              Tree (Acc)));
+   end New_Access_Element;
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode
+   is
+      Val_Type : Tree;
+      Val_Code : Tree_Code;
+      Rtype_Code : Tree_Code;
+      Code : Tree_Code;
+   begin
+      Val_Type := Get_TREE_TYPE (Tree (Val));
+      if Val_Type = Tree (Rtype) then
+         return Val;
+      end if;
+      --  FIXME: check conversions.
+      Val_Code := Get_TREE_CODE (Val_Type);
+      Rtype_Code := Get_TREE_CODE (Rtype);
+      if Val_Code = POINTER_TYPE and then Rtype_Code = POINTER_TYPE then
+         Code := NOP_EXPR;
+      elsif Val_Code = INTEGER_TYPE and then Rtype_Code = INTEGER_TYPE then
+         Code := CONVERT_EXPR;
+      elsif Val_Code = REAL_TYPE and then Rtype_Code = INTEGER_TYPE then
+         --  REAL to INTEGER
+         --  Gcc only handles FIX_TRUNC_EXPR, but we need rounding.
+         declare
+            M_P5 : Tree;
+            P5 : Tree;
+            Zero : Tree;
+            Saved : Tree;
+            Comp : Tree;
+            Adj : Tree;
+            Res : Tree;
+         begin
+            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 := Build_Save_Expr (Tree (Val));
+            Comp := Build (GE_EXPR, Integer_Type_Node, Saved, Zero);
+            --  FIXME: instead of res = res + (comp ? .5 : -.5)
+            --                 do: res = res (comp ? + : -) .5
+            Adj := Build (COND_EXPR, Val_Type, Comp, P5, M_P5);
+            Res := Build (PLUS_EXPR, Val_Type, Saved, Adj);
+            Res := Build1 (FIX_TRUNC_EXPR, Tree (Rtype), Res);
+            return O_Enode (Res);
+         end;
+      elsif Val_Code = INTEGER_TYPE and then Rtype_Code = ENUMERAL_TYPE then
+         Code := CONVERT_EXPR;
+      elsif Val_Code = ENUMERAL_TYPE and then Rtype_Code = INTEGER_TYPE then
+         Code := CONVERT_EXPR;
+      elsif Val_Code = INTEGER_TYPE and then Rtype_Code = REAL_TYPE then
+         Code := FLOAT_EXPR;
+      elsif Val_Code = BOOLEAN_TYPE and then Rtype_Code = BOOLEAN_TYPE then
+         Code := NOP_EXPR;
+      elsif Val_Code = BOOLEAN_TYPE and then Rtype_Code = INTEGER_TYPE then
+         Code := CONVERT_EXPR;
+      elsif Val_Code = INTEGER_TYPE and then Rtype_Code = BOOLEAN_TYPE then
+         --  From integer to boolean.
+         Code := NOP_EXPR;
+      elsif Val_Code = REAL_TYPE and then Rtype_Code = REAL_TYPE then
+         Code := CONVERT_EXPR;
+      else
+         raise Program_Error;
+      end if;
+      return O_Enode (Build1 (Code, Tree (Rtype), Tree (Val)));
+   end New_Convert_Ov;
+
+   function Build_Addr (Operand : Tree; Atype : Tree) return Tree
+   is
+      use Agcc.Machmode;
+      Result : Tree;
+   begin
+      case Get_TREE_CODE (Operand) is
+         when INDIRECT_REF =>
+            --  This may be an unchecked conversion.
+            Result := Get_TREE_OPERAND (Operand, 0);
+            if Get_TREE_CODE (Get_TREE_TYPE (Result)) /= POINTER_TYPE then
+               raise Program_Error;
+            end if;
+            return Result;
+
+         when ARRAY_REF
+           | COMPONENT_REF =>
+            --  Find the address of the prefix and add the offset.
+            declare
+               Op_Type : Tree;
+               Bitsize, Bitpos : HOST_WIDE_INT;
+               Inner, Offset : Tree;
+               Mode : Machine_Mode;
+               Unsignedp, Volatilep : Integer;
+            begin
+               Op_Type := Get_TREE_TYPE (Get_TREE_OPERAND (Operand, 0));
+               Inner := Get_Inner_Reference
+                 (Operand, Bitsize'Address, Bitpos'Address, Offset'Address,
+                  Mode'Address, Unsignedp'Address, Volatilep'Address);
+
+               -- Compute the offset as a byte offset from INNER.  */
+               if Offset = NULL_TREE then
+                  Offset := Size_Zero_Node;
+               end if;
+
+               Offset := Size_Binop
+                 (PLUS_EXPR, Offset,
+                  Size_Int (Bitpos / HOST_WIDE_INT (BITS_PER_UNIT)));
+
+               -- Take the address of INNER, convert the offset to void *, and
+               -- add then.  It will later be converted to the desired result
+               -- type, if any.
+               Inner := Build_Addr (Inner, Ptr_Type_Node);
+               Inner := Convert (Ptr_Type_Node, Inner);
+               Offset := Convert (Ptr_Type_Node, Offset);
+               Result := Fold
+                 (Build (PLUS_EXPR, Ptr_Type_Node, Inner, Offset));
+               return Result;
+            end;
+
+         when VAR_DECL =>
+            --  This is like Mark_Addressable.
+            Put_Var_Into_Stack (Operand, C_True);
+            Set_TREE_ADDRESSABLE (Operand, C_True);
+            return Build1 (ADDR_EXPR, Atype, Operand);
+
+         when others =>
+            raise Program_Error;
+      end case;
+   end Build_Addr;
+
+   function New_Addr (Lvalue : Tree; Atype : O_Tnode)
+                     return Tree
+   is
+      Result : Tree;
+   begin
+      Result := Build_Addr (Lvalue, Tree (Atype));
+      if Get_TREE_TYPE (Result) /= Tree (Atype) then
+         if Get_TREE_CODE (Get_TREE_TYPE (Result)) /= POINTER_TYPE then
+            raise Program_Error;
+         end if;
+         Result := Build1 (NOP_EXPR, Tree (Atype), Result);
+      end if;
+      return Result;
+      --return O_Enode (Build1 (ADDR_EXPR, Tree (Atype), Tree (Lvalue)));
+   end New_Addr;
+
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+                                  return O_Enode
+   is
+   begin
+      return O_Enode (New_Addr (Tree (Lvalue), Atype));
+   end New_Unchecked_Address;
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode
+   is
+   begin
+      --if Get_TREE_TYPE (Lvalue) /= Get_TREE_TYPE (Atype) then
+      --   raise Type_Error;
+      --end if;
+      return O_Enode (New_Addr (Tree (Lvalue), Atype));
+   end New_Address;
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode
+   is
+   begin
+      return O_Cnode (New_Addr (Tree (Decl), Atype));
+   end New_Global_Unchecked_Address;
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) return O_Cnode
+   is
+   begin
+      --if Get_TREE_TYPE (Lvalue) /= Get_TREE_TYPE (Atype) then
+      --   raise Type_Error;
+      --end if;
+      return O_Cnode (New_Addr (Tree (Decl), Atype));
+   end New_Global_Address;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode
+   is
+   begin
+      return O_Cnode (Build1 (ADDR_EXPR, Tree (Atype), Tree (Subprg)));
+   end New_Subprogram_Address;
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode is
+   begin
+      return O_Enode (Lvalue);
+   end New_Value;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return O_Enode (Obj);
+   end New_Obj_Value;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      return O_Lnode (Obj);
+   end New_Obj;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode (Lit);
+   end New_Lit;
+
+   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode
+   is
+      Off : Tree;
+      Bit_Off : Tree;
+      Pos : HOST_WIDE_INT;
+      Res : Tree;
+   begin
+      Off := Get_DECL_FIELD_OFFSET (Tree (Field));
+      if Host_Integerp (Off, 1) = 0 then
+         --  The offset must be a constant.
+         raise Program_Error;
+      end if;
+      Bit_Off := Get_DECL_FIELD_BIT_OFFSET (Tree (Field));
+      if Host_Integerp (Bit_Off, 1) = 0 then
+         --  The offset must be a constant.
+         raise Program_Error;
+      end if;
+      Pos := Get_TREE_INT_CST_LOW (Off)
+        + (Get_TREE_INT_CST_LOW (Bit_Off) / HOST_WIDE_INT (BITS_PER_UNIT));
+      Res := Build_Int_2 (Pos, 0);
+      Set_TREE_TYPE (Res, Tree (Rtype));
+      return O_Cnode (Res);
+   end New_Offsetof;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      Size : Tree;
+   begin
+      Size := Get_TYPE_SIZE_UNIT (Tree (Atype));
+      --Size := Size_Binop (CEIL_DIV_EXPR, Size,
+      --                    Size_Int (HOST_WIDE_INT (BITS_PER_UNIT)));
+
+      return O_Cnode (Fold (Build1 (NOP_EXPR, Tree (Rtype), Size)));
+   end New_Sizeof;
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      Var : Tree;
+      Var_Type : Tree;
+      Res : Tree;
+   begin
+      --  Create a dummy variable of the correct size.
+      --  This way, the storage will be deallocated at the end of the scope.
+      Var_Type := Build_Array_Type (Char_Type_Node,
+                                    Build_Index_Type (Tree (Size)));
+      Var := Build_Decl (VAR_DECL, NULL_TREE, Var_Type);
+      Set_TREE_STATIC (Var, C_False);
+      Set_DECL_EXTERNAL (Var, C_False);
+      Set_TREE_PUBLIC (Var, C_False);
+      Pushdecl (Var);
+      Expand_Decl (Var);
+      Res := Build1 (ADDR_EXPR, Tree (Rtype), Var);
+      return O_Enode (Res);
+
+      -- Old code that use alloca.  This is not space efficient, since the
+      -- storage will be freed only at the exit of the function.
+      --Arg := Build1 (CONVERT_EXPR, Sizetype, Tree (Size));
+      --Res := Build (CALL_EXPR, Ptr_Type_Node, Alloca_Function_Ptr,
+      --              Tree_Cons (NULL_TREE, Arg, NULL_TREE));
+      --return O_Enode (Build1 (NOP_EXPR, Tree (Rtype), Res));
+   end New_Alloca;
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   type String_Acc is access String;
+   Current_Filename : String_Acc := null;
+
+   procedure New_Debug_Filename_Decl (Filename : String)
+   is
+      Len : Natural;
+   begin
+      Len := Filename'Length;
+      if Current_Filename = null
+        or else Current_Filename.all'Length /= Len + 1
+        or else Current_Filename (1 .. Len) /= Filename
+      then
+         Current_Filename := new String (1 .. Len + 1);
+         Current_Filename (1 .. Len) := Filename;
+         Current_Filename (Len + 1) := Nul;
+         Input_Location.File := Current_Filename (1)'Address;
+      end if;
+   end New_Debug_Filename_Decl;
+
+   procedure New_Debug_Line_Decl (Line : Natural)
+   is
+   begin
+      Input_Location.Line := Line;
+   end New_Debug_Line_Decl;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode)
+   is
+      Decl : Tree;
+      Ttype : Tree := Tree (Atype);
+   begin
+--       if Atype.Decl /= null then
+--          raise Type_Error;
+--       end if;
+      Set_TYPE_NAME (Ttype, Ident);
+      Decl := Build_Decl (TYPE_DECL, Ident, Ttype);
+      Set_TYPE_STUB_DECL (Ttype, Decl);
+      Pushdecl (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;
+   end New_Type_Decl;
+
+   procedure Set_Storage (Node : Tree; Storage : O_Storage)
+   is
+   begin
+      case Storage is
+         when O_Storage_External =>
+            Set_DECL_EXTERNAL (Node, C_True);
+            Set_TREE_PUBLIC (Node, C_True);
+            Set_TREE_STATIC (Node, C_False);
+         when O_Storage_Public =>
+            Set_DECL_EXTERNAL (Node, C_False);
+            Set_TREE_PUBLIC (Node, C_True);
+            Set_TREE_STATIC (Node, C_True);
+         when O_Storage_Private =>
+            Set_DECL_EXTERNAL (Node, C_False);
+            Set_TREE_PUBLIC (Node, C_False);
+            Set_TREE_STATIC (Node, C_True);
+         when O_Storage_Local =>
+            Set_DECL_EXTERNAL (Node, C_False);
+            Set_TREE_PUBLIC (Node, C_False);
+            Set_TREE_STATIC (Node, C_False);
+      end case;
+   end Set_Storage;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+      Cst : Tree;
+   begin
+      Cst := Build_Decl (VAR_DECL, Ident, Tree (Atype));
+      Set_Storage (Cst, Storage);
+      Set_TREE_READONLY (Cst, C_True);
+      Pushdecl (Cst);
+      case Storage is
+         when O_Storage_Local =>
+            raise Syntax_Error;
+         when O_Storage_External =>
+            --  We are at top level if Current_Function_Decl is null.
+            Rest_Of_Decl_Compilation
+              (Cst, NULL_Chars,
+               Boolean'Pos (Current_Function_Decl = NULL_TREE), C_False);
+         when O_Storage_Public
+           | O_Storage_Private =>
+            null;
+      end case;
+      Res := O_Dnode (Cst);
+   end New_Const_Decl;
+
+   procedure Start_Const_Value (Const : in out O_Dnode)
+   is
+      pragma Unreferenced (Const);
+   begin
+      null;
+   end Start_Const_Value;
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
+   is
+   begin
+      Set_DECL_INITIAL (Tree (Const), Tree (Val));
+      Set_TREE_CONSTANT (Val, C_True);
+      Rest_Of_Decl_Compilation
+        (Tree (Const), NULL_Chars,
+         Boolean'Pos (Current_Function_Decl = NULL_TREE), C_False);
+   end Finish_Const_Value;
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+      Var : Tree;
+   begin
+      Var := Build_Decl (VAR_DECL, Ident, Tree (Atype));
+      if Current_Function_Decl /= NULL_TREE  then
+         --  Local variable.
+         Set_TREE_STATIC (Var, C_False);
+         Set_DECL_EXTERNAL (Var, C_False);
+         Set_TREE_PUBLIC (Var, C_False);
+      else
+         Set_Storage (Var, Storage);
+      end if;
+      Pushdecl (Var);
+      if Current_Function_Decl /= NULL_TREE  then
+         Expand_Decl (Var);
+      else
+         Rest_Of_Decl_Compilation (Var, NULL_Chars, C_True, C_False);
+      end if;
+      Res := O_Dnode (Var);
+   end New_Var_Decl;
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Interfaces.Ident := Ident;
+      Interfaces.Storage := Storage;
+      Interfaces.Rtype := Rtype;
+      Chain_Init (Interfaces.Param_Chain);
+      List_Init (Interfaces.Param_List);
+   end Start_Function_Decl;
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List; Ident : O_Ident; Storage : O_Storage) is
+   begin
+      Start_Function_Decl (Interfaces, Ident, Storage,
+                           O_Tnode (Void_Type_Node));
+   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
+      R : Tree;
+   begin
+      R := Build_Decl (PARM_DECL, Ident, Tree (Atype));
+      --Set_DECL_CONTEXT (Res, Xxx);
+
+      --  Do type conversion: convert boolean and enums to int
+      if +PROMOTE_PROTOTYPES then
+         case Get_TREE_CODE (Tree (Atype)) is
+            when ENUMERAL_TYPE
+              | BOOLEAN_TYPE =>
+               Set_DECL_ARG_TYPE (R, Integer_Type_Node);
+            when others =>
+               Set_DECL_ARG_TYPE (R, Tree (Atype));
+         end case;
+      else
+         Set_DECL_ARG_TYPE (R, Tree (Atype));
+      end if;
+
+      Chain_Append (Interfaces.Param_Chain, R);
+      List_Append (Interfaces.Param_List, Tree (Atype));
+      Res := O_Dnode (R);
+   end New_Interface_Decl;
+
+   --  Current function nest level, or the number of parents.
+   Function_Nest_Level : Natural := 0;
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode)
+   is
+      Decl : Tree;
+      Result : Tree;
+      Parm : Tree;
+      Is_Global : Boolean;
+   begin
+      Decl := Build_Decl (FUNCTION_DECL, Interfaces.Ident,
+                          Build_Function_Type (Tree (Interfaces.Rtype),
+                                               Interfaces.Param_List.First));
+      Is_Global := Function_Nest_Level = 0
+        or Interfaces.Storage = O_Storage_External;
+      if Is_Global then
+         Set_Storage (Decl, Interfaces.Storage);
+      else
+         --  A nested subprogram.
+         Set_DECL_EXTERNAL (Decl, C_False);
+         Set_TREE_PUBLIC (Decl, C_False);
+      end if;
+      --  The function exist in static storage.
+      Set_TREE_STATIC (Decl, C_True);
+      Set_DECL_INITIAL (Decl, Error_Mark_Node);
+      Set_TREE_ADDRESSABLE (Decl, C_True);
+
+      --  Declare the result.
+      --  FIXME: should be moved in start_function_body.
+      Result := Build_Decl (RESULT_DECL, NULL_TREE, Tree (Interfaces.Rtype));
+      Set_DECL_RESULT (Decl, Result);
+      Set_DECL_CONTEXT (Result, Decl);
+
+      Set_DECL_ARGUMENTS (Decl, Interfaces.Param_Chain.First);
+      --  Set DECL_CONTEXT of parameters.
+      Parm := Interfaces.Param_Chain.First;
+      while Parm /= NULL_TREE loop
+         Set_DECL_CONTEXT (Parm, Decl);
+         Parm := Get_TREE_CHAIN (Parm);
+      end loop;
+
+      Pushdecl (Decl);
+
+      if Is_Global then
+         Rest_Of_Decl_Compilation (Decl, NULL_Chars, C_True, C_False);
+      else
+         Expand_Decl (Decl);
+      end if;
+
+      --Make_Function_Rtl (Decl);
+
+      Res := O_Dnode (Decl);
+   end Finish_Subprogram_Decl;
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+   begin
+      if Function_Nest_Level /= 0 then
+         --  For a nested subprogram:
+         Push_Function_Context;
+         --start_function (c-decl.c)
+         --  announce_function
+         --  current_function_decl = pushdecl (x)
+         --  ??
+         --XXX
+         --finish_function(1) (c-decl.c)
+         --  poplevel
+         --pop_function_context
+         --add_decl_stmt
+      end if;
+      Function_Nest_Level := Function_Nest_Level + 1;
+
+      Current_Function_Decl := Tree (Func);
+      Announce_Function (Tree (Func));
+
+      --  Create a binding for the parameters.
+      Pushlevel (C_False);
+      --  FIXME: should push parameters.
+      --Make_Function_Rtl (Current_Function_Decl);
+      Init_Function_Start (Func, NULL_Chars, 0);
+      Expand_Function_Start (Func, C_False);
+      --  Create a binding for the function.
+      --  This is necessary for compatibility.
+      Pushlevel (C_False);
+      Expand_Start_Bindings (0);
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body
+   is
+   begin
+      Expand_End_Bindings (Getdecls, C_True, C_False);
+      Poplevel (C_True, C_False, C_False);
+      Expand_Function_End (NULL_Chars, 0, C_False);
+      Poplevel (C_True, C_False, C_True);
+      --  The subprogram is not external anymore (extern inline is not
+      --  supported).  As a result, code will be generated.
+      Set_DECL_EXTERNAL (Current_Function_Decl, C_False);
+
+      --  FIXME: protect against ggc.  See c-decl.c:c_expand_body
+      Rest_Of_Compilation (Current_Function_Decl);
+      Function_Nest_Level := Function_Nest_Level - 1;
+      if Function_Nest_Level > 0 then
+         Pop_Function_Context;
+      else
+         Current_Function_Decl := NULL_TREE;
+      end if;
+   end Finish_Subprogram_Body;
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural) is
+   begin
+      Input_Location.Line := Line;
+      Emit_Line_Note (Input_Location);
+   end New_Debug_Line_Stmt;
+
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   procedure Start_Declare_Stmt
+   is
+   begin
+      Pushlevel (C_False);
+      Expand_Start_Bindings (0);
+   end Start_Declare_Stmt;
+
+   procedure Finish_Declare_Stmt
+   is
+   begin
+      Expand_End_Bindings (Getdecls, C_True, C_True);
+      Poplevel (C_True, C_False, C_False);
+   end Finish_Declare_Stmt;
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+   begin
+      Assocs.Subprg := Tree (Subprg);
+      List_Init (Assocs.List);
+   end Start_Association;
+
+--    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 New_Association (Assocs : in out O_Assoc_List; Val : O_Enode)
+   is
+   begin
+      List_Append (Assocs.List, Tree (Val));
+   end New_Association;
+
+   --  Return a pointer to function FUNC.
+   function Build_Function_Ptr (Func : Tree) return Tree is
+   begin
+      return Build1 (ADDR_EXPR,
+                     Build_Pointer_Type (Get_TREE_TYPE (Func)), Func);
+   end Build_Function_Ptr;
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+   begin
+      return O_Enode (Build (CALL_EXPR,
+                             Get_TREE_TYPE (Get_TREE_TYPE (Assocs.Subprg)),
+                             Build_Function_Ptr (Assocs.Subprg),
+                             Assocs.List.First, NULL_TREE));
+   end New_Function_Call;
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List)
+   is
+      Res : Tree;
+   begin
+      Res := Build (CALL_EXPR,
+                    Get_TREE_TYPE (Get_TREE_TYPE (Assocs.Subprg)),
+                    Build_Function_Ptr (Assocs.Subprg),
+                    Assocs.List.First, NULL_TREE);
+      Set_TREE_SIDE_EFFECTS (Res, C_True);
+      Expand_Expr_Stmt (Res);
+   end New_Procedure_Call;
+
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      N : Tree;
+   begin
+      N := Build (MODIFY_EXPR, Get_TREE_TYPE (Tree (Target)),
+                  Tree (Target), Tree (Value));
+      Set_TREE_SIDE_EFFECTS (N, C_True);
+      Expand_Expr_Stmt (N);
+   end New_Assign_Stmt;
+
+   procedure New_Return_Stmt (Value : O_Enode)
+   is
+      Assign : Tree;
+   begin
+      Assign := Build (MODIFY_EXPR, Get_TREE_TYPE (Tree (Value)),
+                       Get_DECL_RESULT (Current_Function_Decl),
+                       Tree (Value));
+      Set_TREE_SIDE_EFFECTS (Assign, C_True);
+      --Set_TREE_USED (Assign, True);
+      Expand_Expr_Stmt (Assign);
+      Expand_Return (Value);
+   end New_Return_Stmt;
+
+   procedure New_Return_Stmt
+   is
+   begin
+      Expand_Null_Return;
+   end New_Return_Stmt;
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode)
+   is
+      pragma Unreferenced (Block);
+   begin
+      Expand_Start_Cond (Cond, C_False);
+   end Start_If_Stmt;
+
+   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode)
+   is
+      pragma Unreferenced (Block);
+   begin
+      Expand_Start_Elseif (Cond);
+   end New_Elsif_Stmt;
+
+   procedure New_Else_Stmt (Block : in out O_If_Block)
+   is
+      pragma Unreferenced (Block);
+   begin
+      Expand_Start_Else;
+   end New_Else_Stmt;
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block)
+   is
+      pragma Unreferenced (Block);
+   begin
+      Expand_End_Cond;
+   end Finish_If_Stmt;
+
+   procedure Start_Loop_Stmt (Label : out O_Snode)
+   is
+   begin
+      Label := Expand_Start_Loop (C_True);
+      --  This is required to avoid crash with goto fixup.
+      Expand_Start_Bindings (0);
+   end Start_Loop_Stmt;
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode)
+   is
+      pragma Unreferenced (Label);
+   begin
+      Expand_End_Bindings (NULL_TREE, C_False, C_False);
+      Expand_End_Loop;
+   end Finish_Loop_Stmt;
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+   begin
+      Expand_Exit_Loop (L);
+   end New_Exit_Stmt;
+
+   procedure New_Next_Stmt (L : O_Snode) is
+   begin
+      Expand_Continue_Loop (L);
+   end New_Next_Stmt;
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode)
+   is
+   begin
+      Expand_Start_Case (C_True, Value, Get_TREE_TYPE (Value), NULL_Chars);
+      Block := O_Case_Block'(Expr => Tree (Value),
+                           First => True, Label => NULL_TREE);
+   end Start_Case_Stmt;
+
+   procedure Start_Choice (Block : in out O_Case_Block)
+   is
+   begin
+      if Block.First then
+         Block.First := False;
+      else
+         --  Add a "break" statement.
+         if Expand_Exit_Something = 0 then
+            raise Type_Error;
+         end if;
+      end if;
+      if Block.Label /= NULL_TREE then
+         raise Syntax_Error;
+      end if;
+      Block.Label := Build_Decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+      --Pushdecl (Choices.Label);
+   end Start_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode)
+   is
+      Duplicate : Tree;
+   begin
+      if Pushcase (Tree (Expr), Agcc.Trees.Convert'Address,
+                   Block.Label, Duplicate'Address) /= 0 then
+         raise Syntax_Error;
+      end if;
+   end New_Expr_Choice;
+
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode)
+   is
+      Duplicate : Tree;
+   begin
+      if Pushcase_Range (Tree (Low), Tree (High), Agcc.Trees.Convert'Address,
+                         Tree (Block.Label), Duplicate'Address) /= 0
+      then
+         raise Syntax_Error;
+      end if;
+   end New_Range_Choice;
+
+   procedure New_Default_Choice (Block : in out O_Case_Block)
+   is
+      Duplicate : Tree;
+   begin
+      if Pushcase (NULL_TREE, System.Null_Address,
+                   Block.Label, Duplicate'Address) /= 0
+      then
+         raise Syntax_Error;
+      end if;
+   end New_Default_Choice;
+
+   procedure Finish_Choice (Block : in out O_Case_Block)
+   is
+   begin
+      Block.Label := NULL_TREE;
+   end Finish_Choice;
+
+   procedure Finish_Case_Stmt (Block: in out O_Case_Block) is
+   begin
+      Expand_End_Case_Type (Block.Expr, NULL_TREE);
+   end Finish_Case_Stmt;
+end Ortho_Gcc;
diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads
new file mode 100644
index 000000000..e7c3679e1
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.ads
@@ -0,0 +1,557 @@
+--  Ortho implementation 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 Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+with Agcc.Trees; use Agcc.Trees;
+
+
+--  Interface to create nodes.
+package Ortho_Gcc is
+   --- PUBLIC DECLARATIONS
+   --  PUBLIC PART is defined in ortho_nodes.common.ads
+   type O_Cnode is private;
+   type O_Dnode is private;
+   type O_Enode is private;
+   type O_Fnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+
+   --  Alloca builtin, to be set during initialization.
+   Alloca_Function_Ptr : Tree;
+
+   --  Must be called during initialization, before use of any subprograms.
+   procedure Init;
+
+   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;
+
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type Bitsize_Type is range 0 .. 1024;
+
+   --  Standard types metrics.  0 means unknown.
+   Metric_Char        : Bitsize_Type := 0;
+   Metric_Short       : Bitsize_Type := 0;
+   Metric_Int         : Bitsize_Type := 0;
+   Metric_Long        : Bitsize_Type := 0;
+   Metric_Long_Long   : Bitsize_Type := 0;
+   Metric_Enum        : Bitsize_Type := 0;
+   Metric_Float       : Bitsize_Type := 0;
+   Metric_Double      : Bitsize_Type := 0;
+   Metric_Long_Double : Bitsize_Type := 0;
+
+   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 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_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
+      ON_And_Then,              --  ON_Dyadic_Op_Kind
+      ON_Or_Else,               --  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_Or_Else;
+   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);
+   --  COND is NULL for the final else statement.
+   procedure New_Elsif_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
+   type O_Cnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Snode is new Nesting;
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := O_Snode (Nesting_Null);
+
+
+   --  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;
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   procedure List_Init (Constr : out List_Constr_Type);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+
+   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;
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Case_Block is record
+      Expr : Tree;
+      First : Boolean;
+      Label : Tree;
+   end record;
+
+   type O_If_Block is record
+      null;
+   end record;
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is new O_Aggr_List;
+   type O_Array_Aggr_List is new O_Aggr_List;
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+
+   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;
+
+end Ortho_Gcc;
diff --git a/ortho/gcc/ortho_gcc.private.ads b/ortho/gcc/ortho_gcc.private.ads
new file mode 100644
index 000000000..c4a0135e1
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.private.ads
@@ -0,0 +1,122 @@
+--  Ortho implementation 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 Agcc.Trees; use Agcc.Trees;
+
+package Ortho_Nodes is
+   --  PUBLIC PART is defined in ortho_nodes.common.ads
+   type O_Cnode is private;
+   type O_Dnode is private;
+   type O_Enode is private;
+   type O_Fnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+
+   --  Alloca builtin, to be set during initialization.
+   Alloca_Function_Ptr : Tree;
+
+   --  Must be called during initialization, before use of any subprograms.
+   procedure Init;
+private
+   type O_Cnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Snode is new Nesting;
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := O_Snode (Nesting_Null);
+
+
+   --  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;
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   procedure List_Init (Constr : out List_Constr_Type);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+
+   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;
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Case_Block is record
+      Expr : Tree;
+      First : Boolean;
+      Label : Tree;
+   end record;
+
+   type O_If_Block is record
+      null;
+   end record;
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is new O_Aggr_List;
+   type O_Array_Aggr_List is new O_Aggr_List;
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+
+   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;
+
+end Ortho_Nodes;
diff --git a/ortho/gcc/ortho_gcc_front.ads b/ortho/gcc/ortho_gcc_front.ads
new file mode 100644
index 000000000..0b98f4568
--- /dev/null
+++ b/ortho/gcc/ortho_gcc_front.ads
@@ -0,0 +1,19 @@
+--  Ortho implementation 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 Ortho_Front;
+package Ortho_Gcc_Front renames Ortho_Front;
diff --git a/ortho/gcc/ortho_ident.adb b/ortho/gcc/ortho_ident.adb
new file mode 100644
index 000000000..a3779f38c
--- /dev/null
+++ b/ortho/gcc/ortho_ident.adb
@@ -0,0 +1,52 @@
+--  Ortho implementation 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 Agcc; use Agcc;
+with Agcc.Trees;
+with C; use C;
+
+package body Ortho_Ident is
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Str_Nul : String := Str & Nul;
+   begin
+      return Get_Identifier (Str_Nul'Address);
+   end Get_Identifier;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      use Agcc.Trees;
+      Str : C_Str_Len;
+   begin
+      Str.Len := Get_IDENTIFIER_LENGTH (Id);
+      Str.Str := To_C_String (Get_IDENTIFIER_POINTER (Id));
+      return Image (Str);
+   end Get_String;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean
+   is
+      S : C_String;
+   begin
+      if Get_IDENTIFIER_LENGTH (Id) /= Str'Length then
+         return False;
+      end if;
+      S := To_C_String (Get_IDENTIFIER_POINTER (Id));
+      return S.all (1 .. Str'Length) = Str;
+   end Is_Equal;
+
+end Ortho_Ident;
+
diff --git a/ortho/gcc/ortho_ident.ads b/ortho/gcc/ortho_ident.ads
new file mode 100644
index 000000000..84a330e9c
--- /dev/null
+++ b/ortho/gcc/ortho_ident.ads
@@ -0,0 +1,30 @@
+--  Ortho implementation 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 Agcc.Trees; use Agcc.Trees;
+
+package Ortho_Ident is
+   subtype O_Ident is Tree;
+   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
+     Agcc.Trees."=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   O_Ident_Nul : constant O_Ident;
+private
+   O_Ident_Nul : constant O_Ident := NULL_TREE;
+end Ortho_Ident;
diff --git a/ortho/gcc/ortho_nodes.ads b/ortho/gcc/ortho_nodes.ads
new file mode 100644
index 000000000..04d9018e1
--- /dev/null
+++ b/ortho/gcc/ortho_nodes.ads
@@ -0,0 +1,20 @@
+--  Ortho implementation 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 Ortho_Gcc;
+
+package Ortho_Nodes renames Ortho_Gcc;
diff --git a/ortho/ortho_front.ads b/ortho/ortho_front.ads
new file mode 100644
index 000000000..1d20e15d7
--- /dev/null
+++ b/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/ortho/ortho_nodes.common.ads b/ortho/ortho_nodes.common.ads
new file mode 100644
index 000000000..1d245db1e
--- /dev/null
+++ b/ortho/ortho_nodes.common.ads
@@ -0,0 +1,457 @@
+--  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;
+--- PRIVATE CONTEXT CLAUSES
+
+--  Interface to create nodes.
+package ORTHO_NODES is
+   --- PUBLIC DECLARATIONS
+
+   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;
+
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type Bitsize_Type is range 0 .. 1024;
+
+   --  Standard types metrics.  0 means unknown.
+   Metric_Char        : Bitsize_Type := 0;
+   Metric_Short       : Bitsize_Type := 0;
+   Metric_Int         : Bitsize_Type := 0;
+   Metric_Long        : Bitsize_Type := 0;
+   Metric_Long_Long   : Bitsize_Type := 0;
+   Metric_Enum        : Bitsize_Type := 0;
+   Metric_Float       : Bitsize_Type := 0;
+   Metric_Double      : Bitsize_Type := 0;
+   Metric_Long_Double : Bitsize_Type := 0;
+
+   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 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_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
+      ON_And_Then,              --  ON_Dyadic_Op_Kind
+      ON_Or_Else,               --  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_Or_Else;
+   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);
+   --  COND is NULL for the final else statement.
+   procedure New_Elsif_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/parse.adb b/parse.adb
new file mode 100644
index 000000000..8364b29c3
--- /dev/null
+++ b/parse.adb
@@ -0,0 +1,5701 @@
+--  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 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 Types; use Types;
+with Tokens; use Tokens;
+with Scan; use Scan;
+with Iirs_Utils; use Iirs_Utils;
+with Errorout; use Errorout;
+with Std_Names; use Std_Names;
+with Flags;
+with Name_Table;
+with Str_Table;
+with Iir_Chains; use Iir_Chains;
+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 return Iir_Expression;
+   function Parse_Primary return Iir_Expression;
+   function Parse_Use_Clause return Iir_Use_Clause;
+
+   function Parse_Association_Chain 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_Expression return Iir_Expression;
+   function Parse_Subprogram_Declaration 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);
+
+   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
+      use Errorout;
+   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.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
+            Xrefs.Xref_End (Get_Token_Location, Decl);
+         end if;
+      end if;
+      Scan.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.Scan;
+         if Current_Token /= Tok then
+            Error_Msg_Parse
+              ("""end"" must be followed by """ & Image (Tok) & """");
+         else
+            Scan.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.Scan;
+         end case;
+      end loop;
+   end Eat_Tokens_Until_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.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.Scan;
+               return Iir_Inout_Mode;
+            end if;
+            return Iir_In_Mode;
+         when Tok_Out =>
+            Scan.Scan;
+            return Iir_Out_Mode;
+         when Tok_Inout =>
+            Scan.Scan;
+            return Iir_Inout_Mode;
+         when Tok_Linkage =>
+            Scan.Scan;
+            return Iir_Linkage_Mode;
+         when Tok_Buffer =>
+            Scan.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.Scan;
+         return Iir_Bus_Kind;
+      elsif Current_Token = Tok_Register then
+         Scan.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.Scan;
+            if Current_Token = Tok_Box then
+               Unexpected ("<> not allowed here");
+               Scan.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_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.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.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:  RANGE
+   --  postcond: next token
+   function Parse_Range_Constraint return Iir is
+   begin
+      if Current_Token /= Tok_Range then
+         Error_Msg_Parse ("'range' expected");
+         return Null_Iir;
+      end if;
+      Scan.Scan;
+
+      return Parse_Range;
+   end Parse_Range_Constraint;
+
+   --  precond:  next token
+   --  postcond: next token
+   --
+   --  [ 3.2.1 ]
+   --  discrete_range ::= discrete_subtype_indication | range
+   function Parse_Discrete_Range return Iir
+   is
+      Left: Iir;
+      Rng : Iir;
+   begin
+      Left := Parse_Simple_Expression;
+
+      case Current_Token is
+         when Tok_To
+           | Tok_Downto =>
+            return Parse_Range_Right (Left);
+         when Tok_Range =>
+            --  FIXME: create a subtype indication.
+            Rng := Parse_Range_Constraint;
+            Set_Type (Rng, Left);
+            return Rng;
+         when others =>
+            --  Assume a discrete subtype indication.
+            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 ("""" & Str (1 .. Natural (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 ("""" & Str (1 .. Natural (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 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 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
+   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 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;
+
+               -- There is an attribute with a signature.
+               Res := Create_Iir (Iir_Kind_Attribute_Name);
+               Set_Prefix (Res, Prefix);
+               Set_Signature (Res, Parse_Signature);
+               if Current_Token /= Tok_Tick then
+                  Error_Msg_Parse ("' is expected after a signature");
+               else
+                  Set_Location (Res);
+                  Scan.Scan;
+                  if Current_Token /= Tok_Identifier then
+                     Error_Msg_Parse ("attribute_designator expected after '");
+                  else
+                     Set_Attribute_Identifier (Res, Current_Identifier);
+                     Scan.Scan;
+                  end if;
+               end if;
+
+            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.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_Attribute_Identifier (Res, Current_Identifier);
+               Set_Location (Res);
+               Set_Prefix (Res, Prefix);
+               -- accept the identifier.
+               Scan.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_Chain);
+
+            when Tok_Dot =>
+               if Get_Kind (Prefix) = Iir_Kind_String_Literal then
+                  Prefix := String_To_Operator_Symbol (Prefix);
+               end if;
+
+               Scan.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_Suffix_Identifier (Res, Current_Identifier);
+                  when Tok_String =>
+                     Res := Create_Iir (Iir_Kind_Selected_Name);
+                     Set_Location (Res);
+                     Set_Prefix (Res, Prefix);
+                     Set_Suffix_Identifier
+                       (Res, Scan_To_Operator_Name (Get_Token_Location));
+                  when others =>
+                     Error_Msg_Parse ("an identifier or all is expected");
+               end case;
+               Scan.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.Scan;
+
+      return Parse_Name_Suffix (Res, Allow_Indexes);
+   end Parse_Name;
+
+   --  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;
+   begin
+      Res := Parse_Name (Allow_Indexes => False);
+      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 : '('
+   --  postcond: next token
+   --
+   --  [ §4.3.2.1 ]
+   --  interface_list ::= interface_element { ; interface_element }
+   --
+   --  [ §4.3.2.1 ]
+   --  interface_element ::= interface_declaration
+   --
+   --  [ §4.3.2 ]
+   --  interface_declaration ::= interface_constant_declaration
+   --                          | interface_signal_declaration
+   --                          | interface_variable_declaration
+   --                          | interface_file_declaration
+   --
+   --
+   --  [ §3.2.2 ]
+   --  identifier_list ::= identifier { , identifier }
+   --
+   --  [ §4.3.2 ]
+   --  interface_constant_declaration ::=
+   --      [ CONSTANT ] identifier_list : [ IN ] subtype_indication
+   --          [ := STATIC_expression ]
+   --
+   --  [ §4.3.2 ]
+   --  interface_file_declaration ::= FILE identifier_list : subtype_indication
+   --
+   --  [ §4.3.2 ]
+   --  interface_signal_declaration ::=
+   --      [ SIGNAL ] identifier_list : [ mode ] subtype_indication [ BUS ]
+   --          [ := STATIC_expression ]
+   --
+   --  [ §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_Chain (Default: Iir_Kind; Parent : Iir)
+     return Iir
+   is
+      Res, Last : Iir;
+      First, Prev_First : Iir;
+      Interface: Iir;
+      Is_Default : Boolean;
+      Interface_Mode: Iir_Mode;
+      Interface_Type: Iir;
+      Signal_Kind: Iir_Signal_Kind;
+      Default_Value: Iir;
+      Proxy : Iir_Proxy;
+      Lexical_Layout : Iir_Lexical_Layout_Type;
+      Prev_Loc : Location_Type;
+   begin
+      Expect (Tok_Left_Paren);
+      Res := Null_Iir;
+      Last := Null_Iir;
+      loop
+         Prev_Loc := Get_Token_Location;
+         Scan.Scan;
+         case Current_Token is
+            when Tok_Identifier =>
+               Interface := Create_Iir (Default);
+            when Tok_Signal =>
+               Interface := Create_Iir (Iir_Kind_Signal_Interface_Declaration);
+            when Tok_Variable =>
+               Interface :=
+                 Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+            when Tok_Constant =>
+               Interface :=
+                 Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+            when Tok_File =>
+               if Flags.Vhdl_Std = Vhdl_87 then
+                  Error_Msg_Parse ("file interface not allowed in vhdl 87");
+               end if;
+               Interface := Create_Iir (Iir_Kind_File_Interface_Declaration);
+            when Tok_Right_Paren =>
+               Error_Msg_Parse
+                 ("extra ';' at end of interface list", Prev_Loc);
+               exit;
+            when others =>
+               Error_Msg_Parse
+                 ("'signal', 'constant', 'variable', 'file' "
+                  & "or identifier expected");
+               --  Use a variable interface as a fall-back.
+               Interface :=
+                 Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+         end case;
+         if Current_Token = Tok_Identifier then
+            Is_Default := True;
+            Lexical_Layout := 0;
+         else
+            Is_Default := False;
+            Lexical_Layout := Iir_Lexical_Has_Mode;
+            Scan.Scan;
+         end if;
+
+         Prev_First := Last;
+         First := Interface;
+         loop
+            if Current_Token /= Tok_Identifier then
+               Expect (Tok_Identifier);
+            end if;
+            Set_Identifier (Interface, Current_Identifier);
+            Set_Location (Interface);
+
+            if Res = Null_Iir then
+               Res := Interface;
+            else
+               Set_Chain (Last, Interface);
+            end if;
+            Last := Interface;
+
+            Scan.Scan;
+            exit when Current_Token = Tok_Colon;
+            Expect (Tok_Comma, "',' or ':' after an identifier");
+            Scan.Scan;
+            Interface := Create_Iir (Get_Kind (Interface));
+         end loop;
+
+         Expect (Tok_Colon,
+                 "':' must follow the interface element identifier");
+         Scan.Scan;
+
+         --  LRM93 2.1.1
+         --  If the mode is INOUT or OUT, and no object class is explicitly
+         --  specified, variable is assumed.
+         if Is_Default
+           and then Default /= Iir_Kind_Signal_Interface_Declaration
+           and then (Current_Token = Tok_Inout or else Current_Token = Tok_Out)
+         then
+            --  Convert into variable.
+            declare
+               O_Interface : Iir_Constant_Interface_Declaration;
+               N_Interface : Iir_Variable_Interface_Declaration;
+            begin
+               O_Interface := First;
+               while O_Interface /= Null_Iir loop
+                  N_Interface :=
+                    Create_Iir (Iir_Kind_Variable_Interface_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;
+                  Interface := Get_Chain (O_Interface);
+                  Free_Iir (O_Interface);
+                  O_Interface := Interface;
+               end loop;
+               Interface := First;
+            end;
+         end if;
+
+         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;
+
+         case Get_Kind (Interface) is
+            when Iir_Kind_File_Interface_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_Signal_Interface_Declaration
+              | Iir_Kind_Variable_Interface_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_Constant_Interface_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;
+         if Get_Kind (Interface) = Iir_Kind_Signal_Interface_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 (Interface) = Iir_Kind_File_Interface_Declaration then
+               Error_Msg_Parse
+                 ("default expression not allowed for an interface file");
+            end if;
+            Scan.Scan;
+            Default_Value := Parse_Expression;
+         else
+            Default_Value := Null_Iir;
+         end if;
+
+         Interface := First;
+         while Interface /= Null_Iir loop
+            Set_Mode (Interface, Interface_Mode);
+            Set_Parent (Interface, Parent);
+            if Interface = Last then
+               Set_Lexical_Layout (Interface,
+                                   Lexical_Layout or Iir_Lexical_Has_Type);
+            else
+               Set_Lexical_Layout (Interface, Lexical_Layout);
+            end if;
+            if Interface = First then
+               Set_Type (Interface, Interface_Type);
+               if Get_Kind (Interface) /= Iir_Kind_File_Interface_Declaration
+               then
+                  Set_Default_Value (Interface, Default_Value);
+               end if;
+            else
+               Proxy := Create_Iir (Iir_Kind_Proxy);
+               Set_Proxy (Proxy, First);
+               Set_Type (Interface, Proxy);
+            end if;
+            if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration
+            then
+               Set_Signal_Kind (Interface, Signal_Kind);
+            end if;
+            Interface := Get_Chain (Interface);
+         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;
+      Scan.Scan;
+      return Res;
+   end Parse_Interface_Chain;
+
+   --  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
+      -- tok_port must have been scaned.
+      if Current_Token /= Tok_Port then
+         raise Program_Error;
+      end if;
+
+      Scan.Scan;
+      Res := Parse_Interface_Chain
+        (Iir_Kind_Signal_Interface_Declaration, Parent);
+
+      --  Check the interface are signal interfaces.
+      El := Res;
+      while El /= Null_Iir loop
+         if Get_Kind (El) /= Iir_Kind_Signal_Interface_Declaration then
+            Error_Msg_Parse ("port must be a signal", El);
+         end if;
+         El := Get_Chain (El);
+      end loop;
+
+      if Current_Token /= Tok_Semi_Colon then
+         Error_Msg_Parse ("missing "";"" at end of port clause");
+      else
+         Scan.Scan;
+      end if;
+      Set_Port_Chain (Parent, Res);
+   end Parse_Port_Clause;
+
+   --  precond : GENERIC
+   --  postcond: next token
+   --
+   --  [ §1.1.1 ]
+   --  generic_clause ::= GENERIC ( generic_list ) ;
+   --
+   --  [ §1.1.1.1]
+   --  generic_list ::= GENERIC_interface_list
+   procedure Parse_Generic_Clause (Parent : Iir)
+   is
+      Res: Iir;
+   begin
+      -- tok_port must have been scaned.
+      if Current_Token /= Tok_Generic then
+         raise Program_Error;
+      end if;
+
+      Scan.Scan;
+      Res := Parse_Interface_Chain
+        (Iir_Kind_Constant_Interface_Declaration, Parent);
+      if Current_Token /= Tok_Semi_Colon then
+         Error_Msg_Parse ("missing "";"" at end of generic clause");
+      else
+         Scan.Scan;
+      end if;
+      Set_Generic_Chain (Parent, Res);
+   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.Scan;
+      if Current_Token = Tok_Right_Paren then
+         Error_Msg_Parse ("at least one literal must be declared");
+         Scan.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.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.Scan;
+      end loop;
+      Scan.Scan;
+      return Enum_Type;
+   end Parse_Enumeration_Type_Definition;
+
+   --  precond : ARRAY
+   --  postcond: ??
+   --
+   --  [ §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
+   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;
+      Rng : Iir;
+   begin
+      Loc := Get_Token_Location;
+
+      Scan_Expect (Tok_Left_Paren);
+      Scan.Scan;
+      First := True;
+      Index_List := Create_Iir_List;
+
+      loop
+         Type_Mark := Parse_Simple_Expression;
+         case Current_Token is
+            when Tok_Range =>
+               --  Type_Mark is a name...
+               Scan.Scan;
+               if Current_Token = Tok_Box then
+                  --  This is an index_subtype_definition.
+                  Index_Constrained := False;
+                  Scan.Scan;
+                  Def := Type_Mark;
+               else
+                  Index_Constrained := True;
+                  Rng := Parse_Range;
+                  --  FIXME: create a subtype_definition ?
+                  if Rng /= Null_Iir then
+                     Set_Type (Rng, Type_Mark);
+                     Def := Rng;
+                  else
+                     Def := Type_Mark;
+                  end if;
+               end if;
+            when Tok_To
+              | Tok_Downto =>
+               Index_Constrained := True;
+               Def := Parse_Range_Right (Type_Mark);
+--                Def := Create_Iir (Iir_Kind_Subtype_Definition);
+--                Location_Copy (Def, Type_Mark);
+--                Set_Type_Mark (Def, Type_Mark);
+--                Set_Range_Constraint (Def, Rng);
+            when others =>
+               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.Scan;
+      end loop;
+
+      if Array_Constrained then
+         Res_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+      else
+         Res_Type := Create_Iir (Iir_Kind_Array_Type_Definition);
+      end if;
+      Set_Location (Res_Type, Loc);
+      Set_Index_Subtype_List (Res_Type, Index_List);
+
+      Expect (Tok_Right_Paren);
+      Scan_Expect (Tok_Of);
+      Scan.Scan;
+      Set_Element_Subtype (Res_Type, Parse_Subtype_Indication);
+      return Res_Type;
+   end Parse_Array_Definition;
+
+   --  precond : UNITS
+   --  postcond: next token
+   --
+   --  [ §3.1.3 ]
+   --  physical_type_definition ::=
+   --      range_constraint
+   --          UNITS
+   --              base_unit_declaration
+   --              { secondary_unit_declaration }
+   --          END UNITS [ PHYSICAL_TYPE_simple_name ]
+   --
+   --  [ §3.1.3 ]
+   --  base_unit_declaration ::= identifier ;
+   --
+   --  [ §3.1.3 ]
+   --  secondary_unit_declaration ::= identifier = physical_literal ;
+   function Parse_Physical_Type_Definition
+     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);
+      Expect (Tok_Units);
+      Scan.Scan;
+      --  Parse primary unit.
+      Expect (Tok_Identifier);
+      Unit := Create_Iir (Iir_Kind_Unit_Declaration);
+      Set_Location (Unit);
+      Set_Identifier (Unit, Current_Identifier);
+      Build_Init (Last);
+      Append (Last, Res, Unit);
+      Scan_Expect (Tok_Semi_Colon);
+      Scan.Scan;
+      --  Parse secondary units.
+      while Current_Token /= Tok_End loop
+         Unit := Create_Iir (Iir_Kind_Unit_Declaration);
+         Set_Location (Unit);
+         Set_Identifier (Unit, Current_Identifier);
+         Scan_Expect (Tok_Equal);
+         Scan.Scan;
+         Multiplier := Parse_Primary;
+         Set_Physical_Literal (Unit, Multiplier);
+         case Get_Kind (Multiplier) is
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Physical_Int_Literal =>
+               null;
+            when others =>
+               Error_Msg_Parse ("a physical literal is expected here");
+         end case;
+         Append (Last, Res, Unit);
+         Expect (Tok_Semi_Colon);
+         Scan.Scan;
+      end loop;
+      Scan.Scan;
+      Expect (Tok_Units);
+      Scan.Scan;
+      return Res;
+   end Parse_Physical_Type_Definition;
+
+   --  precond : RECORD
+   --  postcond: next token
+   --
+   --  [ §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_Definition return Iir_Record_Type_Definition
+   is
+      use Iir_Chains.Element_Declaration_Chain_Handling;
+      Res: Iir_Record_Type_Definition;
+      Last : Iir_Element_Declaration;
+      El: Iir_Element_Declaration;
+      First : Iir;
+      Pos: Iir_Index32;
+      Subtype_Indication: Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Record_Type_Definition);
+      Set_Location (Res);
+      Scan.Scan;
+      Pos := 0;
+      Build_Init (Last);
+      First := Null_Iir;
+      loop
+         pragma Assert (First = Null_Iir);
+         --  Parse identifier_list
+         loop
+            El := Create_Iir (Iir_Kind_Element_Declaration);
+            Set_Location (El);
+            Expect (Tok_Identifier);
+            Set_Identifier (El, Current_Identifier);
+            Append (Last, Res, El);
+            Set_Element_Position (El, Pos);
+            Pos := Pos + 1;
+            if First = Null_Iir then
+               First := El;
+            end if;
+            Scan.Scan;
+            exit when Current_Token /= Tok_Comma;
+            Scan.Scan;
+         end loop;
+         Expect (Tok_Colon);
+         Scan.Scan;
+         Subtype_Indication := Parse_Subtype_Indication;
+         while First /= Null_Iir loop
+            Set_Type (First, Subtype_Indication);
+            First := Get_Chain (First);
+         end loop;
+         Expect (Tok_Semi_Colon);
+         Scan.Scan;
+         exit when Current_Token = Tok_End;
+      end loop;
+      Set_Number_Element_Declaration (Res, Pos);
+      Scan_Expect (Tok_Record);
+      Scan.Scan;
+      return Res;
+   end Parse_Record_Definition;
+
+   --  precond : ACCESS
+   --  postcond: ?
+   --
+   --  [§3.3]
+   --  access_type_definition ::= ACCESS subtype_indication.
+   function Parse_Access_Definition return Iir_Access_Type_Definition is
+      Res : Iir_Access_Type_Definition;
+   begin
+      Res := Create_Iir (Iir_Kind_Access_Type_Definition);
+      Set_Location (Res);
+      Expect (Tok_Access);
+      Scan.Scan;
+      Set_Designated_Type (Res, Parse_Subtype_Indication);
+      return Res;
+   end Parse_Access_Definition;
+
+   --  precond : FILE
+   --  postcond: ???
+   --
+   --  [ §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.Scan;
+      Type_Mark := Parse_Type_Mark (Check_Paren => True);
+      if Get_Kind (Type_Mark) not in Iir_Kinds_Name then
+         Error_Msg_Parse ("type mark expected");
+      else
+         Set_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.Scan;
+      if Current_Token = Tok_Body then
+         Res := Create_Iir (Iir_Kind_Protected_Type_Body);
+         Scan.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 (Decl, Res);
+      end if;
+      Set_Identifier (Decl, Ident);
+      Set_Location (Decl, Loc);
+      Parse_Declarative_Part (Res);
+      Expect (Tok_End);
+      Scan_Expect (Tok_Protected);
+      if Get_Kind (Res) = Iir_Kind_Protected_Type_Body then
+         Scan_Expect (Tok_Body);
+      end if;
+      Scan.Scan;
+      Check_End_Name (Decl);
+      return Decl;
+   end Parse_Protected_Type_Definition;
+
+   --  precond : TYPE
+   --  postcond: a token
+   --
+   --  [ §4.1 ]
+   --  type_definition ::= scalar_type_definition
+   --                    | composite_type_definition
+   --                    | access_type_definition
+   --                    | file_type_definition
+   --                    | protected_type_definition
+   --
+   --  [ §3.1 ]
+   --  scalar_type_definition ::= enumeration_type_definition
+   --                           | integer_type_definition
+   --                           | floating_type_definition
+   --                           | physical_type_definition
+   --
+   --  [ §3.2 ]
+   --  composite_type_definition ::= array_type_definition
+   --                              | record_type_definition
+   --
+   --  [ §3.1.2 ]
+   --  integer_type_definition ::= range_constraint
+   --
+   --  [ 3.1.4 ]
+   --  floating_type_definition ::= range_constraint
+   function Parse_Type_Declaration return Iir
+   is
+      Def : Iir;
+      Loc : Location_Type;
+      Ident : Name_Id;
+      Decl : Iir;
+   begin
+      -- The current token must be type.
+      if Current_Token /= Tok_Type then
+         raise Program_Error;
+      end if;
+
+      -- Get the identifier
+      Scan_Expect (Tok_Identifier,
+                   "an identifier is expected after 'type' keyword");
+      Loc := Get_Token_Location;
+      Ident := Current_Identifier;
+
+      Scan.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.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);
+            Def := Parse_Range_Constraint;
+            Set_Type (Decl, Def);
+            if Current_Token = Tok_Units then
+               declare
+                  Unit_Def : Iir;
+               begin
+                  Unit_Def := Parse_Physical_Type_Definition;
+                  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 (Decl);
+                  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);
+            Set_Type (Decl, Parse_Record_Definition);
+            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 (Decl);
+            end if;
+         when Tok_Access =>
+            Def := Parse_Access_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);
+               Set_Type (Decl, Def);
+            when Iir_Kind_Array_Subtype_Definition =>
+               Decl := Create_Iir (Iir_Kind_Anonymous_Type_Declaration);
+               Set_Type (Decl, Def);
+            when others =>
+               Error_Kind ("parse_type_declaration", Def);
+         end case;
+      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 : identifier
+   --  postcond: next token
+   --
+   --  [ §4.2 ]
+   --  subtype_indication ::=
+   --      [ RESOLUTION_FUNCTION_name ] type_mark [ constraint ]
+   --
+   --  [ §4.2 ]
+   --  constraint ::= range_constraint | index_constraint
+   --
+   --  [ §3.2.1]
+   --  index_constraint ::= ( discrete_range { , discrete_range } )
+   function Parse_Subtype_Indication (Name : Iir := Null_Iir)
+     return Iir
+   is
+      Type_Mark : Iir;
+      Def: Iir;
+      El: Iir;
+      Resolution_Function: Iir;
+   begin
+      -- FIXME: location.
+      Resolution_Function := Null_Iir;
+
+      if Name /= Null_Iir then
+         Type_Mark := Name;
+      else
+         if Current_Token /= Tok_Identifier then
+            Error_Msg_Parse ("type mark expected in a subtype indication");
+            raise Parse_Error;
+         end if;
+         Type_Mark := Parse_Name (Allow_Indexes => False);
+      end if;
+
+      if Current_Token = Tok_Identifier then
+         Resolution_Function := Type_Mark;
+         Type_Mark := Parse_Type_Mark (Check_Paren => False);
+      end if;
+
+      case Current_Token is
+         when Tok_Left_Paren =>
+            --  Index_constraint.
+            Def := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+            Set_Location (Def);
+            Set_Type_Mark (Def, Type_Mark);
+            Set_Resolution_Function (Def, Resolution_Function);
+            Set_Index_Subtype_List (Def, Create_Iir_List);
+            -- index_constraint ::= (discrete_range {, discrete_range} )
+            loop
+               -- accept parenthesis or comma.
+               Scan.Scan;
+               El := Parse_Discrete_Range;
+               Append_Element (Get_Index_Subtype_List (Def), El);
+               exit when Current_Token = Tok_Right_Paren;
+               Expect (Tok_Comma);
+            end loop;
+            Scan.Scan;
+
+         when Tok_Range =>
+            --  range_constraint.
+            Def := Create_Iir (Iir_Kind_Subtype_Definition);
+            Location_Copy (Def, Type_Mark);
+            Set_Type_Mark (Def, Type_Mark);
+            Set_Range_Constraint (Def, Parse_Range_Constraint);
+            Set_Resolution_Function (Def, Resolution_Function);
+
+         when others =>
+            if Resolution_Function = Null_Iir then
+               Def := Type_Mark;
+            else
+               Def := Create_Iir (Iir_Kind_Subtype_Definition);
+               Location_Copy (Def, Type_Mark);
+               Set_Type_Mark (Def, Type_Mark);
+               Set_Resolution_Function (Def, Resolution_Function);
+            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.Scan;
+      Def := Parse_Subtype_Indication;
+      Set_Type (Decl, Def);
+
+      Expect (Tok_Semi_Colon);
+      return Decl;
+   end Parse_Subtype_Declaration;
+
+   --  precond : token (CONSTANT, SIGNAL, VARIABLE, FILE)
+   --  postcond: ;
+   --
+   --  KIND can be iir_kind_constant_declaration, iir_kind_file_declaration
+   --   or iir_kind_variable_declaration
+   --
+   --  [ §4.3.1 ]
+   --  object_declaration ::= constant_declaration
+   --                       | signal_declaration
+   --                       | variable_declaration
+   --                       | file_declaration
+   --
+   --  [ §4.3.1.1 ]
+   --  constant_declaration ::=
+   --      CONSTANT identifier_list : subtype_indication [ := expression ]
+   --
+   --  [ §4.3.1.4 ]
+   --  file_declaration ::=
+   --      FILE identifier_list : subtype_indication [ file_open_information ]
+   --
+   --  [ §4.3.1.4 ]
+   --  file_open_information ::=
+   --      [ OPEN FILE_OPEN_KIND_expression ] IS file_logical_name
+   --
+   --  [ §4.3.1.4 ]
+   --  file_logical_name ::= STRING_expression
+   --
+   --  [ §4.3.1.3 ]
+   --  variable_declaration ::=
+   --      [ SHARED ] VARIABLE identifier_list : subtype_indication
+   --          [ := expression ]
+   --
+   --  [ §4.3.1.2 ]
+   --  signal_declaration ::=
+   --      SIGNAL identifier_list : subtype_information [ signal_kind ]
+   --          [ := expression ]
+   --
+   --  [ §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;
+      Proxy : Iir_Proxy;
+      Kind: Iir_Kind;
+      Shared : 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.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;
+      end loop;
+
+      -- The colon was parsed.
+      Scan.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;
+         Scan.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.Scan;
+            Open_Kind := Parse_Expression;
+         else
+            Open_Kind := Null_Iir;
+         end if;
+
+         if Flags.Vhdl_Std = Vhdl_87 then
+            --  LRM 4.3.1.4
+            --  The default mode is IN, if no mode is specified.
+            Mode := Iir_In_Mode;
+         else
+            --  GHDL: no mode for vhdl 93.
+            Mode := Iir_Unknown_Mode;
+         end if;
+
+         Logical_Name := Null_Iir;
+         if Current_Token = Tok_Is then
+            Scan.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;
+               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;
+
+      Proxy := Null_Iir;
+      Object := First;
+      while Object /= Null_Iir loop
+         -- Type definitions are factorized.  This is OK, but not done by
+         -- sem.
+         if Object = First then
+            Set_Type (Object, Object_Type);
+         else
+            --  FIXME: could avoid to create many proxies, by adding
+            --  a reference counter.
+            Proxy := Create_Iir (Iir_Kind_Proxy);
+            Set_Proxy (Proxy, First);
+            Set_Type (Object, Proxy);
+         end if;
+         if Kind = Iir_Kind_File_Declaration then
+            Set_Mode (Object, Mode);
+            Set_File_Open_Kind (Object, Open_Kind);
+            Set_File_Logical_Name (Object, Logical_Name);
+         end if;
+         if Kind /= Iir_Kind_File_Declaration then
+            Set_Default_Value (Object, Default_Value);
+         end if;
+         if Kind = Iir_Kind_Signal_Declaration then
+            Set_Signal_Kind (Object, Signal_Kind);
+         end if;
+         Object := Get_Chain (Object);
+      end loop;
+      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.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;
+         Scan.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);
+      Scan.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.Scan;
+         end loop;
+      end if;
+      if Current_Token = Tok_Return then
+         Scan.Scan;
+         Set_Return_Type (Res, Parse_Name);
+      end if;
+      Expect (Tok_Right_Bracket);
+      Scan.Scan;
+      return Res;
+   end Parse_Signature;
+
+   --  precond : ALIAS
+   --  postcond: a token
+   --
+   --  [ §4.3.3 ]
+   --  alias_declaration ::=
+   --      ALIAS alias_designator [ : subtype_indication ]
+   --          IS name [ signature ] ;
+   --
+   --  [ §4.3.3 ]
+   --  alias_designator ::= identifier | character_literal | operator_symbol
+   --
+   --  FIXME: signature
+   function Parse_Alias_Declaration return Iir
+   is
+      Res: Iir;
+      Loc : Location_Type;
+      Ident : Name_Id;
+   begin
+      -- accept ALIAS.
+      Scan.Scan;
+      Loc := Get_Token_Location;
+      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;
+      Scan.Scan;
+      if Current_Token = Tok_Colon then
+         Scan.Scan;
+         Res := Create_Iir (Iir_Kind_Object_Alias_Declaration);
+         Set_Type (Res, Parse_Subtype_Indication);
+         --  FIXME: nice message if token is ':=' ?
+         Expect (Tok_Is);
+         Scan.Scan;
+         Set_Name (Res, Parse_Name);
+         --  FIXME: emit error if token = '['
+      elsif Current_Token = Tok_Is then
+         Res := Create_Iir (Iir_Kind_Non_Object_Alias_Declaration);
+         Scan.Scan;
+         Set_Name (Res, Parse_Name (Allow_Indexes => False));
+         if Current_Token = Tok_Left_Bracket then
+            Set_Signature (Res, Parse_Signature);
+         end if;
+      else
+         Error_Msg_Parse ("'is' or ':' expected");
+         Res := Create_Iir (Iir_Kind_Object_Alias_Declaration);
+         Eat_Tokens_Until_Semi_Colon;
+      end if;
+
+      Set_Location (Res, Loc);
+      Set_Identifier (Res, Ident);
+
+      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.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.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.Scan;
+      if Current_Token = Tok_Left_Bracket then
+         Name := Res;
+         Res := Parse_Signature;
+         Set_Name (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.Scan;
+         when Tok_Others =>
+            List := Iir_List_Others;
+            Scan.Scan;
+         when others =>
+            List := Create_Iir_List;
+            loop
+               El := Parse_Entity_Designator;
+               Append_Element (List, El);
+               exit when Current_Token /= Tok_Comma;
+               Scan.Scan;
+            end loop;
+      end case;
+      Set_Entity_Name_List (Attribute, List);
+      if Current_Token = Tok_Colon then
+         Scan.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.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.Scan;
+               Set_Type (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.Scan;
+               Parse_Entity_Name_List (Res);
+               Expect (Tok_Is);
+               Scan.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.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.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.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.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.Scan;
+               Set_Group_Template_Name
+                 (Res, Parse_Name (Allow_Indexes => False));
+               Expect (Tok_Left_Paren);
+               Scan.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.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.Scan;
+            return Iir_List_Others;
+         when Tok_All =>
+            Scan.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.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);
+      Expect (Tok_Disconnect);
+      Scan.Scan;
+      Set_Signal_List (Res, Parse_Signal_List);
+      Expect (Tok_Colon);
+      Scan.Scan;
+      Set_Type (Res, Parse_Name (Allow_Indexes => False));
+      Expect (Tok_After);
+      Scan.Scan;
+      Set_Expression (Res, Parse_Expression);
+      return Res;
+   end Parse_Disconnection_Specification;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §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;
+
+               --  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_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_Declaration
+                    | 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;
+            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 =>
+                     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.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.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.Scan;
+
+      Parse_Generic_Port_Clauses (Res);
+
+      Parse_Declarative_Part (Res);
+
+      if Current_Token = Tok_Begin then
+         Scan.Scan;
+         Parse_Concurrent_Statements (Res);
+      end if;
+
+      --   end keyword is expected to finish an entity declaration
+      Expect (Tok_End);
+      Set_End_Location (Unit);
+
+      Scan.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;
+         Scan.Scan;
+      end if;
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Invalidate_Current_Token;
+      Set_Library_Unit (Unit, Res);
+   end Parse_Entity_Declaration;
+
+   --  [ §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);
+            Scan.Scan;
+            return A_Choice;
+         else
+            Expr1 := Parse_Expression;
+         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_Expression (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_Expression (A_Choice, Parse_Range_Right (Expr1));
+         return A_Choice;
+--       elsif Get_Kind (Expr1) in Iir_Kinds_Name then
+--          A_Choice := Create_Iir (Iir_Kind_Choice_By_Name);
+--          Location_Copy (A_Choice, Expr1);
+--          Set_Name (A_Choice, Parse_Range_Type_Expression (Expr1));
+--          return A_Choice;
+      else
+         A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression);
+         Location_Copy (A_Choice, Expr1);
+         Set_Expression (A_Choice, Expr1);
+         return A_Choice;
+      end if;
+   end Parse_A_Choice;
+
+   --  [ §7.3.2 ]
+   --  choices ::= choice { | choice }
+   --
+   -- Leave tok_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.Scan;
+         Expr1 := Null_Iir;
+      end loop;
+   end Parse_Choices;
+
+   --  precond : '('
+   --  postcond: next token
+   --
+   --  This can be an expression or an aggregate.
+   --
+   --  [ §7.3.2 ]
+   --  aggregate ::= ( element_association { , element_association } )
+   --
+   --  [ §7.3.2 ]
+   --  element_association ::= [ choices => ] expression
+   function Parse_Aggregate return Iir
+   is
+      use Iir_Chains.Association_Choices_Chain_Handling;
+      Expr: Iir;
+      Res: Iir_Aggregate;
+      Last : Iir;
+      Assoc: Iir;
+      Loc : Location_Type;
+   begin
+      Loc := Get_Token_Location;
+      Scan.Scan;
+      if Current_Token /= Tok_Others then
+         Expr := Parse_Expression;
+         case Current_Token is
+            when Tok_Comma
+              | Tok_Arrow
+              | Tok_Bar =>
+               --  This is really an aggregate
+               null;
+            when Tok_Right_Paren =>
+               -- This was just a braced expression.
+               -- Eat ')'.
+               Scan.Scan;
+               return Expr;
+            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);
+      if Expr /= Null_Iir then
+         Location_Copy (Res, Expr);
+      else
+         Set_Location (Res);
+      end if;
+      Build_Init (Last);
+      loop
+         if Current_Token = Tok_Others then
+            Assoc := Parse_A_Choice (Null_Iir);
+            Expect (Tok_Arrow);
+            Scan.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_Arrow);
+                  Scan.Scan;
+                  Expr := Parse_Expression;
+            end case;
+         end if;
+         Set_Associated (Assoc, Expr);
+         Append_Subchain (Last, Res, Assoc);
+         exit when Current_Token = Tok_Right_Paren;
+         Expect (Tok_Comma);
+         Scan.Scan;
+         Expr := Null_Iir;
+      end loop;
+      Scan.Scan;
+      return Res;
+   end Parse_Aggregate;
+
+   --  precond : NEW
+   --  postcond: ???
+   --
+   --  [ §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.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);
+      else
+         Res := Create_Iir (Iir_Kind_Allocator_By_Expression);
+      end if;
+      Set_Location (Res, Loc);
+      Set_Expression (Res, Expr);
+      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;
+            Scan.Scan;
+            if Current_Token = Tok_Identifier then
+               -- physical literal
+               Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+               Set_Unit_Name (Res, Current_Text);
+               Scan.Scan;
+            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;
+            Scan.Scan;
+            if Current_Token = Tok_Identifier then
+               -- physical literal
+               Res := Create_Iir (Iir_Kind_Physical_Fp_Literal);
+               Set_Unit_Name (Res, Current_Text);
+               Scan.Scan;
+            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.Scan;
+            if Current_Token = Tok_Tick then
+               Error_Msg_Parse
+                 ("prefix of an attribute can't be a character literal");
+               --  skip tick.
+               Scan.Scan;
+               --  skip attribute designator
+               Scan.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.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.Scan;
+            return Res;
+         when Tok_Minus
+           | Tok_Plus =>
+            Error_Msg_Parse
+              ("'-' and '+' are not allowed in primary, use parenthesis");
+            return Parse_Simple_Expression;
+         when others =>
+            Unexpected ("primary");
+            return Null_Iir;
+      end case;
+   end Parse_Primary;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  factor ::= primary [ ** primary ]
+   --           | ABS primary
+   --           | NOT primary
+   function Parse_Factor return Iir_Expression is
+      Res, Tmp: Iir_Expression;
+   begin
+      case Current_Token is
+         when Tok_Abs =>
+            Scan.Scan;
+            Res := Create_Iir (Iir_Kind_Absolute_Operator);
+            Set_Location (Res);
+            Set_Operand (Res, Parse_Primary);
+            return Res;
+         when Tok_Not =>
+            Res := Create_Iir (Iir_Kind_Not_Operator);
+            Set_Location (Res);
+            Scan.Scan;
+            Set_Operand (Res, Parse_Primary);
+            return Res;
+         when others =>
+            Tmp := Parse_Primary;
+            if Current_Token = Tok_Double_Star then
+               Res := Create_Iir (Iir_Kind_Exponentiation_Operator);
+               Set_Location (Res);
+               Scan.Scan;
+               Set_Left (Res, Tmp);
+               Set_Right (Res, Parse_Primary);
+               return Res;
+            else
+               return Tmp;
+            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 return Iir_Expression is
+      Res, Tmp: Iir_Expression;
+   begin
+      Res := Parse_Factor;
+      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.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 return Iir_Expression is
+      Res, Tmp: Iir_Expression;
+   begin
+      if Current_Token in Token_Sign_Type 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.Scan;
+         Set_Operand (Res, Parse_Term);
+      else
+         Res := Parse_Term;
+      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.Scan;
+         Set_Left (Tmp, Res);
+         Set_Right (Tmp, Parse_Term);
+         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.Scan;
+      Set_Left (Res, Tmp);
+      Set_Right (Res, Parse_Simple_Expression);
+      return Res;
+   end Parse_Shift_Expression;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  relation ::= shift_expression [ relational_operator shift_expression ]
+   --
+   --  [ §7.2 ]
+   --  relational_operator ::= = | /= | < | <= | > | >=
+   function Parse_Relation return Iir_Expression is
+      Res, Tmp: Iir_Expression;
+   begin
+      Tmp := Parse_Shift_Expression;
+      if Current_Token not in Token_Relational_Operator_Type then
+         return Tmp;
+      end if;
+
+      --  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 others =>
+               raise Program_Error;
+         end case;
+         Set_Location (Res);
+         Scan.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;
+
+   --  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 return Iir_Expression is
+      Res, Tmp: Iir_Expression;
+
+      --  OP_TOKEN contains the operator combinaison.
+      Op_Token: Token_Type;
+   begin
+      Tmp := Parse_Relation;
+      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.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.Scan;
+         end if;
+
+         Set_Left (Res, Tmp);
+         Set_Right (Res, Parse_Relation);
+         Tmp := Res;
+      end loop;
+   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.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.Scan;
+               Set_Time (We, Parse_Expression);
+            end if;
+            exit when Current_Token /= Tok_Comma;
+            Scan.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.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.Scan;
+            Set_Reject_Time_Expression (Assign, Parse_Expression);
+            Expect (Tok_Inertial);
+            Scan.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.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 : in out Iir) is
+   begin
+      if Current_Token = Tok_Guarded then
+         Set_Guard (Stmt, Stmt);
+         Scan.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.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.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.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.Scan;  -- accept 'with' token.
+      Res := Create_Iir (Iir_Kind_Concurrent_Selected_Signal_Assignment);
+      Set_Location (Res);
+      Set_Expression (Res, Parse_Expression);
+
+      Expect (Tok_Select, "after expression");
+      Scan.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.Scan;
+
+      Parse_Options (Res);
+
+      Build_Init (Last);
+      loop
+         Wf_Chain := Parse_Waveform;
+         Expect (Tok_When, "after waveform");
+         Scan.Scan;
+         Assoc := Parse_Choices (Null_Iir);
+         Set_Associated (Assoc, Wf_Chain);
+         Append_Subchain (Last, Res, Assoc);
+         exit when Current_Token = Tok_Semi_Colon;
+         Expect (Tok_Comma, "after choice");
+         Scan.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.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.Scan;
+      Set_Assertion_Condition (Stmt, Parse_Expression);
+      if Current_Token = Tok_Report then
+         Scan.Scan;
+         Set_Report_Expression (Stmt, Parse_Expression);
+      end if;
+      if Current_Token = Tok_Severity then
+         Scan.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.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.Scan;
+      Set_Report_Expression (Res, Parse_Expression);
+      if Current_Token = Tok_Severity then
+         Scan.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.Scan;
+      case Current_Token is
+         when Tok_On =>
+            List := Create_Iir_List;
+            Set_Sensitivity_List (Res, List);
+            Scan.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.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.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.Scan;
+      Clause := Res;
+      loop
+         Set_Condition (Clause, Parse_Expression);
+         Expect (Tok_Then, "'then' is expected here");
+         Scan.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.Scan;
+            Set_Sequential_Statement_Chain
+              (Clause, Parse_Sequential_Statements (Res));
+            exit;
+         elsif Current_Token = Tok_Elsif then
+            Scan.Scan;
+         else
+            Error_Msg_Parse ("'else' or 'elsif' expected");
+         end if;
+      end loop;
+      Expect (Tok_End);
+      Scan_Expect (Tok_If);
+      Scan.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_Implementation (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_Implementation (Call, Name);
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Parenthesis_Name_To_Procedure_Call;
+
+   --  precond : identifier
+   --  postcond: next token
+   --
+   --  [ §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);
+      Scan_Expect (Tok_In);
+      Scan.Scan;
+      -- parse a range.
+      Set_Type (Decl, Parse_Range_Expression (Null_Iir, True));
+      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.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.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_Implementation (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.Scan;
+            if Current_Token = Tok_Colon then
+               Scan.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.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_left_paren
+               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.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);
+               Scan.Scan;
+               Set_Iterator_Scheme
+                 (Stmt, Parse_Parameter_Specification (Stmt));
+               Expect (Tok_Loop);
+               Scan.Scan;
+               Set_Sequential_Statement_Chain
+                 (Stmt, Parse_Sequential_Statements (Stmt));
+               Expect (Tok_End);
+               Scan_Expect (Tok_Loop);
+               Scan.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.Scan;
+                  Set_Condition (Stmt, Parse_Expression);
+                  Expect (Tok_Loop);
+               end if;
+               Scan.Scan;
+               Set_Sequential_Statement_Chain
+                 (Stmt, Parse_Sequential_Statements (Stmt));
+               Expect (Tok_End);
+               Scan_Expect (Tok_Loop);
+               Scan.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;
+               Scan.Scan;
+               if Current_Token = Tok_Identifier then
+                  Set_Loop (Stmt, Current_Text);
+                  Scan.Scan;
+               end if;
+               if Current_Token = Tok_When then
+                  Scan.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.Scan;
+                  Set_Expression (Stmt, Parse_Expression);
+                  Expect (Tok_Is);
+                  Scan.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
+                     Expect (Tok_When);
+                     Scan.Scan;
+                     if Current_Token = Tok_Arrow then
+                        Error_Msg_Parse ("missing expression in alternative");
+                     else
+                        Assoc := Parse_Choices (Null_Iir);
+                     end if;
+                     Expect (Tok_Arrow);
+                     Scan.Scan;
+                     Set_Associated
+                       (Assoc, Parse_Sequential_Statements (Stmt));
+                     Append_Subchain (Last_Assoc, Stmt, Assoc);
+                  end loop;
+                  Scan_Expect (Tok_Case);
+                  Scan.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;
+         Expect (Tok_Semi_Colon);
+         Scan.Scan;
+
+         --  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 return Iir
+   is
+      Subprg: Iir;
+      Subprg_Body : Iir;
+      Old : Iir;
+   begin
+      -- Create the node.
+      case Current_Token is
+         when Tok_Procedure =>
+            Subprg := Create_Iir (Iir_Kind_Procedure_Declaration);
+         when Tok_Function
+           | Tok_Pure
+           | Tok_Impure =>
+            Subprg := Create_Iir (Iir_Kind_Function_Declaration);
+         when others =>
+            raise Internal_Error;
+      end case;
+      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;
+            --  FIXME: what to do in case of error ??
+            --  Eat PURE or IMPURE.
+            Scan.Scan;
+            Expect (Tok_Function, "'function' must follow 'pure' or 'impure'");
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      --  Eat PROCEDURE or FUNCTION.
+      Scan.Scan;
+
+      if Current_Token = Tok_Identifier then
+         Set_Identifier (Subprg, Current_Identifier);
+         Set_Location (Subprg);
+      elsif Current_Token = Tok_String then
+         if Get_Kind (Subprg) = 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.Scan;
+      if Current_Token = Tok_Left_Paren then
+         --  Parse the interface declaration.
+         Set_Interface_Declaration_Chain
+           (Subprg,
+            Parse_Interface_Chain (Iir_Kind_Constant_Interface_Declaration,
+                                   Subprg));
+      end if;
+
+      if Current_Token = Tok_Return then
+         if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then
+            Error_Msg_Parse ("'return' not allowed for a procedure");
+            Error_Msg_Parse ("(remove return part or define a function)");
+            Scan.Scan;
+            Old := Parse_Type_Mark;
+         else
+            Scan.Scan;
+            Set_Return_Type (Subprg, Parse_Type_Mark (Check_Paren => True));
+         end if;
+      else
+         if Get_Kind (Subprg) = 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;
+      if Get_Kind (Subprg) = 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);
+
+      Expect (Tok_Is);
+      Scan.Scan;
+      Parse_Declarative_Part (Subprg_Body);
+      Expect (Tok_Begin);
+      Scan.Scan;
+      Set_Sequential_Statement_Chain
+        (Subprg_Body, Parse_Sequential_Statements (Subprg_Body));
+      Expect (Tok_End);
+      Scan.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 Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then
+               Error_Msg_Parse ("'procedure' expected instead of 'function'");
+            end if;
+            Scan.Scan;
+         when Tok_Procedure =>
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse ("'procedure' not allowed here by vhdl 87");
+            end if;
+            if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then
+               Error_Msg_Parse ("'function' expected instead of 'procedure'");
+            end if;
+            Scan.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;
+            Scan.Scan;
+         when others =>
+            null;
+      end case;
+      Expect (Tok_Semi_Colon);
+      return Subprg;
+   end Parse_Subprogram_Declaration;
+
+   --  precond:  PROCESS
+   --  postcond: null
+   --
+   --  [ §9.2 ]
+   --  process_statement ::=
+   --    [ PROCESS_label : ]
+   --       [ POSTPONED ] PROCESS [ ( sensitivity_list ) ] [ IS ]
+   --           process_declarative_part
+   --       BEGIN
+   --           process_statement_part
+   --       END [ POSTPONED ] PROCESS [ PROCESS_label ] ;
+   --
+   --  FIXME: POSTPONED
+   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.Scan;
+
+      if Current_Token = Tok_Left_Paren then
+         Res := Create_Iir (Iir_Kind_Sensitized_Process_Statement);
+         Scan.Scan;
+         Sensitivity_List := Create_Iir_List;
+         Set_Sensitivity_List (Res, Sensitivity_List);
+         Parse_Sensitivity_List (Sensitivity_List);
+         Expect (Tok_Right_Paren);
+         Scan.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;
+         Scan.Scan;
+      end if;
+
+      -- declarative part.
+      Parse_Declarative_Part (Res);
+
+      Expect (Tok_Begin);
+      Scan.Scan;
+
+      Set_Sequential_Statement_Chain (Res, Parse_Sequential_Statements (Res));
+
+      Expect (Tok_End);
+      Scan.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;
+         Scan.Scan;
+      end if;
+
+      if Current_Token = Tok_Semi_Colon then
+         Error_Msg_Parse ("""end"" must be followed by ""process""");
+      else
+         Expect (Tok_Process);
+         Scan.Scan;
+         Check_End_Name (Res);
+         Expect (Tok_Semi_Colon);
+      end if;
+      return Res;
+   end Parse_Process_Statement;
+
+   -- precond : '('
+   -- postcond: NEXT_TOKEN
+   --
+   --  [ §4.3.2.2 ]
+   --  association_list ::= association_element { , association_element }
+   --
+   --  [ §4.3.2.2 ]
+   --  association_element ::= [ formal_part => ] actual_part
+   --
+   --  [ §4.3.2.2 ]
+   --  actual_part ::= actual_designator
+   --                | FUNCTION_name ( actual_designator )
+   --                | type_mark ( actual_designator )
+   --
+   --  [ §4.3.2.2 ]
+   --  actual_designator ::= expression
+   --                      | SIGNAL_name
+   --                      | VARIABLE_name
+   --                      | FILE_name
+   --                      | OPEN
+   --
+   --  [ §4.3.2.2 ]
+   --  formal_part ::= formal_designator
+   --                | FUNCTION_name ( formal_designator )
+   --                | type_mark ( formal_designator )
+   --
+   --  [ §4.3.2.2 ]
+   --  formal_designator ::= GENERIC_name
+   --                      | PORT_name
+   --                      | PARAMETER_name
+   --
+   --  Note: an actual part is parsed as an expression.
+   function Parse_Association_Chain return Iir
+   is
+      Res, Last: Iir;
+      El: Iir;
+      Formal: Iir;
+      Actual: Iir;
+      Nbr_Assocs : Natural;
+   begin
+      Sub_Chain_Init (Res, Last);
+
+      Expect (Tok_Left_Paren);
+      Scan.Scan;
+
+      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.
+         Formal := Null_Iir;
+         if Current_Token /= Tok_Open then
+            Actual := Parse_Expression;
+            case Current_Token is
+               when Tok_To
+                 | Tok_Downto =>
+                  Actual := Parse_Range_Expression (Actual);
+                  if Nbr_Assocs /= 1 then
+                     Error_Msg_Parse ("multi-dimensional slice is forbidden");
+                  end if;
+               when Tok_Arrow =>
+                  Formal := Actual;
+                  Scan.Scan;
+                  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);
+            Scan.Scan; -- past open.
+         else
+            El := Create_Iir (Iir_Kind_Association_Element_By_Expression);
+            if Formal = Null_Iir then
+               Set_Location (El);
+            else
+               Location_Copy (El, Formal);
+            end if;
+            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.Scan;
+         Nbr_Assocs := Nbr_Assocs + 1;
+      end loop;
+      Scan.Scan;
+      return Res;
+   end Parse_Association_Chain;
+
+   --  precond : GENERIC
+   --  postcond: next token
+   --
+   --  [ §5.2.1.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.Scan;
+      return Parse_Association_Chain;
+   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.Scan;
+      return Parse_Association_Chain;
+   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.Scan;
+            return Parse_Name (False);
+         when Tok_Entity =>
+            Res := Create_Iir (Iir_Kind_Entity_Aspect_Entity);
+            Set_Location (Res);
+            Scan.Scan;
+            Set_Entity (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.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 (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);
+            Expect (Tok_Semi_Colon);
+            Scan.Scan;
+         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);
+            Expect (Tok_Semi_Colon);
+            Scan.Scan;
+         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.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.Scan;
+         Set_Guard_Expression (Guard, Parse_Expression);
+         Expect (Tok_Right_Paren, "a ')' is expected after guard expression");
+         Scan.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.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.Scan;
+      Parse_Concurrent_Statements (Res);
+      Check_End_Name (Tok_Block, Res);
+      return Res;
+   end Parse_Block_Statement;
+
+   --  precond : IF or FOR
+   --  postcond: ';'
+   --
+   --  [ §9.7 ]
+   --  generate_statement ::=
+   --      GENERATE_label : generation_scheme GENERATE
+   --          [ { block_declarative_item }
+   --      BEGIN ]
+   --          { concurrent_statement }
+   --      END GENERATE [ GENERATE_label ] ;
+   --
+   --  [ §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.Scan;
+            Set_Generation_Scheme (Res, Parse_Parameter_Specification (Res));
+         when Tok_If =>
+            Scan.Scan;
+            Set_Generation_Scheme (Res, Parse_Expression);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Expect (Tok_Generate);
+
+      Scan.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);
+            Scan.Scan;
+         when others =>
+            null;
+      end case;
+
+      Parse_Concurrent_Statements (Res);
+      Expect (Tok_End);
+      Scan_Expect (Tok_Generate);
+      Scan.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
+   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 others =>
+            -- or a component instantiation.
+            return Parse_Component_Instantiation (Target);
+      end case;
+   end Parse_Concurrent_Assignment;
+
+   procedure Parse_Concurrent_Statements (Parent : Iir)
+   is
+      Last_Stmt : Iir;
+      Stmt: Iir;
+      Label: Name_Id;
+      Id: Iir;
+      Postponed : Boolean;
+      Loc : Location_Type;
+      Target : Iir;
+   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.Scan;
+            if Current_Token = Tok_Colon then
+               -- The identifier is really a label.
+               Scan.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.Scan;
+         end if;
+
+         case Current_Token is
+            when Tok_End =>
+               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 =>
+               if Postponed then
+                  Error_Msg_Parse
+                    ("'postponed' is not allowed before 'block'");
+                  Postponed := False;
+               end if;
+               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 =>
+               if Postponed then
+                  Error_Msg_Parse ("'postponed' not allowed before " &
+                                   "an instantiation statement");
+                  Postponed := False;
+               end if;
+               declare
+                  Unit : Iir;
+               begin
+                  Unit := Parse_Instantiated_Unit;
+                  Stmt := Parse_Component_Instantiation (Unit);
+               end;
+            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);
+            Set_Label (Stmt, Label);
+            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.Scan;
+      end loop;
+   end Parse_Concurrent_Statements;
+
+   --  precond : LIBRARY
+   --  postcond: ;
+   --
+   --  [ §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);
+         Scan_Expect (Tok_Identifier);
+         Set_Identifier (Library, Current_Identifier);
+         Set_Location (Library);
+         Sub_Chain_Append (First, Last, Library);
+         Scan.Scan;
+         exit when Current_Token = Tok_Semi_Colon;
+         Expect (Tok_Comma);
+      end loop;
+      Scan.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.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.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 (Unit : Iir_Design_Unit)
+   is
+      Res: Iir_Architecture_Declaration;
+   begin
+      Expect (Tok_Architecture);
+      Res := Create_Iir (Iir_Kind_Architecture_Declaration);
+
+      -- Get identifier.
+      Scan_Expect (Tok_Identifier);
+      Set_Identifier (Res, Current_Identifier);
+      Set_Location (Res);
+      Scan.Scan;
+      if Current_Token = Tok_Is then
+         Error_Msg_Parse ("architecture identifier is missing");
+      else
+         Expect (Tok_Of);
+         Scan.Scan;
+         Set_Entity (Res, Parse_Name (False));
+         Expect (Tok_Is);
+      end if;
+
+      Scan.Scan;
+      Parse_Declarative_Part (Res);
+
+      Expect (Tok_Begin);
+      Scan.Scan;
+      Parse_Concurrent_Statements (Res);
+      -- end was scanned.
+      Set_End_Location (Unit);
+      Scan.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;
+         Scan.Scan;
+      end if;
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Set_Library_Unit (Unit, Res);
+   end Parse_Architecture;
+
+   --  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.Scan;
+            return Iir_List_All;
+         when Tok_Others =>
+            Scan.Scan;
+            return Iir_List_Others;
+         when Tok_Identifier =>
+            Res := Create_Iir_List;
+            loop
+               Append_Element (Res, Current_Text);
+               Scan.Scan;
+               exit when Current_Token /= Tok_Comma;
+               Expect (Tok_Comma);
+               Scan.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 (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.Scan;
+            end if;
+         when Tok_Configuration =>
+            Res := Create_Iir (Iir_Kind_Entity_Aspect_Configuration);
+            Set_Location (Res);
+            Scan_Expect (Tok_Identifier);
+            Set_Configuration (Res, Parse_Name (False));
+         when Tok_Open =>
+            Res := Create_Iir (Iir_Kind_Entity_Aspect_Open);
+            Set_Location (Res);
+            Scan.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.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);
+            Expect (Tok_Semi_Colon);
+            Scan.Scan;
+         when others =>
+            null;
+      end case;
+      if Current_Token = Tok_For then
+         Set_Block_Configuration (Res, Parse_Block_Configuration);
+         --  Eat ';'.
+         Scan.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.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.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.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.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.Scan;
+            return Parse_Component_Configuration (Loc, Iir_List_All);
+         when Tok_Others =>
+            Scan.Scan;
+            return Parse_Component_Configuration (Loc, Iir_List_Others);
+         when Tok_Identifier =>
+            El := Current_Text;
+            Scan.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.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.Scan;
+      end loop;
+   end Parse_Configuration_Declarative_Part;
+
+   --  precond : CONFIGURATION
+   --  postcond: ';'
+   --
+   --  [ §1.3 ]
+   --  configuration_declaration ::=
+   --      CONFIGURATION identifier OF ENTITY_name IS
+   --          configuration_declarative_part
+   --          block_configuration
+   --      END [ CONFIGURATION ] [ CONFIGURATION_simple_name ] ;
+   --
+   --  [ §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);
+      Scan_Expect (Tok_Of);
+      Scan.Scan;
+      Set_Entity (Res, Parse_Name (False));
+      Expect (Tok_Is);
+
+      Scan.Scan;
+      Parse_Configuration_Declarative_Part (Res);
+
+      Set_Block_Configuration (Res, Parse_Block_Configuration);
+
+      Scan_Expect (Tok_End);
+      Set_End_Location (Unit);
+      -- end was scanned.
+      Scan.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;
+         Scan.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 : identifier
+   --  postcond: ';'
+   --
+   --  [ §2.5 ]
+   --  package_declaration ::=
+   --      PACKAGE identifier IS
+   --          package_declarative_part
+   --      END [ PACKAGE ] [ PACKAGE_simple_name ] ;
+   procedure Parse_Package_Declaration (Unit : Iir_Design_Unit)
+   is
+      Res: Iir_Package_Declaration;
+   begin
+      Res := Create_Iir (Iir_Kind_Package_Declaration);
+      Set_Location (Res);
+
+      -- Get identifier.
+      Expect (Tok_Identifier);
+      Set_Identifier (Res, Current_Identifier);
+      Scan_Expect (Tok_Is);
+      Scan.Scan;
+
+      Parse_Declarative_Part (Res);
+
+      Expect (Tok_End);
+      Set_End_Location (Unit);
+      Scan.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;
+         Scan.Scan;
+      end if;
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Set_Library_Unit (Unit, Res);
+   end Parse_Package_Declaration;
+
+   --  precond : BODY
+   --  postcond: ';'
+   --
+   --  [ §2.6 ]
+   --  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.Scan;
+
+      Parse_Declarative_Part (Res);
+
+      Expect (Tok_End);
+      Set_End_Location (Unit);
+      Scan.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;
+         Scan_Expect (Tok_Body);
+         Scan.Scan;
+      end if;
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Set_Library_Unit (Unit, Res);
+   end Parse_Package_Body;
+
+   -- 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.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.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.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 (Res);
+         when Tok_Package =>
+            Scan.Scan;
+            if Current_Token = Tok_Body then
+               Scan.Scan;
+               Parse_Package_Body (Res);
+            else
+               Parse_Package_Declaration (Res);
+            end if;
+         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/parse.ads b/parse.ads
new file mode 100644
index 000000000..5c56c2818
--- /dev/null
+++ b/parse.ads
@@ -0,0 +1,33 @@
+--  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 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 Parse is
+   -- 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/post_sems.adb b/post_sems.adb
new file mode 100644
index 000000000..2eee5c0a0
--- /dev/null
+++ b/post_sems.adb
@@ -0,0 +1,67 @@
+--  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 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 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 : Iir;
+      Lib : Iir_Library_Declaration;
+      Id : Name_Id;
+
+      Value : Iir_Attribute_Value;
+      Spec : Iir_Attribute_Specification;
+      Attr_Decl : Iir_Attribute_Declaration;
+   begin
+      Lib_Unit := Get_Library_Unit (Unit);
+      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 (Unit);
+         while Value /= Null_Iir loop
+            Spec := Get_Attribute_Specification (Value);
+            Attr_Decl := 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/post_sems.ads b/post_sems.ads
new file mode 100644
index 000000000..15fcb4449
--- /dev/null
+++ b/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 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 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/scan-scan_literal.adb b/scan-scan_literal.adb
new file mode 100644
index 000000000..21c54fb73
--- /dev/null
+++ b/scan-scan_literal.adb
@@ -0,0 +1,626 @@
+--  Lexical analysis for numbers.
+--  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.Unchecked_Conversion;
+
+separate (Scan)
+
+-- 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
+      T : Uint32;
+   begin
+      T := Uint32 (V);
+      for I in Digit_Range loop
+         T := Uint32 (E.S (I)) * Uint32 (B) + T;
+         Res.S (I) := Uint16 (T mod Uint16'Modulus);
+         T := T / Uint16'Modulus;
+      end loop;
+
+      --  There is a carry, shift.
+      if T /= 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;
+      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
+         --  Lost of precision.
+         --  Round.
+         if T (Max - Nbr_Digits) >= Uint16 (Uint16'Modulus / 2) then
+            V := 1;
+            for I in reverse 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);
+      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.
+      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.
+      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;
+
+               Q := Q * 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
+                  Q := Q + 1;
+                  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
+                  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/scan.adb b/scan.adb
new file mode 100644
index 000000000..9dddf2ec1
--- /dev/null
+++ b/scan.adb
@@ -0,0 +1,1175 @@
+--  VHDL lexical scanner.
+--  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; use Ada.Characters.Latin_1;
+with Ada.Characters.Handling;
+with Tokens; use Tokens;
+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 Scan 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,
+
+      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 others =>
+               Error_Msg_Scan
+                 ("character '" & C & "' not allowed in a bit string");
+               goto Again;
+         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;
+
+      -- 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.
+         if Current_Identifier > Std_Names.Name_Last_Vhdl87
+           and then 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;
+         elsif Current_Identifier > Std_Names.Name_Last_Vhdl93
+           and then 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;
+         else
+            Current_Token := Token_Type'Val
+              (Token_Type'Pos (Tok_First_Keyword)
+               + Current_Identifier - Std_Names.Name_First_Keyword);
+         end if;
+      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;
+
+   -- 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 | CR =>
+            -- Accept CR, LF, CR+LF or LF+CR as line separator.
+            if (Source (Pos) = LF and then Source (Pos + 1) = CR)
+              or else (Source (Pos) = CR and then Source (Pos + 1) = LF)
+            then
+               Pos := Pos + 2;
+            else
+               Pos := Pos + 1;
+            end if;
+            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);
+            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;
+
+               -- 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;
+            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;
+            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 '|' | '!' =>
+            -- LRM93 13.10
+            -- A vertical line (|) can be replaced by an exclamation mark (!)
+            -- where used as a delimiter.
+            Current_Token := Tok_Bar;
+            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 '&' =>
+            Current_Token := Tok_Ampersand;
+            Pos := Pos + 1;
+            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
+               Current_Token := Tok_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 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;
+            return;
+         when ']' =>
+            if Vhdl_Std = Vhdl_87 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 '{' =>
+            Error_Msg_Scan ("'{' is an invalid character, replaced by '('");
+            Pos := Pos + 1;
+            Current_Token := Tok_Left_Paren;
+            return;
+         when '}' =>
+            Error_Msg_Scan ("'}' is an invalid character, replaced by ')'");
+            Pos := Pos + 1;
+            Current_Token := Tok_Right_Paren;
+            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 '$' | '@' | '?' | '`'
+           | 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 '_' =>
+            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 Scan;
diff --git a/scan.ads b/scan.ads
new file mode 100644
index 000000000..28100aa0c
--- /dev/null
+++ b/scan.ads
@@ -0,0 +1,97 @@
+--  VHDL lexical scanner.
+--  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 Tokens; use Tokens;
+
+package Scan 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;
+
+   -- 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 Scan;
diff --git a/sem.adb b/sem.adb
new file mode 100644
index 000000000..ae6669282
--- /dev/null
+++ b/sem.adb
@@ -0,0 +1,2295 @@
+--  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 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 Types; use Types;
+with Errorout; use Errorout;
+with Std_Package; use Std_Package;
+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 Iirs_Utils; use Iirs_Utils;
+with Flags;
+with Name_Table;
+with Str_Table;
+with Sem_Stmts; use Sem_Stmts;
+with Sem_Types; use Sem_Types;
+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
+   begin
+      Add_Dependence (Get_Current_Design_Unit, Unit);
+   end Add_Dependence;
+
+   --  LRM 1.1  Entity declaration.
+   procedure Sem_Entity_Declaration (Entity: Iir_Entity_Declaration)
+   is
+      Unit : Iir_Design_Unit;
+      Implicit : Implicit_Signal_Declaration_Type;
+   begin
+      Unit := Get_Design_Unit (Entity);
+      Xrefs.Xref_Decl (Entity);
+      Sem_Scopes.Add_Name (Unit);
+      Set_Visible_Flag (Unit, 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), Interface_Generic);
+
+      -- Sem ports.
+      Sem_Interface_Chain (Get_Port_Chain (Entity), Interface_Port);
+
+      -- entity declarative part.
+      Push_Signals_Declarative_Part (Implicit, Entity);
+      Sem_Declaration_Chain (Entity);
+      Sem_Specification_Chain (Entity, Null_Iir);
+
+      --  Check for missing subprogram bodies.
+      Check_Full_Declaration (Entity, Entity);
+
+      -- statements.
+      Sem_Concurrent_Statement_Chain (Entity, True);
+      Pop_Signals_Declarative_Part (Implicit);
+      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_Unit : Iir;
+      Entity_Library : Iir;
+   begin
+      Name := Get_Entity (Library_Unit);
+      Library := Get_Library
+        (Get_Design_File (Get_Design_Unit (Library_Unit)));
+      if Get_Kind (Name) = Iir_Kind_Simple_Name then
+         Entity_Unit := Libraries.Load_Primary_Unit
+           (Library, Get_Identifier (Name), Library_Unit);
+         if Entity_Unit = Null_Iir then
+            Error_Msg_Sem ("entity " & Disp_Node (Name) & " was not analysed",
+                           Library_Unit);
+            return Null_Iir;
+         end if;
+         Set_Named_Entity (Name, Entity_Unit);
+      else
+         Sem_Name (Name, False);
+         Entity_Unit := Get_Named_Entity (Name);
+         if Entity_Unit = Error_Mark then
+            return Null_Iir;
+         end if;
+      end if;
+      if Get_Kind (Entity_Unit) = Iir_Kind_Design_Unit then
+         Entity_Library := Get_Library_Unit (Entity_Unit);
+         Xrefs.Xref_Ref (Name, Entity_Library);
+         if Get_Kind (Entity_Library) = Iir_Kind_Entity_Declaration then
+            --  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 (Entity_Unit)) /= Library then
+               Error_Msg_Sem
+                 (Disp_Node (Entity_Library) & " does not reside in "
+                  & Disp_Node (Library), Library_Unit);
+               return Null_Iir;
+            end if;
+            return Entity_Unit;
+         end if;
+      end if;
+
+      Error_Msg_Sem ("entity name expected, found " & Disp_Node (Entity_Unit),
+                     Library_Unit);
+      return Null_Iir;
+   end Sem_Entity_Name;
+
+   --  LRM 1.2  Architecture bodies.
+   procedure Sem_Architecture_Declaration (Arch: Iir_Architecture_Declaration)
+   is
+      Unit : Iir_Design_Unit;
+      Entity_Unit : Iir_Design_Unit;
+      Entity_Library : Iir_Entity_Declaration;
+   begin
+      Xrefs.Xref_Decl (Arch);
+      -- First, find the entity.
+      Entity_Unit := Sem_Entity_Name (Arch);
+      if Entity_Unit = Null_Iir then
+         return;
+      end if;
+      Entity_Library := Get_Library_Unit (Entity_Unit);
+
+      --  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);
+
+      -- Transforms an identifier into an entity_decl.
+      Set_Entity (Arch, Entity_Library);
+
+      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_Unit, Get_Identifier (Entity_Unit), 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.
+      Unit := Get_Design_Unit (Arch);
+      Sem_Scopes.Add_Name (Unit, Get_Identifier (Unit), True);
+      Set_Visible_Flag (Unit, 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 Flags.Vhdl_Std >= Vhdl_02 then
+         Open_Declarative_Region;
+      end if;
+      Sem_Block (Arch, True);
+      if Flags.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_Declaration;
+
+   --  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_Signal_Interface_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_Function (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_Base_Name (Formal);
+      Actual_Base := Get_Base_Name (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 and ports interfaces;
+   --  ASSOC_PARENT constains generics and ports map aspects.
+   procedure Sem_Generic_Port_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir)
+   is
+      El : Iir;
+      Actual : Iir;
+      Prefix : Iir;
+      Object : Iir;
+      Match : Boolean;
+      Assoc_Chain : Iir;
+      Miss_Generic : Missing_Type;
+      Miss_Port : Missing_Type;
+      Inter : Iir;
+      Formal : 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.
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Miss_Generic := Missing_Generic;
+               Miss_Port := Missing_Port;
+            else
+               Miss_Generic := Missing_Allowed;
+               if Get_Kind (Inter_Parent) = Iir_Kind_Entity_Declaration then
+                  --  FIXME: to be checked.
+                  --  Ghdl: for a direct instantiation, follow rules of
+                  --  LRM 1.1.1.2 Ports.
+                  Miss_Port := Missing_Port;
+               else
+                  Miss_Port := Missing_Allowed;
+               end if;
+            end if;
+         when Iir_Kind_Binding_Indication =>
+            --  LRM 5.2.1.2  Generic map and port map aspects
+            Miss_Generic := Missing_Allowed;
+            Miss_Port := Missing_Allowed;
+         when Iir_Kind_Block_Header =>
+            --  FIXME: it is possible to have port unassociated ?
+            Miss_Generic := Missing_Generic;
+            Miss_Port := Missing_Port;
+         when others =>
+            Error_Kind ("sem_generic_port_association_list", Assoc_Parent);
+      end case;
+
+      Assoc_Chain := Get_Generic_Map_Aspect_Chain (Assoc_Parent);
+      if Sem_Actual_Of_Association_Chain (Assoc_Chain) then
+         Sem_Association_Chain
+           (Get_Generic_Chain (Inter_Parent), Assoc_Chain,
+            True, Miss_Generic, Assoc_Parent, Match);
+         Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
+
+         --  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;
+         if Match then
+            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 =>
+                     null;
+                  when Iir_Kind_Association_Element_By_Individual =>
+                     null;
+                  when others =>
+                     Error_Kind
+                       ("sem_generic_port_map_association_chain(1)", El);
+               end case;
+               El := Get_Chain (El);
+            end loop;
+         end if;
+      end if;
+
+      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_Port, 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
+            Formal := Inter;
+            Inter := Get_Chain (Inter);
+         else
+            Inter := Null_Iir;
+         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_Base_Name (Object);
+            end if;
+            case Get_Kind (Prefix) is
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Signal_Interface_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_Signal_Interface_Declaration
+                  then
+                     declare
+                        P : Boolean;
+                     begin
+                        P := Check_Port_Association_Restriction
+                          (Get_Base_Name (Formal), Prefix, El);
+                     end;
+                  end if;
+               when others =>
+                  --  Expression.
+                  Set_Collapse_Signal_Flag (El, False);
+                  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 (Get_Base_Name (Formal)) /= 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_Generic_Port_Association_Chain;
+
+   --  LRM 1.3  Configuration Declarations.
+   procedure Sem_Configuration_Declaration (Decl: Iir)
+   is
+      Unit : Iir_Design_Unit;
+      Entity_Design: 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_Design := Sem_Entity_Name (Decl);
+      if Entity_Design = Null_Iir then
+         return;
+      end if;
+      Set_Entity (Decl, Entity_Design);
+
+      --  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_Design);
+
+      Unit := Get_Design_Unit (Decl);
+      Sem_Scopes.Add_Name (Unit);
+      Set_Visible_Flag (Unit, 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_Design);
+      Sem_Scopes.Add_Entity_Declarations (Get_Library_Unit (Entity_Design));
+
+      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_Declaration;
+               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_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_Declaration;
+               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_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_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 := Block_Spec;
+                  when Iir_Kind_Parenthesis_Name =>
+                     Block := Get_Prefix (Block_Spec);
+                  when Iir_Kind_Slice_Name =>
+                     Block := Get_Prefix (Block_Spec);
+                  when others =>
+                     Error_Msg_Sem ("label expected", Block_Spec);
+                     return;
+               end case;
+               Block := Find_Declaration (Block, Decl_Label);
+               if Block = Null_Iir then
+                  return;
+               end if;
+               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);
+                     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);
+                  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
+            exit when El = Null_Iir;
+            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_Component_Name (Conf);
+      if Get_Kind (Comp) /= Iir_Kind_Component_Declaration then
+         --  There has been an error in sem_component_specification.
+         --  Leave here.
+         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.
+      -- FIXME: ports and generics declared by the component must be
+      --   made visible here; create a declarative_region only for this purpose
+      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_Associated_Formal (S_El);
+                        F_El := F_Chain;
+                        while F_El /= Null_Iir loop
+                           exit when Get_Associated_Formal (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 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration =>
+            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)) = True 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)
+              or else Get_Resolution_Function (Left)
+              /= Get_Resolution_Function (Right)
+            then
+               return False;
+            end if;
+            if Get_Type_Declarator (Left) /= Get_Type_Declarator (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)
+              or else (Get_Resolution_Function (Left)
+                       /= Get_Resolution_Function (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_Integer_Literal
+           | Iir_Kind_Enumeration_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_Physical_Int_Literal =>
+            if Get_Value (Left) /= Get_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_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 =>
+            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 .. Natural (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 =>
+            return Are_Trees_Equal (Get_Associated (Left),
+                                    Get_Associated (Right));
+         when Iir_Kind_Choice_By_Name =>
+            if not Are_Trees_Equal (Get_Name (Left), Get_Name (Right)) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Associated (Left),
+                                    Get_Associated (Right));
+         when Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range =>
+            if not Are_Trees_Equal (Get_Expression (Left),
+                                    Get_Expression (Right)) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Associated (Left),
+                                    Get_Associated (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 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
+      Inter : Name_Interpretation_Type;
+      Prev : Iir;
+      Num : Iir_Int32;
+   begin
+      Inter := Get_Interpretation (Get_Identifier (Decl));
+      if Valid_Interpretation (Inter)
+        and then Is_In_Current_Declarative_Region (Inter)
+      then
+         --  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;
+            when others =>
+               --  Can be an enumeration literal or an error.
+               Num := 0;
+         end case;
+      else
+         --  No previous declaration in the current declarative region.
+         Num := 0;
+      end if;
+      Set_Overload_Number (Decl, Num);
+   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_Logical_Operators
+           | Name_Xnor
+           | 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 operator must have two parameters", Subprg);
+         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.
+   function Sem_Subprogram_Declaration (Subprg: Iir) return Iir
+   is
+      Spec: Iir;
+      Interface_Chain : Iir;
+      Subprg_Body : Iir;
+   begin
+      --  Set depth.
+      declare
+         Parent : 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, Interface_Function);
+            Set_Return_Type
+              (Subprg, Sem_Subtype_Indication (Get_Return_Type (Subprg)));
+         when Iir_Kind_Procedure_Declaration =>
+            Sem_Interface_Chain (Interface_Chain, Interface_Procedure);
+            --  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);
+            declare
+               Inter : Iir;
+            begin
+               Inter := Interface_Chain;
+               while Inter /= Null_Iir loop
+                  if Get_Kind (Inter) = Iir_Kind_Signal_Interface_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;
+
+      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);
+         Free_Old_Iir (Subprg);
+         Set_Subprogram_Specification (Subprg_Body, Spec);
+         Set_Subprogram_Body (Spec, Subprg_Body);
+         return 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);
+         return Subprg;
+      end if;
+   end Sem_Subprogram_Declaration;
+
+   procedure Add_Analysis_Checks_List (El : Iir)
+   is
+      Design : 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 thr 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_Signal_Interface_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.
+            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 (Spec) = 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 necessary.
+            if Get_Wait_State (Spec) = Unknown then
+               declare
+                  Callees : Iir_List;
+                  Callee : Iir;
+                  State : Tri_State_Type;
+               begin
+                  Callees := Get_Callees_List (Spec);
+                  --  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;
+         when Iir_Kind_Function_Declaration =>
+            if Get_Callees_List (Spec) /= 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;
+
+   procedure Update_And_Check_Pure_Wait (Subprg : Iir)
+   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 := Get_Callees_List (Subprg);
+      Callee : Iir;
+      Callee_Bod : Iir;
+      Subprg_Depth : Iir_Int32;
+      Subprg_Bod : Iir;
+      --  Current purity depth of SUBPRG.
+      Depth : Iir_Int32;
+      Depth_Callee : Iir_Int32;
+      Has_Unknown : Boolean;
+      Has_Pure_Errors : Boolean := False;
+      Has_Wait_Errors : Boolean := False;
+      Npos : Natural;
+   begin
+      --  If the subprogram has no callee list, there is nothing to do.
+      if Callees_List = Null_Iir_List then
+         return;
+      end if;
+
+      --  This subprogram is being considered.
+      --  To avoid infinite loop, suppress its callees list.
+      Set_Callees_List (Subprg, Null_Iir_List);
+
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration =>
+            Kind := K_Function;
+            Subprg_Bod := Null_Iir;
+            Subprg_Depth := Get_Subprogram_Depth (Subprg);
+            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;
+            if Get_Purity_State (Subprg) = Impure
+              and then Get_Wait_State (Subprg) /= Unknown
+            then
+               --  No need to go further.
+               Destroy_Iir_List (Callees_List);
+               return;
+            end if;
+            Subprg_Bod := Get_Subprogram_Body (Subprg);
+            Subprg_Depth := Get_Subprogram_Depth (Subprg);
+            Depth := Get_Impure_Depth (Subprg_Bod);
+         when Iir_Kind_Sensitized_Process_Statement =>
+            Kind := K_Process;
+            Subprg_Bod := Null_Iir;
+            Subprg_Depth := 0;
+            Depth := Iir_Depth_Impure;
+         when others =>
+            Error_Kind ("update_and_check_pure_wait(1)", Subprg);
+      end case;
+
+      --  First loop: check without recursion.
+      --  Second loop: recurse if necessary.
+      Has_Unknown := False;
+      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;
+            if Get_Kind (Callee) /= Iir_Kind_Procedure_Declaration then
+               --  Pure functions should not be in the list.
+               --  Impure functions must have directly set Purity_State.
+               Error_Kind ("update_and_check_pure_wait(3)", Callee);
+            end if;
+
+            --  Check pure.
+            Callee_Bod := Get_Subprogram_Body (Callee);
+            if Callee_Bod = Null_Iir then
+               --  No body yet for the subprogram called.
+               --  Nothing can be extracted from it, postpone the checks.
+               Has_Unknown := True;
+            else
+               --  Second loop: recurse if a state is not known.
+               if J = 1 and then (Get_Purity_State (Callee) = Unknown
+                                  or else Get_Wait_State (Callee) = Unknown)
+               then
+                  Update_And_Check_Pure_Wait (Callee);
+               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.
+                     --  FIXME: check the compare.
+                     Depth_Callee := Iir_Depth_Impure;
+                     if Kind = K_Function then
+                        Error_Pure (Subprg, Callee, Null_Iir);
+                        Has_Pure_Errors := True;
+                     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;
+
+            --  Keep in list.
+            if Callee_Bod = Null_Iir
+              or else (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))
+            then
+               Replace_Nth_Element (Callees_List, Npos, Callee);
+               Npos := Npos + 1;
+            end if;
+         end 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;
+            exit;
+         else
+            Set_Nbr_Elements (Callees_List, Npos);
+         end if;
+      end loop;
+
+      Set_Callees_List (Subprg, Callees_List);
+   end 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;
+      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 ?
+               Update_And_Check_Pure_Wait (El);
+               Callees := Get_Callees_List (El);
+               if Callees /= Null_Iir_List then
+                  if Emit_Warnings then
+                     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;
+                  Keep := True;
+               end if;
+            when Iir_Kind_Sensitized_Process_Statement =>
+               Update_And_Check_Pure_Wait (El);
+               if Get_Callees_List (El) /= Null_Iir_List then
+                  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;
+                  Keep := True;
+               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 (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_Use_Clause =>
+               null;
+            when Iir_Kind_Component_Declaration =>
+               null;
+            when Iir_Kind_Protected_Type_Body =>
+               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;
+   begin
+      Unit := Get_Design_Unit (Decl);
+      Sem_Scopes.Add_Name (Unit);
+      Set_Visible_Flag (Unit, True);
+      Xref_Decl (Decl);
+
+      --  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);
+
+      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;
+
+   --  LRM 10.4  Use Clauses.
+   procedure Sem_Use_Clause (Clauses: Iir_Use_Clause)
+   is
+      Clause : Iir_Use_Clause;
+      Name: Iir;
+      Prefix: Iir;
+      Prefix_Name : 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 =>
+               Prefix := Get_Prefix (Name);
+            when others =>
+               Error_Msg_Sem ("use clause allows only selected name", Name);
+               return;
+         end case;
+
+         Sem_Name (Prefix, False);
+         Prefix_Name := Get_Named_Entity (Prefix);
+         if Prefix_Name = Error_Mark then
+            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_Name) is
+            when Iir_Kind_Library_Declaration =>
+               null;
+            when Iir_Kind_Design_Unit =>
+               if Get_Kind (Get_Library_Unit (Prefix_Name))
+                 /= Iir_Kind_Package_Declaration
+               then
+                  Error_Msg_Sem ("design unit is not a package", Prefix);
+                  return;
+               end if;
+               Libraries.Load_Design_Unit (Prefix_Name, Clause);
+            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, False);
+               if Get_Named_Entity (Name) = Error_Mark then
+                  return;
+               end if;
+               Xref_Name (Name);
+            when Iir_Kind_Selected_By_All_Name =>
+               Xref_Name (Prefix);
+               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 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 (Std_Standard_Unit);
+      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_Declaration =>
+            Sem_Architecture_Declaration (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 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/sem.ads b/sem.ads
new file mode 100644
index 000000000..c37500819
--- /dev/null
+++ b/sem.ads
@@ -0,0 +1,78 @@
+--  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 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 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 entit_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.
+   --  SUBPRG is either a _specification or a _spec_body.
+   function Sem_Subprogram_Declaration (Subprg: Iir) return 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);
+
+end Sem;
diff --git a/sem_assocs.adb b/sem_assocs.adb
new file mode 100644
index 000000000..d85774675
--- /dev/null
+++ b/sem_assocs.adb
@@ -0,0 +1,1679 @@
+--  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 GCC; 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;
+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
+   --  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
+            Error_Msg_Sem ("positional argument after named argument", Assoc);
+            Ok := False;
+         end if;
+         if Get_Kind (Assoc) /= Iir_Kind_Association_Element_Open 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;
+
+   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;
+
+   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;
+      Interface : 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.
+            Interface := Inter;
+            Inter := Get_Chain (Inter);
+         else
+            --  Association by name.
+            Interface := Get_Base_Name (Formal);
+            Inter := Null_Iir;
+         end if;
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_Open =>
+               if Get_Default_Value (Interface) = Null_Iir then
+                  Error_Msg_Sem
+                    ("no parameter for " & Disp_Node (Interface), 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_Base_Name (Object);
+               else
+                  Prefix := Actual;
+               end if;
+
+               case Get_Kind (Interface) is
+                  when Iir_Kind_Signal_Interface_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_Signal_Interface_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 (Interface));
+                           end if;
+                        when others =>
+                           Error_Msg_Sem
+                             ("signal parameter requires a signal expression",
+                              Assoc);
+                     end case;
+
+                     case Get_Kind (Prefix) is
+                        when Iir_Kind_Signal_Interface_Declaration =>
+                           Check_Parameter_Association_Restriction
+                             (Interface, Prefix, Assoc);
+                        when Iir_Kind_Guard_Signal_Declaration =>
+                           if Get_Mode (Interface) /= Iir_In_Mode then
+                              Error_Msg_Sem
+                                ("cannot associate a guard signal with "
+                                 & Get_Mode_Name (Get_Mode (Interface)) & " "
+                                 & Disp_Node (Interface), Assoc);
+                           end if;
+                        when Iir_Kinds_Signal_Attribute =>
+                           if Get_Mode (Interface) /= Iir_In_Mode then
+                              Error_Msg_Sem
+                                ("cannot associate a signal attribute with "
+                                 & Get_Mode_Name (Get_Mode (Interface)) & " "
+                                 & Disp_Node (Interface), 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_Variable_Interface_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_Variable_Interface_Declaration =>
+                           Check_Parameter_Association_Restriction
+                             (Interface, Prefix, Assoc);
+                        when Iir_Kind_Variable_Declaration
+                          | Iir_Kind_Dereference
+                          | Iir_Kind_Implicit_Dereference =>
+                           null;
+                        when Iir_Kind_File_Interface_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_File_Interface_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_File_Interface_Declaration
+                          | Iir_Kind_File_Declaration =>
+                           null;
+                        when Iir_Kind_Variable_Declaration
+                          | Iir_Kind_Variable_Interface_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_Constant_Interface_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)", Interface);
+               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_Signal_Interface_Declaration;
+      Actual : Iir_Signal_Interface_Declaration;
+      Assoc : Iir)
+     return Boolean
+   is
+      Fmode : Iir_Mode;
+      Amode : Iir_Mode;
+   begin
+      Fmode := Get_Mode (Formal);
+      Amode := Get_Mode (Actual);
+      if Fmode = Iir_Unknown_Mode or Amode = Iir_Unknown_Mode then
+         raise Internal_Error;
+      end if;
+
+      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;
+
+      Error_Msg_Sem
+        ("cannot associate " & Get_Mode_Name (Fmode) & " "
+         & Disp_Node (Formal) & " with actual port of mode "
+         & Get_Mode_Name (Amode), Assoc);
+      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_Expression (Choice)) = Eval_Pos (Index) then
+                     goto Found;
+                  end if;
+               when Iir_Kind_Choice_By_Range =>
+                  if Eval_Int_In_Range (Eval_Pos (Index),
+                                        Get_Expression (Choice))
+                  then
+                     --  FIXME: overlap.
+                     raise Internal_Error;
+                  end if;
+               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_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 (Choice);
+            if Sub_Assoc = Null_Iir then
+               Sub_Assoc := Create_Iir
+                 (Iir_Kind_Association_Element_By_Individual);
+               Location_Copy (Sub_Assoc, Index);
+               Set_Associated (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.
+      Index := Eval_Expr (Index);
+      Set_Suffix (Formal, Index);
+
+      Choice := Create_Iir (Iir_Kind_Choice_By_Range);
+      Location_Copy (Choice, Formal);
+      Set_Expression (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_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
+      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_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 (Iassoc);
+            if Sub = Null_Iir then
+               Sub := Create_Iir (Iir_Kind_Association_Element_By_Individual);
+               Location_Copy (Sub, Formal);
+               Set_Formal (Sub, Iassoc);
+               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_Associated_Formal (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;
+
+   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 (Iass);
+      if Prev /= Null_Iir then
+         Error_Msg_Sem ("individual association of "
+                        & Disp_Node (Get_Base_Name (Formal))
+                        & " conflicts with that at " & Disp_Location (Prev),
+                        Assoc);
+      else
+         Set_Associated (Iass, Assoc);
+      end if;
+   end Add_Individual_Association;
+
+   procedure Finish_Individual_Assoc_Array_Subtype (Assoc : Iir; Atype : Iir)
+   is
+      Index_Tlist : Iir_List;
+      Index_Type : Iir;
+      Low, High : Iir;
+      Chain : Iir;
+   begin
+      Index_Tlist := Get_Index_Subtype_List (Atype);
+      for I in Natural loop
+         Index_Type := Get_Nth_Element (Index_Tlist, I);
+         exit when Index_Type = Null_Iir;
+         Chain := Get_Individual_Association_Chain (Assoc);
+         Sem_Choices_Range
+           (Chain, Index_Type, True, Get_Location (Assoc), Low, High);
+         Set_Individual_Association_Chain (Assoc, Chain);
+      end loop;
+   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_Nth_Element (Get_Index_Subtype_List (Base_Type),
+                                        Dim - 1);
+      end if;
+      Chain := Get_Individual_Association_Chain (Assoc);
+      Sem_Choices_Range
+        (Chain, Base_Index, True, 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 : Iir_Record_Type_Definition;
+      Matches : Iir_Array_Acc;
+      Ch : Iir;
+      Pos : Natural;
+      Rec_El : Iir;
+   begin
+      Base_Type := Get_Base_Type (Atype);
+      Matches := new Iir_Array
+        (0 .. Natural (Get_Number_Element_Declaration (Base_Type)) - 1);
+      Matches.all := (others => Null_Iir);
+      Ch := Get_Individual_Association_Chain (Assoc);
+      while Ch /= Null_Iir loop
+         Rec_El := Get_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;
+      Rec_El := Get_Element_Declaration_Chain (Base_Type);
+      for I in Matches'Range loop
+         if Matches (I) = Null_Iir then
+            Error_Msg_Sem (Disp_Node (Rec_El) & " not associated", Assoc);
+         end if;
+         Rec_El := Get_Chain (Rec_El);
+      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_Associated_Formal (Assoc);
+      Atype := Get_Type (Formal);
+
+      case Get_Kind (Atype) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            Finish_Individual_Assoc_Array_Subtype (Assoc, Atype);
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            Set_Actual_Type
+              (Assoc, Create_Array_Subtype (Atype, Get_Location (Assoc)));
+            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_Base_Name (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;
+
+
+   --  EXPR is a formal or actual expression.
+   --  Extract conversion function CONV from EXPR, if:
+   --  * argument of the function is of type ARG_TYPE.
+   --  * return type of the function is RES_TYPE if RES_TYPE /= Null_Iir
+   --    or any type if RES_TYPE = Null_Iir.
+--    procedure Sem_Conversion (Expr : in out Iir; Conv : out Iir)
+--    is
+--       Assoc : Iir;
+--    begin
+--       Conv := Null_Iir;
+--       case Get_Kind (Expr) is
+--          when Iir_Kind_Parenthesis_Name =>
+--             raise Internal_Error;
+--          when Iir_Kind_Function_Call =>
+--             Conv := Get_Implementation (Expr);
+--             Assoc := Get_Parameter_Association_Chain (Expr);
+--             Expr := Get_Actual (Assoc);
+--             Free_Iir (Assoc);
+--             Set_Use_Flag (Conv, True);
+--          when Iir_Kind_Type_Conversion =>
+--             Assoc := Get_Expression (Expr);
+--             Conv := Expr;
+--             Expr := Assoc;
+--             --Set_Expression (Conv, Null_Iir);
+--          when others =>
+--             return;
+--       end case;
+--    end Sem_Conversion;
+
+   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;
+
+   --  Return TRUE iff FUNC is valid as a conversion function/type.
+   function Is_Valid_Conversion (Func : Iir) return Boolean is
+   begin
+      case Get_Kind (Func) is
+         when Iir_Kinds_Function_Declaration =>
+            if not Is_Chain_Length_One (Get_Interface_Declaration_Chain (Func))
+            then
+               return False;
+            end if;
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            if Flags.Vhdl_Std = Vhdl_87 then
+               return False;
+            end if;
+         when others =>
+            return False;
+      end case;
+      return True;
+   end Is_Valid_Conversion;
+
+   function Extract_Type_Of_Conversions (Convs : Iir) return Iir
+   is
+      Res_List : Iir_List;
+      Ov_List : Iir_List;
+      El : Iir;
+   begin
+      if not Is_Overload_List (Convs) then
+         if Is_Valid_Conversion (Convs) then
+            return Get_Type (Convs);
+         else
+            return Null_Iir;
+         end if;
+      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;
+            if Is_Valid_Conversion (El) then
+               Add_Element (Res_List, Get_Type (El));
+            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 : Iir;
+      Assoc_Chain : Iir;
+      Res : Iir;
+      Conv : Iir;
+      Name : Iir;
+      Conv_Func : Iir;
+      Conv_Type : Iir;
+   begin
+      Formal := Get_Formal (Assoc);
+      Assoc_Chain := Get_Association_Chain (Formal);
+      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;
+                              Interface : 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 (Interface) then
+               Prefix := Name;
+               Name_Type := Get_Type (Interface);
+            else
+               Name_Type := Null_Iir;
+            end if;
+            return;
+         when Iir_Kind_Selected_Name =>
+            Sem_Formal_Name
+              (Get_Prefix (Name), Interface, 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_Chain
+              (Get_Element_Declaration_Chain (Base_Type),
+               Get_Suffix_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), Interface, 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; Interface : 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 (Interface) then
+               Formal_Type := Get_Type (Interface);
+               Set_Named_Entity (Formal, Interface);
+               Set_Type (Formal, Formal_Type);
+               --Xrefs.Xref_Name (Formal);
+               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, Interface, Prefix, Formal_Type);
+      if Formal_Type /= Null_Iir then
+         Set_Type (Formal, Formal_Type);
+         Set_Named_Entity (Prefix, Interface);
+         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 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);
+      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;
+
+      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_Base_Name (Res, Res);
+            Set_Parameter_Association_Chain (Res, Null_Iir);
+            Set_Type (Res, Get_Return_Type (Func));
+            Set_Expr_Staticness (Res, None);
+            Set_Use_Flag (Func, True);
+         when Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Type_Declaration =>
+            Res := Create_Iir (Iir_Kind_Type_Conversion);
+            Location_Copy (Res, Conv);
+            Set_Type_Mark (Res, Func);
+            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;
+      Set_Named_Entity (Conv, Res);
+      Xrefs.Xref_Name (Conv);
+      return Res;
+   end Extract_Out_Conversion;
+
+
+   --  Associate ASSOC with interface INTERFACE
+   --  This sets RES.
+   procedure Sem_Association
+     (Assoc : Iir;
+      Interface : Iir;
+      Finish : Boolean;
+      Match : out Boolean)
+   is
+      Formal : Iir;
+      Formal_Type : Iir;
+      Actual: Iir;
+      Actual_Types : Iir;
+      Out_Conv, In_Conv : Iir;
+      Expr : Iir;
+      Res_Type : Iir;
+      Assoc_Kind : Param_Assoc_Type;
+   begin
+      --  Sem formal.
+      Formal := Get_Formal (Assoc);
+
+      if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
+         if Formal /= Null_Iir then
+            Assoc_Kind := Sem_Formal (Formal, Interface);
+            if Assoc_Kind = None then
+               Match := False;
+               return;
+            end if;
+            Set_Whole_Association_Flag (Assoc, Assoc_Kind = Whole);
+            if Finish then
+               Set_Type (Formal, Null_Iir);
+               Sem_Name (Formal, False);
+               Expr := Get_Named_Entity (Formal);
+               if Get_Kind (Expr) = Iir_Kind_Error then
+                  Match := False;
+                  return;
+               end if;
+               Xrefs.Xref_Name (Formal);
+               Set_Formal (Assoc, Expr);
+            end if;
+         else
+            Set_Whole_Association_Flag (Assoc, True);
+         end if;
+         Match := True;
+         return;
+      end if;
+
+      if Formal /= Null_Iir then
+         Assoc_Kind := Sem_Formal (Formal, Interface);
+         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 := Interface;
+      end if;
+      Formal_Type := Get_Type (Formal);
+
+      --  Extract conversion from actual.
+      Actual := Get_Actual (Assoc);
+      Actual_Types := Get_Type (Actual);
+      In_Conv := Null_Iir;
+      if Actual_Types = Null_Iir then
+         Match := False;
+         return;
+      end if;
+      if Get_Kind (Interface) /= Iir_Kind_Constant_Interface_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;
+         Actual_Types := Get_Type (Actual);
+      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 := Compatibility_Types (Formal_Type, Actual_Types);
+      else
+         Match := True;
+         if In_Conv /= Null_Iir then
+            if not Compatibility_Types (Formal_Type, Get_Type (In_Conv)) then
+               Match := False;
+            end if;
+         end if;
+         if Out_Conv /= Null_Iir then
+            if not Compatibility_Types (Get_Type (Out_Conv), Actual_Types) 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 (Interface), Assoc);
+            Error_Msg_Sem
+              ("(type of " & Disp_Node (Actual) & " is "
+               & Disp_Type_Of (Actual) & ")", Assoc);
+            Error_Msg_Sem
+              ("(type of " & Disp_Node (Interface) & " is "
+               & Disp_Type_Of (Interface) & ")", Interface);
+         end if;
+         return;
+      end if;
+
+      if not Finish then
+         return;
+      end if;
+
+      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),
+                                                Actual_Types);
+         else
+            Res_Type := Actual_Types;
+         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
+         raise Internal_Error;
+      end if;
+
+      if Get_Formal (Assoc) /= Null_Iir then
+         Set_Type (Formal, Null_Iir);
+         Sem_Name (Formal, False);
+         Expr := Get_Named_Entity (Formal);
+         if Get_Kind (Expr) = Iir_Kind_Error then
+            return;
+         end if;
+         Xrefs.Xref_Name (Formal);
+         Free_Name (Formal);
+         Set_Formal (Assoc, Expr);
+         Formal_Type := Get_Type (Expr);
+      end if;
+
+      Set_Out_Conversion (Assoc, Out_Conv);
+      Set_In_Conversion (Assoc, In_Conv);
+      Set_Actual (Assoc, Actual);
+
+      --  Semantize actual.
+      Expr := Sem_Expression (Actual, Res_Type);
+      if Expr /= Null_Iir then
+         Expr := Eval_Expr_If_Static (Expr);
+         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;
+
+   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;
+                                  Interface : out Iir;
+                                  Pos : out Integer)
+      is
+         I_Match : Boolean;
+      begin
+         Interface := Interface_Chain;
+         Pos := 0;
+         while Interface /= 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, Interface, False, I_Match);
+            if I_Match then
+               return;
+            end if;
+            Interface := Get_Chain (Interface);
+            Pos := Pos + 1;
+         end loop;
+      end Search_Interface;
+
+      Assoc: Iir;
+      Interface: 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.
+      Interface := 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 Interface = Null_Iir then
+               if Finish then
+                  Error_Msg_Sem
+                    ("too many arguments for " & Disp_Node (Loc), Assoc);
+               end if;
+               Match := False;
+               return;
+            end if;
+            Sem_Association (Assoc, Interface, 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);
+            Interface := Get_Chain (Interface);
+            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, Interface, Pos);
+                  if Interface = Null_Iir then
+                     if Assoc_1 /= Null_Iir then
+                        Interface := Interface_1;
+                        Pos := Pos_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, Interface, Pos);
+            end case;
+
+            if Interface /= 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 (Interface) & " 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 /= Interface
+                     then
+                        Error_Msg_Sem
+                          ("non consecutive individual association for "
+                           & Disp_Node (Interface),
+                           Assoc);
+                        Match := False;
+                        return;
+                     end if;
+                     Last_Individual := Interface;
+                     Arg_Matched (Pos) := Individual;
+                  else
+                     if Finish then
+                        Error_Msg_Sem
+                          (Disp_Node (Interface) & " already associated",
+                           Assoc);
+                        Match := False;
+                        return;
+                     end if;
+                  end if;
+               end if;
+               if Finish then
+                  Sem_Association (Assoc, Interface, True, Match);
+                  if not Match then
+                     raise Internal_Error;
+                  end if;
+               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;
+
+      --  LRM 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).
+
+      --  LRM 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).
+
+      --  LRM 1.1.1.2
+      --  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.
+
+      Interface := Interface_Chain;
+      Pos := 0;
+      while Interface /= Null_Iir loop
+         if Arg_Matched (Pos) <= Open
+           and then Get_Default_Value (Interface) = Null_Iir
+         then
+            case Missing is
+               when Missing_Parameter
+                 | Missing_Generic =>
+                  if Finish then
+                     Error_Msg_Sem
+                       ("no actual for " & Disp_Node (Interface), Loc);
+                  end if;
+                  Match := False;
+                  return;
+               when Missing_Port =>
+                  case Get_Mode (Interface) is
+                     when Iir_In_Mode =>
+                        if not Finish then
+                           raise Internal_Error;
+                        end if;
+                        Error_Msg_Sem (Disp_Node (Interface)
+                                       & " 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 Is_Unconstrained_Type_Definition
+                          (Get_Type (Interface))
+                        then
+                           Error_Msg_Sem
+                             ("unconstrained " & Disp_Node (Interface)
+                              & " 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;
+         Interface := Get_Chain (Interface);
+         Pos := Pos + 1;
+      end loop;
+      return;
+   end Sem_Association_Chain;
+end Sem_Assocs;
diff --git a/sem_assocs.ads b/sem_assocs.ads
new file mode 100644
index 000000000..524223601
--- /dev/null
+++ b/sem_assocs.ads
@@ -0,0 +1,55 @@
+--  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 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 Sem_Assocs is
+   --  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_Signal_Interface_Declaration;
+      Actual : Iir_Signal_Interface_Declaration;
+      Assoc : Iir)
+     return Boolean;
+end Sem_Assocs;
diff --git a/sem_decls.adb b/sem_decls.adb
new file mode 100644
index 000000000..3fe32aa86
--- /dev/null
+++ b/sem_decls.adb
@@ -0,0 +1,2413 @@
+--  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 GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Names; use Sem_Names;
+with Errorout; use Errorout;
+with Types; use Types;
+with Sem_Expr; use Sem_Expr;
+with Std_Names;
+with Tokens;
+with Sem_Specs; use Sem_Specs;
+with Flags;
+with Std_Package; use Std_Package;
+with Iir_Chains;
+with Evaluation; use Evaluation;
+with Name_Table;
+with Iirs_Utils; use Iirs_Utils;
+with Sem_Types; use Sem_Types;
+with Sem; use Sem;
+with Iir_Chains; use Iir_Chains;
+with Xrefs; use Xrefs;
+
+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_Chain (Interface_Chain: Iir;
+                                  Interface_Kind : Interface_Kind_Type)
+   is
+      El, A_Type: Iir;
+      Proxy : Iir_Proxy;
+      Default_Value: Iir;
+   begin
+      El := Interface_Chain;
+      while El /= Null_Iir loop
+         --  Avoid the reanalysed duplicated types.
+         --  This is not an optimization, since the unanalysed type must have
+         --  been freed.
+         A_Type := Get_Type (El);
+         if Get_Kind (A_Type) = Iir_Kind_Proxy then
+            Proxy := A_Type;
+            A_Type := Get_Type (Get_Proxy (Proxy));
+            Default_Value := Get_Default_Value (Get_Proxy (Proxy));
+            Free_Iir (Proxy);
+         else
+            A_Type := Sem_Subtype_Indication (A_Type);
+            Default_Value := Get_Default_Value (El);
+            if Default_Value /= Null_Iir and then A_Type /= Null_Iir then
+               Deferred_Constant_Allowed := True;
+               Default_Value := Sem_Expression (Default_Value, A_Type);
+               Deferred_Constant_Allowed := False;
+               Check_Read (Default_Value);
+            end if;
+         end if;
+
+         Set_Base_Name (El, El);
+         Set_Name_Staticness (El, Locally);
+         Xref_Decl (El);
+
+         if A_Type /= Null_Iir then
+            Set_Type (El, A_Type);
+
+            if Get_Kind (El) = Iir_Kind_Signal_Interface_Declaration then
+               case Get_Signal_Kind (El) 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_Function (A_Type) = Null_Iir)
+                     then
+                        Error_Msg_Sem
+                          (Disp_Node (A_Type)
+                           & " of guarded " & Disp_Node (El)
+                           & " is not resolved", El);
+                     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_Kind_Subtype
+                     then
+                        Error_Msg_Sem ("signal parameter can't be of kind bus",
+                                       El);
+                     end if;
+                  when Iir_Register_Kind =>
+                     Error_Msg_Sem
+                       ("interface signal can't be of kind register", El);
+               end case;
+            end if;
+
+            case Get_Kind (El) is
+               when Iir_Kind_Constant_Interface_Declaration
+                 | Iir_Kind_Signal_Interface_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 (El);
+               when Iir_Kind_Variable_Interface_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)", El);
+                        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 (El) /= Iir_Inout_Mode then
+                           Error_Msg_Sem
+                             ("parameter of protected type must be inout", El);
+                        end if;
+                     when others =>
+                        null;
+                  end case;
+               when Iir_Kind_File_Interface_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", El);
+                  end if;
+               when others =>
+                  --  El is not an interface.
+                  raise Internal_Error;
+            end case;
+
+            if Default_Value /= Null_Iir then
+               Set_Default_Value (El, 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 (El) is
+                  when Iir_Kind_Constant_Interface_Declaration =>
+                     null;
+                  when Iir_Kind_Signal_Interface_Declaration =>
+                     if Get_Mode (El) = Iir_Linkage_Mode then
+                        Error_Msg_Sem
+                          ("default expression not allowed for linkage port",
+                           El);
+                     elsif Interface_Kind in Parameter_Kind_Subtype then
+                        Error_Msg_Sem ("default expression not allowed"
+                                       & " for signal parameter", El);
+                     end if;
+                  when Iir_Kind_Variable_Interface_Declaration =>
+                     if Get_Mode (El) /= Iir_In_Mode then
+                        Error_Msg_Sem ("default expression not allowed for"
+                                       & " out/inout variable parameter", El);
+                     elsif Get_Kind (A_Type)
+                       = Iir_Kind_Protected_Type_Declaration
+                     then
+                        Error_Msg_Sem
+                          ("default expression not allowed for"
+                           & " variable parameter of protected type", El);
+                     end if;
+                  when Iir_Kind_File_Interface_Declaration =>
+                     raise Internal_Error;
+                  when others =>
+                     null;
+               end case;
+            end if;
+         else
+            Set_Type (El, Error_Type);
+         end if;
+
+         Sem_Scopes.Add_Name (El);
+
+         --  By default, interface are not static.
+         --  This may be changed just below.
+         Set_Expr_Staticness (El, None);
+
+         case Interface_Kind is
+            when Interface_Generic =>
+               --  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 (El) /= Iir_Kind_Constant_Interface_Declaration then
+                  Error_Msg_Sem
+                    ("generic " & Disp_Node (El) & " must be a constant",
+                     El);
+               else
+                  --   LRM93 7.4.2 (Globally static primaries)
+                  --   3. a generic constant.
+                  Set_Expr_Staticness (El, Globally);
+               end if;
+            when Interface_Port =>
+               if Get_Kind (El) /= Iir_Kind_Signal_Interface_Declaration then
+                  Error_Msg_Sem
+                    ("port " & Disp_Node (El) & " must be a signal", El);
+               end if;
+            when Interface_Procedure
+              | Interface_Function =>
+               if Get_Kind (El) = Iir_Kind_Variable_Interface_Declaration
+                 and then Interface_Kind = Interface_Function
+               then
+                  Error_Msg_Sem ("variable interface parameter are not "
+                                 & "allowed for a function (use a constant)",
+                                 El);
+               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 (El) = Iir_Kind_Signal_Interface_Declaration
+                 and then Get_Mode (El) in Iir_In_Modes
+               then
+                  Set_Has_Active_Flag (El, True);
+               end if;
+
+               case Get_Mode (El) is
+                  when Iir_Unknown_Mode =>
+                     raise Internal_Error;
+                  when Iir_In_Mode =>
+                     null;
+                  when Iir_Inout_Mode
+                    | Iir_Out_Mode =>
+                     if Interface_Kind = Interface_Function
+                       and then
+                       Get_Kind (El) /= Iir_Kind_File_Interface_Declaration
+                     then
+                        Error_Msg_Sem ("mode of a function parameter cannot "
+                                       & "be inout or out", El);
+                     end if;
+                  when Iir_Buffer_Mode
+                    | Iir_Linkage_Mode =>
+                     Error_Msg_Sem ("buffer or linkage mode is not allowed "
+                                    & "for a subprogram parameter", El);
+               end case;
+         end case;
+         El := Get_Chain (El);
+      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.
+      El := Interface_Chain;
+      while El /= Null_Iir loop
+         Name_Visible (El);
+         El := Get_Chain (El);
+      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 Get_Nbr_Elements (Get_Index_Subtype_List (Def)) /= 1 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: Iir;
+      Proc: Iir_Implicit_Procedure_Declaration;
+      Func: Iir_Implicit_Function_Declaration;
+      Interface: Iir;
+      Loc : Location_Type;
+      File_Interface_Kind : Iir_Kind;
+      Last_Interface : Iir;
+      Last : Iir;
+   begin
+      Last := Decl;
+      Type_Mark := Get_Type_Mark (Type_Definition);
+      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);
+            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.
+                  Interface :=
+                    Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+                  Set_Location (Interface, Loc);
+                  Set_Identifier (Interface, Std_Names.Name_Status);
+                  Set_Type (Interface,
+                            Std_Package.File_Open_Status_Type_Definition);
+                  Set_Mode (Interface, Iir_Out_Mode);
+                  Set_Base_Name (Interface, Interface);
+                  Append (Last_Interface, Proc, Interface);
+            end case;
+            --  File F : FT
+            Interface := Create_Iir (Iir_Kind_File_Interface_Declaration);
+            Set_Location (Interface, Loc);
+            Set_Identifier (Interface, Std_Names.Name_F);
+            Set_Type (Interface, Type_Definition);
+            Set_Mode (Interface, Iir_Inout_Mode);
+            Set_Base_Name (Interface, Interface);
+            Append (Last_Interface, Proc, Interface);
+            --  External_Name : in STRING
+            Interface := Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+            Set_Location (Interface, Loc);
+            Set_Identifier (Interface, Std_Names.Name_External_Name);
+            Set_Type (Interface, Std_Package.String_Type_Definition);
+            Set_Mode (Interface, Iir_In_Mode);
+            Set_Base_Name (Interface, Interface);
+            Append (Last_Interface, Proc, Interface);
+            --  Open_Kind : in File_Open_Kind := Read_Mode.
+            Interface := Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+            Set_Location (Interface, Loc);
+            Set_Identifier (Interface, Std_Names.Name_Open_Kind);
+            Set_Type (Interface, Std_Package.File_Open_Kind_Type_Definition);
+            Set_Mode (Interface, Iir_In_Mode);
+            Set_Base_Name (Interface, Interface);
+            Set_Default_Value (Interface,
+                               Std_Package.File_Open_Kind_Read_Mode);
+            Append (Last_Interface, Proc, Interface);
+            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);
+         Build_Init (Last_Interface);
+         Interface := Create_Iir (Iir_Kind_File_Interface_Declaration);
+         Set_Identifier (Interface, Std_Names.Name_F);
+         Set_Location (Interface, Loc);
+         Set_Type (Interface, Type_Definition);
+         Set_Mode (Interface, Iir_Inout_Mode);
+         Set_Base_Name (Interface, Interface);
+         Append (Last_Interface, Proc, Interface);
+         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_Variable_Interface_Declaration;
+      else
+         File_Interface_Kind := Iir_Kind_File_Interface_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);
+      Build_Init (Last_Interface);
+      Interface := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Interface, Std_Names.Name_F);
+      Set_Location (Interface, Loc);
+      Set_Type (Interface, Type_Definition);
+      Set_Mode (Interface, Iir_In_Mode);
+      Set_Base_Name (Interface, Interface);
+      Append (Last_Interface, Proc, Interface);
+      Interface := Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+      Set_Identifier (Interface, Std_Names.Name_Value);
+      Set_Location (Interface, Loc);
+      Set_Type (Interface, Type_Mark);
+      Set_Mode (Interface, Iir_Out_Mode);
+      Set_Base_Name (Interface, Interface);
+      Append (Last_Interface, Proc, Interface);
+      case Get_Kind (Type_Mark) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            Interface := Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+            Set_Identifier (Interface, Std_Names.Name_Length);
+            Set_Location (Interface, Loc);
+            Set_Type (Interface, Std_Package.Natural_Subtype_Definition);
+            Set_Mode (Interface, Iir_Out_Mode);
+            Set_Base_Name (Interface, Interface);
+            Append (Last_Interface, Proc, Interface);
+            Set_Implicit_Definition (Proc, Iir_Predefined_Read_Length);
+         when others =>
+            Set_Implicit_Definition (Proc, Iir_Predefined_Read);
+      end case;
+      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);
+      Build_Init (Last_Interface);
+      Interface := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Interface, Std_Names.Name_F);
+      Set_Location (Interface, Loc);
+      Set_Type (Interface, Type_Definition);
+      Set_Mode (Interface, Iir_Out_Mode);
+      Set_Base_Name (Interface, Interface);
+      Set_Name_Staticness (Interface, Locally);
+      Set_Expr_Staticness (Interface, None);
+      Append (Last_Interface, Proc, Interface);
+      Interface := Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+      Set_Identifier (Interface, Std_Names.Name_Value);
+      Set_Location (Interface, Loc);
+      Set_Type (Interface, Type_Mark);
+      Set_Mode (Interface, Iir_In_Mode);
+      Set_Base_Name (Interface, Interface);
+      Append (Last_Interface, Proc, Interface);
+      Set_Implicit_Definition (Proc, Iir_Predefined_Write);
+      Compute_Subprogram_Hash (Proc);
+      -- Add it to the list.
+      Insert_Incr (Last, Proc);
+
+      -- 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 (Proc, Get_Parent (Decl));
+      Set_Type_Reference (Proc, Decl);
+      Build_Init (Last_Interface);
+      Interface := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Interface, Std_Names.Name_F);
+      Set_Location (Interface, Loc);
+      Set_Type (Interface, Type_Definition);
+      Set_Mode (Interface, Iir_In_Mode);
+      Set_Base_Name (Interface, Interface);
+      Append (Last_Interface, Func, Interface);
+      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_Constant_Interface_Declaration
+   is
+      Interface : Iir_Constant_Interface_Declaration;
+   begin
+      Interface := Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+      Location_Copy (Interface, Atype);
+      Set_Identifier (Interface, Null_Identifier);
+      Set_Mode (Interface, Iir_In_Mode);
+      Set_Type (Interface, Atype);
+      Set_Base_Name (Interface, Interface);
+      return Interface;
+   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);
+         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_Shift_Operators
+      is
+         Inter_Chain : Iir_Constant_Interface_Declaration;
+         Inter_Int : Iir;
+      begin
+         Inter_Chain := Create_Anonymous_Interface (Type_Definition);
+
+         Inter_Int := Create_Iir (Iir_Kind_Constant_Interface_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_Base_Name (Inter_Int, Inter_Int);
+
+         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 (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);
+
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            declare
+               Inter_Chain : Iir;
+               Element_Type : 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);
+               end if;
+
+               Element_Type :=
+                 Get_Base_Type (Get_Element_Subtype (Type_Definition));
+
+               Add_Operation (Name_Op_Concatenation,
+                              Iir_Predefined_Array_Array_Concat,
+                              Binary_Chain,
+                              Type_Definition);
+
+               Inter_Chain := Create_Anonymous_Interface (Element_Type);
+               Set_Chain (Inter_Chain, Unary_Chain);
+               Add_Operation (Name_Op_Concatenation,
+                              Iir_Predefined_Element_Array_Concat,
+                              Inter_Chain,
+                              Type_Definition);
+
+               Inter_Chain := Create_Anonymous_Interface (Type_Definition);
+               Set_Chain (Inter_Chain,
+                          Create_Anonymous_Interface (Element_Type));
+               Add_Operation (Name_Op_Concatenation,
+                              Iir_Predefined_Array_Element_Concat,
+                              Inter_Chain,
+                              Type_Definition);
+
+               Inter_Chain := Create_Anonymous_Interface (Element_Type);
+               Set_Chain (Inter_Chain,
+                          Create_Anonymous_Interface (Element_Type));
+               Add_Operation (Name_Op_Concatenation,
+                              Iir_Predefined_Element_Element_Concat,
+                              Inter_Chain,
+                              Type_Definition);
+
+               if Is_Discrete_Array (Type_Definition) then
+                  if Element_Type = Std_Package.Boolean_Type_Definition then
+                     Add_Unary (Name_Not, Iir_Predefined_Boolean_Array_Not);
+
+                     Add_Binary (Name_And, Iir_Predefined_Boolean_Array_And);
+                     Add_Binary (Name_Or, Iir_Predefined_Boolean_Array_Or);
+                     Add_Binary (Name_Nand, Iir_Predefined_Boolean_Array_Nand);
+                     Add_Binary (Name_Nor, Iir_Predefined_Boolean_Array_Nor);
+                     Add_Binary (Name_Xor, Iir_Predefined_Boolean_Array_Xor);
+                     if Flags.Vhdl_Std > Vhdl_87 then
+                        Add_Binary
+                          (Name_Xnor, Iir_Predefined_Boolean_Array_Xnor);
+
+                        Add_Shift_Operators;
+                     end if;
+                  elsif Element_Type = Std_Package.Bit_Type_Definition then
+                     Add_Unary (Name_Not, Iir_Predefined_Bit_Array_Not);
+
+                     Add_Binary (Name_And, Iir_Predefined_Bit_Array_And);
+                     Add_Binary (Name_Or, Iir_Predefined_Bit_Array_Or);
+                     Add_Binary (Name_Nand, Iir_Predefined_Bit_Array_Nand);
+                     Add_Binary (Name_Nor, Iir_Predefined_Bit_Array_Nor);
+                     Add_Binary (Name_Xor, Iir_Predefined_Bit_Array_Xor);
+                     if Flags.Vhdl_Std > Vhdl_87 then
+                        Add_Binary (Name_Xnor, Iir_Predefined_Bit_Array_Xnor);
+
+                        Add_Shift_Operators;
+                     end if;
+                  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_Variable_Interface_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_Variable_Interface_Declaration);
+               Set_Identifier (Var_Interface, Std_Names.Name_P);
+               Set_Type (Var_Interface, Type_Definition);
+               Set_Mode (Var_Interface, Iir_Inout_Mode);
+               Set_Base_Name (Var_Interface, Var_Interface);
+               --Set_Purity_State (Deallocate_Proc, Impure);
+               Set_Wait_State (Deallocate_Proc, False);
+               Set_Type_Reference (Deallocate_Proc, Decl);
+
+               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;
+
+         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;
+
+         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);
+
+         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 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 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);
+      elsif Decl = Std_Package.Universal_Real_Type 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
+      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 (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 (Decl);
+      if Def = Null_Iir then
+         --  Incomplete type declaration
+         Def := Create_Iir (Iir_Kind_Incomplete_Type_Definition);
+         Location_Copy (Def, Decl);
+         Set_Type (Decl, 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
+         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 (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 (Old_Decl), St_Decl);
+                  end if;
+
+                  Sem_Scopes.Name_Visible (St_Decl);
+
+                  Sem_Scopes.Add_Visible_Type (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);
+                  Sem_Scopes.Add_Visible_Type (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);
+                  Sem_Scopes.Add_Visible_Type (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 (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;
+         end if;
+      end if;
+   end Sem_Type_Declaration;
+
+   procedure Sem_Subtype_Declaration (Decl: Iir)
+   is
+      Def: Iir;
+      Res: 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);
+
+      -- Check the definition of the type.
+      Def := Sem_Subtype_Indication (Get_Type (Decl));
+      if Def = Null_Iir then
+         return;
+      end if;
+
+      if not Is_Anonymous_Type_Definition (Def) then
+         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 =>
+               -- no limits, makes an alias.
+               Res := Create_Iir (Get_Kind (Def));
+               Set_Range_Constraint (Res, Get_Range_Constraint (Def));
+               Set_Resolution_Function (Res, Get_Resolution_Function (Def));
+            when Iir_Kind_Enumeration_Type_Definition =>
+               --  makes an alias.
+               Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+               Set_Type_Mark (Res, Def);
+               Set_Range_Constraint (Res, Get_Range_Constraint (Def));
+            when Iir_Kind_Access_Subtype_Definition
+              | Iir_Kind_Access_Type_Definition =>
+               --  Make an alias.
+               Res := Create_Iir (Iir_Kind_Access_Subtype_Definition);
+            when Iir_Kind_Array_Type_Definition
+              | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+               Res :=
+                 Create_Iir (Iir_Kind_Unconstrained_Array_Subtype_Definition);
+               Set_Type_Staticness (Res, Get_Type_Staticness (Def));
+               if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then
+                  Set_Resolution_Function
+                    (Res, Get_Resolution_Function (Def));
+               end if;
+               Set_Resolved_Flag (Res, Get_Resolved_Flag (Def));
+               Set_Type_Mark (Res, Def);
+               Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Def));
+               Set_Element_Subtype (Res, Get_Element_Subtype (Def));
+            when Iir_Kind_Array_Subtype_Definition =>
+               Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+               Set_Resolution_Function (Res, Get_Resolution_Function (Def));
+               Set_Resolved_Flag (Res, Get_Resolved_Flag (Def));
+               Set_Type_Mark (Res, Def);
+               Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Def));
+               Set_Element_Subtype (Res, Get_Element_Subtype (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_Type_Definition then
+                  Set_Resolution_Function
+                    (Res, Get_Resolution_Function (Def));
+               end if;
+               Set_Resolved_Flag (Res, Get_Resolved_Flag (Def));
+            when others =>
+               --  FIXME: todo
+               Error_Kind ("sem_subtype_declaration", Def);
+         end case;
+         Location_Copy (Res, Decl);
+         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));
+         Def := Res;
+      end if;
+      Set_Type (Decl, Def);
+      Set_Type_Declarator (Def, Decl);
+      Name_Visible (Decl);
+   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) then
+         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)
+   is
+      Atype: Iir;
+      Default_Value : Iir;
+      Proxy : Iir;
+      Deferred_Const : Iir;
+      Staticness : Iir_Staticness;
+   begin
+      Deferred_Const := Get_Deferred_Constant (Decl);
+
+      --  Semantize type and default value:
+      Atype := Get_Type (Decl);
+      if Get_Kind (Atype) /= Iir_Kind_Proxy then
+         Atype := Sem_Subtype_Indication (Atype);
+         if Atype = Null_Iir then
+            Atype := Create_Error_Type (Get_Type (Decl));
+         end if;
+      end if;
+
+      if Deferred_Const = Null_Iir then
+         Sem_Scopes.Add_Name (Decl);
+         Xref_Decl (Decl);
+      else
+         Xref_Ref (Decl, Deferred_Const);
+      end if;
+
+      if Get_Kind (Atype) = Iir_Kind_Proxy then
+         Proxy := Get_Proxy (Atype);
+         Default_Value := Get_Default_Value (Proxy);
+         Atype := Get_Type (Proxy);
+         if Atype = Null_Iir then
+            return;
+         end if;
+         Proxy := Get_Type (Decl);
+         Free_Iir (Proxy);
+      else
+         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);
+         end if;
+      end if;
+      Set_Type (Decl, Atype);
+      Default_Value := Eval_Expr_If_Static (Default_Value);
+      Set_Default_Value (Decl, Default_Value);
+      Set_Base_Name (Decl, Decl);
+      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);
+
+               if Staticness = Locally then
+                  Set_Default_Value
+                    (Decl, Eval_Expr_Check (Default_Value, Atype));
+               end if;
+            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);
+
+         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_Declaration
+                 | Iir_Kind_Package_Declaration
+                 | Iir_Kind_Package_Body
+                 | Iir_Kind_Block_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 ("parse_declarative_part(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
+            --  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 Sem_Is_Constrained (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)
+   is
+      Atype: Iir;
+      Logical_Name: Iir;
+      Open_Kind : Iir;
+   begin
+      Sem_Scopes.Add_Name (Decl);
+      Set_Expr_Staticness (Decl, None);
+      Set_Base_Name (Decl, Decl);
+      Xref_Decl (Decl);
+
+      -- Try to find a type.
+      Atype := Get_Type (Decl);
+      if Get_Kind (Atype) = Iir_Kind_Proxy then
+         Atype := Get_Type (Get_Proxy (Atype));
+         Free_Iir (Get_Type (Decl));
+      else
+         Atype := Sem_Subtype_Indication (Get_Type (Decl));
+         if Atype = Null_Iir then
+            return;
+         end if;
+      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
+               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_Subtype_Indication (Get_Type (Decl));
+      if A_Type = Null_Iir then
+         return;
+      end if;
+      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), Interface_Generic);
+      Sem_Interface_Chain (Get_Port_Chain (Component), Interface_Port);
+
+      Close_Declarative_Region;
+
+      Name_Visible (Component);
+   end Sem_Component_Declaration;
+
+   procedure Sem_Object_Alias_Declaration (Alias: Iir_Object_Alias_Declaration)
+   is
+      N_Type: Iir;
+      N_Name: Iir;
+      Name : Iir;
+      Name_Type : Iir;
+   begin
+      Sem_Scopes.Add_Name (Alias);
+      Xref_Decl (Alias);
+
+      Name := Get_Name (Alias);
+      Sem_Name (Name, False);
+      N_Name := Get_Named_Entity (Name);
+      if N_Name = Error_Mark then
+         return;
+      end if;
+      --  FIXME: overload list ?
+
+      Name_Visible (Alias);
+
+      case Get_Kind (N_Name) is
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Selected_Element =>
+            Set_Base_Name (Alias, Get_Base_Name (N_Name));
+            Xref_Name (Name);
+            Set_Name (Alias, N_Name);
+         when others =>
+            Error_Msg_Sem ("can only alias named object", Alias);
+            return;
+      end case;
+
+      --  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_Type (Alias);
+      if N_Type = Null_Iir then
+         Set_Type (Alias, Name_Type);
+         N_Type := Name_Type;
+      else
+         N_Type := Sem_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_Unidim_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));
+   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_Return_Type (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_Return_Type (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 (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)) /= 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 := Find_Declaration (El, Decl_Type);
+            if El /= Null_Iir then
+               Replace_Nth_Element (List, I, Get_Base_Type (El));
+            end if;
+         end loop;
+      end if;
+      El := Get_Return_Type (Sig);
+      if El /= Null_Iir then
+         El := Find_Declaration (El, Decl_Type);
+         if El /= Null_Iir then
+            Set_Return_Type (Sig, Get_Base_Type (El));
+         end if;
+      end if;
+
+      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;
+      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;
+
+   procedure Sem_Non_Object_Alias_Declaration
+     (Alias : Iir_Non_Object_Alias_Declaration)
+   is
+      use Std_Names;
+      Name : Iir;
+      Sig : Iir_Signature;
+      N_Entity : Iir;
+      Id : Name_Id;
+   begin
+      Name := Get_Name (Alias);
+      Sem_Name (Name, False);
+      N_Entity := Get_Named_Entity (Name);
+      if N_Entity = Error_Mark then
+         return;
+      end if;
+      Xref_Decl (Alias);
+
+      Sig := Get_Signature (Alias);
+      if Is_Overload_List (N_Entity) then
+         if Sig = Null_Iir then
+            Error_Msg_Sem
+              ("signature required for alias of a subprogram", Alias);
+            return;
+         end if;
+      end if;
+
+      if Sig /= Null_Iir then
+         N_Entity := Sem_Signature (N_Entity, Sig);
+      else
+         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.
+               Error_Msg_Sem ("signature required for subprogram", Alias);
+               return;
+            when Iir_Kind_Enumeration_Literal =>
+               Error_Msg_Sem ("signature required for enumeration literal",
+                              Alias);
+               return;
+            when Iir_Kind_Type_Declaration =>
+               declare
+                  Def : Iir;
+                  Last : Iir;
+                  El : Iir;
+                  Enum_List : Iir_Enumeration_Literal_List;
+
+                  procedure Add_Implicit_Alias (Decl : Iir)
+                  is
+                     N_Alias : Iir_Non_Object_Alias_Declaration;
+                  begin
+                     N_Alias :=
+                       Create_Iir (Iir_Kind_Non_Object_Alias_Declaration);
+                     Location_Copy (N_Alias, Alias);
+                     Set_Identifier (N_Alias, Get_Identifier (Decl));
+                     Set_Name (N_Alias, Decl);
+
+                     Add_Name (El, Get_Identifier (El), False);
+                     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
+                  Def := Get_Type (N_Entity);
+                  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; [...]
+                     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.
+                        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).
+                  if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then
+                     raise Internal_Error;
+                  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.
+                  El := Get_Chain (N_Entity);
+                  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) /= N_Entity;
+                        when others =>
+                           exit;
+                     end case;
+                     Add_Implicit_Alias (El);
+                     El := Get_Chain (El);
+                  end loop;
+               end;
+            when Iir_Kinds_Object_Declaration =>
+               Error_Msg_Sem
+                 ("non-object alias cannot denotes an object", Alias);
+               --  Do not return and add the name to avoid an error storm.
+            when Iir_Kind_Subtype_Declaration
+              | Iir_Kind_Attribute_Declaration =>
+               null;
+            when others =>
+               Error_Kind ("sem_non_object_alias_declaration", N_Entity);
+         end case;
+      end if;
+      if N_Entity = Null_Iir then
+         return;
+      end if;
+      Set_Named_Entity (Name, N_Entity);
+      Xref_Name (Name);
+
+      Set_Name (Alias, N_Entity);
+
+      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;
+      Add_Name (Alias);
+      Set_Visible_Flag (Alias, True);
+   end Sem_Non_Object_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;
+      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 := Find_Declaration (Get_Group_Template_Name (Group),
+                                    Decl_Group_Template);
+      if Template = Null_Iir then
+         return;
+      end if;
+      Set_Group_Template_Name (Group, Template);
+      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;
+
+         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;
+
+         Sem_Name (El, False);
+         El_Name := Get_Named_Entity (El);
+         if El_Name /= Error_Mark then
+            --  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;
+            Xref_Name (El);
+         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;
+
+   --  Semantize every declaration of DECLS_PARENT.
+   --  STMTS is the concurrent statement list associated with DECLS_PARENT
+   --  if any, or null_iir.  This is used for specification.
+   procedure Sem_Declaration_Chain (Parent : Iir)
+   is
+      Decl: Iir;
+      Last_Decl : Iir;
+      Attr_Spec_Chain : Iir;
+   begin
+      --  Due to implicit declarations, the list can grow during sem.
+      Decl := Get_Declaration_Chain (Parent);
+      Last_Decl := Null_Iir;
+      Attr_Spec_Chain := Null_Iir;
+      loop
+         << Again >> exit when Decl = Null_Iir;
+         case Get_Kind (Decl) is
+            when Iir_Kind_Type_Declaration =>
+               Sem_Type_Declaration (Decl);
+            when Iir_Kind_Anonymous_Type_Declaration =>
+               Sem_Type_Declaration (Decl);
+            when Iir_Kind_Subtype_Declaration =>
+               Sem_Subtype_Declaration (Decl);
+            when Iir_Kind_Signal_Declaration =>
+               Sem_Object_Declaration (Decl, Parent);
+            when Iir_Kind_Constant_Declaration =>
+               Sem_Object_Declaration (Decl, Parent);
+            when Iir_Kind_Variable_Declaration =>
+               Sem_Object_Declaration (Decl, Parent);
+            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
+              | Iir_Kind_Procedure_Declaration =>
+               declare
+                  Res : Iir;
+               begin
+                  Res := Sem_Subprogram_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;
+                     --  Since RES is a body, no need to check for post
+                     --  attribute specification.
+                     goto Again;
+                  end if;
+               end;
+            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);
+               Name_Visible (Decl);
+            when Iir_Kind_Object_Alias_Declaration =>
+               Sem_Object_Alias_Declaration (Decl);
+            when Iir_Kind_Non_Object_Alias_Declaration =>
+               Last_Decl := Decl;
+               Decl := Get_Chain (Decl);
+               Sem_Non_Object_Alias_Declaration (Last_Decl);
+               if Attr_Spec_Chain /= Null_Iir then
+                  while Last_Decl /= Decl loop
+                     Check_Post_Attribute_Specification
+                       (Attr_Spec_Chain, Last_Decl);
+                     Last_Decl := Get_Chain (Last_Decl);
+                  end loop;
+               end if;
+               goto Again;
+            when Iir_Kind_File_Declaration =>
+               Sem_File_Declaration (Decl);
+            when Iir_Kind_Use_Clause =>
+               Sem_Use_Clause (Decl);
+            when Iir_Kind_Configuration_Specification =>
+               null;
+            when Iir_Kind_Disconnection_Specification =>
+               Sem_Disconnect_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 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_Declaration
+              | 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 (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) then
+                     Warning_Msg_Sem
+                       (Disp_Node (El) & " is never used", 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_Type: Iir;
+      A_Range: Iir;
+      Range_Type : Iir;
+   begin
+      Xref_Decl (Iterator);
+      It_Type := Get_Type (Iterator);
+      A_Range := Sem_Discrete_Range_Integer (It_Type);
+      if A_Range = Null_Iir then
+         Set_Type (Iterator, Create_Error_Type (Iterator));
+         return;
+      end if;
+      if Get_Kind (A_Range) in Iir_Kinds_Type_And_Subtype_Definition then
+         Range_Type := A_Range;
+      else
+         Range_Type := Get_Type (A_Range);
+      end if;
+      case Get_Kind (Range_Type) is
+         when Iir_Kinds_Discrete_Type_Definition =>
+            null;
+         when others =>
+            Error_Msg_Sem ("iterator is not of discrete type", A_Range);
+            Set_Type (Iterator, Null_Iir);
+            return;
+      end case;
+
+      Set_Type (Iterator, Range_To_Subtype_Definition (A_Range));
+      Set_Base_Name (Iterator, Iterator);
+      Set_Expr_Staticness (Iterator, Staticness);
+   end Sem_Iterator;
+end Sem_Decls;
diff --git a/sem_decls.ads b/sem_decls.ads
new file mode 100644
index 000000000..c8dede1a1
--- /dev/null
+++ b/sem_decls.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 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 Sem_Decls is
+   --  The kind of an inteface list.
+   type Interface_Kind_Type is (Interface_Generic, Interface_Port,
+                                Interface_Procedure, Interface_Function);
+   subtype Parameter_Kind_Subtype is
+     Interface_Kind_Type range Interface_Procedure .. Interface_Function;
+
+   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.
+   function Sem_Signature (Name : Iir; Sig : Iir_Signature) return Iir;
+
+end Sem_Decls;
diff --git a/sem_expr.adb b/sem_expr.adb
new file mode 100644
index 000000000..36f4b8005
--- /dev/null
+++ b/sem_expr.adb
@@ -0,0 +1,3811 @@
+--  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 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 Std_Package; use Std_Package;
+with Errorout; use Errorout;
+with 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 Undeclared (Expr: Iir) is
+   begin
+      Error_Msg_Sem ("identifier '" & Iirs_Utils.Image_Identifier (Expr)
+                     & "' not declared", Expr);
+   end Undeclared;
+
+   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 ID is overloaded, ie has several meanings.
+   function Is_Overloaded (Id: Iir) return Boolean is
+   begin
+      return Is_Overload_List (Get_Type (Id));
+   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;
+
+   function Check_Is_Expression (Expr : 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_Declaration
+           | Iir_Kind_Entity_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 =>
+            Error_Msg_Sem (Disp_Node (Expr)
+                           & " not allowed in an expression", Expr);
+            return Null_Iir;
+         when Iir_Kinds_Function_Declaration =>
+            return Expr;
+         when Iir_Kind_Overload_List =>
+            return Expr;
+         when Iir_Kinds_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_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_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 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
+      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_Nth_Element (Targ_Indexes, I);
+         Expr_Index := Get_Nth_Element (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;
+
+   --  Return compatibility for type nodes LEFT and RIGHT.
+   function Compatibility (Left_Type, Right_Type : Iir)
+     return Boolean
+   is
+      Right_Base_Type : Iir;
+      Left_Base_Type : Iir;
+   begin
+      Right_Base_Type := Get_Base_Type (Right_Type);
+      Left_Base_Type := Get_Base_Type (Left_Type);
+      if Right_Base_Type = Left_Base_Type then
+         return True;
+      end if;
+      if Get_Kind (Left_Base_Type) = Iir_Kind_Integer_Type_Definition
+        and then Right_Base_Type = Convertible_Integer_Type_Definition
+      then
+         return True;
+      end if;
+      if Get_Kind (Left_Base_Type) = Iir_Kind_Floating_Type_Definition
+        and then Right_Base_Type = Convertible_Real_Type_Definition
+      then
+         return True;
+      end if;
+      return False;
+   end Compatibility;
+
+   function Compatibility_Types1 (Left_Type : Iir; Right_Types : Iir)
+                                 return Boolean
+   is
+      El : Iir;
+      Right_List : Iir_List;
+   begin
+      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 Compatibility (Left_Type, El) then
+               return True;
+            end if;
+         end loop;
+         return False;
+      else
+         return Compatibility (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;
+
+   function Compatibility_Types (Left_Types : Iir; Right_Types : Iir)
+                                return Boolean
+   is
+      El : Iir;
+      Left_List : Iir_List;
+   begin
+      if Is_Overload_List (Left_Types) then
+         Left_List := Get_Overload_List (Left_Types);
+         for I in Natural loop
+            El := Get_Nth_Element (Left_List, I);
+            exit when El = Null_Iir;
+            if Compatibility_Types1 (El, Right_Types) then
+               return True;
+            end if;
+         end loop;
+         return False;
+      else
+         return Compatibility_Types1 (Left_Types, Right_Types);
+      end if;
+   end Compatibility_Types;
+
+   function Sem_Type_Range (Expr : Iir; A_Type : Iir) return Iir
+   is
+      Expr_Type : Iir;
+   begin
+      Expr_Type := Get_Type (Expr);
+      if Expr_Type = Null_Iir then
+         return A_Type;
+      end if;
+      if Get_Kind (Expr_Type) in Iir_Kinds_Scalar_Type_Definition then
+         return Expr_Type;
+      end if;
+      Expr_Type := Find_Declaration (Expr_Type, Decl_Type);
+      if A_Type /= Null_Iir and then A_Type /= Expr_Type then
+         -- This can happend when EXPR is an array subtype index subtype
+         -- and A_TYPE is the array index type.
+         Error_Msg_Sem ("subtype " & Disp_Node (Expr_Type)
+                        & " doesn't match expected type "
+                        & Disp_Node (A_Type), Expr);
+      end if;
+      return Expr_Type;
+   end Sem_Type_Range;
+
+   -- 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_Range_Expression (Expr: Iir_Range_Expression; A_Type: Iir)
+      return Iir_Range_Expression
+   is
+      Base_Type: Iir;
+      Left, Right: Iir;
+      Expr_Type : Iir;
+   begin
+      Expr_Type := Sem_Type_Range (Expr, A_Type);
+      if Expr_Type /= Null_Iir then
+         Base_Type := Get_Base_Type (Expr_Type);
+      else
+         Base_Type := Null_Iir;
+      end if;
+
+      Left := Get_Left_Limit (Expr);
+      Right := Get_Right_Limit (Expr);
+      Right := Sem_Expression_Ov (Right, Base_Type);
+      Left := Sem_Expression_Ov (Left, Base_Type);
+      if Left = Null_Iir or else Right = Null_Iir then
+         return Null_Iir;
+      end if;
+      if Is_Overloaded (Left) or else Is_Overloaded (Right) then
+         if Base_Type /= Null_Iir then
+            --  Cannot happen, since sem_expression_ov should resolved
+            --  ambiguties if a type is given.
+            raise Internal_Error;
+         end if;
+
+         --  Try to find a common type.
+         Base_Type := Search_Compatible_Type
+           (Get_Type (Left), Get_Type (Right));
+         if Base_Type = Null_Iir then
+            if Compatibility_Types1
+              (Universal_Integer_Type_Definition, Get_Type (Left))
+              and then
+              Compatibility_Types1
+              (Universal_Integer_Type_Definition, Get_Type (Right))
+            then
+               Base_Type := Universal_Integer_Type_Definition;
+            elsif Compatibility_Types1
+              (Universal_Real_Type_Definition, Get_Type (Left))
+              and then
+              Compatibility_Types1
+              (Universal_Real_Type_Definition, Get_Type (Right))
+            then
+               Base_Type := Universal_Real_Type_Definition;
+            else
+               Error_Msg_Sem
+                 ("left and right expressions of range are not compatible",
+                  Expr);
+               return Null_Iir;
+            end if;
+         end if;
+         Base_Type := Get_Base_Type (Base_Type);
+         Left := Sem_Expression (Left, Base_Type);
+         Right := Sem_Expression (Right, Base_Type);
+         if Left = Null_Iir or else Right = Null_Iir then
+            return Null_Iir;
+         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 Expr_Type /= Null_Iir then
+         Set_Type (Expr, Base_Type);
+         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);
+         end if;
+      else
+         Base_Type := Get_Common_Basetype (Get_Base_Type (Get_Type (Left)),
+                                           Get_Base_Type (Get_Type (Right)));
+         if Base_Type = Null_Iir then
+            Error_Msg_Sem
+              ("left and right expressions of range are not compatible", Expr);
+            return Null_Iir;
+         end if;
+         Set_Type (Expr, Base_Type);
+      end if;
+      return Expr;
+   end Sem_Range_Expression;
+
+   -- Set semantic to expr.
+   -- 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_Discrete_Range_Expression (Expr: Iir; A_Type: Iir)
+     return Iir
+   is
+      Res : Iir;
+      Res_Type : Iir;
+   begin
+      if Get_Kind (Expr) = Iir_Kind_Range_Expression then
+         Res := Sem_Range_Expression (Expr, A_Type);
+         if Res = Null_Iir then
+            return Null_Iir;
+         end if;
+         Res_Type := Get_Type (Res);
+      else
+         if Get_Kind (Expr) in Iir_Kinds_Name
+           or else Get_Kind (Expr) = Iir_Kind_Attribute_Name
+         then
+            Sem_Name (Expr, False);
+            Maybe_Finish_Sem_Name (Expr);
+            Res := Get_Named_Entity (Expr);
+            if Res = Error_Mark then
+               return Null_Iir;
+            end if;
+            Xref_Name (Expr);
+         else
+            Res := Expr;
+         end if;
+
+         case Get_Kind (Res) is
+            when Iir_Kind_Type_Declaration
+              | Iir_Kind_Subtype_Declaration =>
+               Res := Get_Type (Res);
+               Res_Type := Res;
+               if Get_Kind (Res) not in Iir_Kinds_Discrete_Type_Definition
+               then
+                  Error_Msg_Sem
+                    (Disp_Node (Res) & " is not a discrete range type", Expr);
+                  return Null_Iir;
+               end if;
+            when Iir_Kind_Range_Array_Attribute
+              | Iir_Kind_Reverse_Range_Array_Attribute =>
+               Res_Type := Get_Type (Res);
+               Res := Eval_Expr_If_Static (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;
+      end if;
+
+      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
+         case Get_Kind (Res) is
+            when Iir_Kinds_Type_And_Subtype_Definition =>
+               if Get_Type_Staticness (Res) = Locally then
+                  Eval_Check_Range (Get_Range_Constraint (Res), A_Type);
+               end if;
+            when others =>
+               if Get_Expr_Staticness (Res) = Locally then
+                  Eval_Check_Range (Res, A_Type);
+               end if;
+         end case;
+      end if;
+      return Res;
+   end Sem_Discrete_Range_Expression;
+
+   function Sem_Discrete_Range_Integer (Expr: Iir) return Iir
+   is
+      Range_Type : Iir;
+   begin
+      Range_Type := Sem_Discrete_Range_Expression (Expr, Null_Iir);
+      if Range_Type = Null_Iir then
+         return Null_Iir;
+      end if;
+      if Get_Kind (Expr) /= Iir_Kind_Range_Expression then
+         return Range_Type;
+      end if;
+      Range_Type := Get_Type (Expr);
+      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 (Expr, Integer_Type_Definition);
+      elsif Range_Type = Universal_Integer_Type_Definition 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
+         if Flags.Vhdl_Std = Vhdl_93c then
+            --  Be tolerant.
+            Warning_Msg_Sem ("universal integer bound must be numeric literal "
+                             & "or attribute", Expr);
+         else
+            Error_Msg_Sem ("universal integer bound must be numeric literal "
+                           & "or attribute", Expr);
+         end if;
+         Set_Type (Expr, Integer_Type_Definition);
+      end if;
+      return Expr;
+   end Sem_Discrete_Range_Integer;
+
+   function Get_Discrete_Range_Staticness (Expr : Iir) return Iir_Staticness is
+   begin
+      if Get_Kind (Expr) in Iir_Kinds_Discrete_Type_Definition then
+         return Get_Type_Staticness (Expr);
+      else
+         return Get_Expr_Staticness (Expr);
+      end if;
+   end Get_Discrete_Range_Staticness;
+
+
+   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 calle list of SUBPRG (which must be a subprg decl).
+   procedure Add_In_Callee_List (Subprg : Iir; Callee : Iir)
+   is
+      List : Iir_List;
+   begin
+      List := Get_Callees_List (Subprg);
+      if List = Null_Iir_List then
+         List := Create_Iir_List;
+         Set_Callees_List (Subprg, List);
+      end if;
+      --  FIXME: May use a flag in IMP to speed up the
+      --  add operation.
+      Add_Element (List, Callee);
+   end Add_In_Callee_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_Callee_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
+      if Get_Kind (Callee) /= Iir_Kind_Procedure_Declaration then
+         raise Internal_Error;
+      end if;
+      case Get_Wait_State (Callee) is
+         when False =>
+            return;
+         when True =>
+            null;
+         when Unknown =>
+            Add_In_Callee_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;
+
+   --  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 : Iir := Get_Current_Subprogram;
+   begin
+      Set_Implementation (Expr, Imp);
+      Set_Function_Call_Staticness (Expr, Imp);
+      Set_Use_Flag (Imp, True);
+
+      --  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);
+         when Iir_Kind_Procedure_Declaration =>
+            Sem_Call_Purity_Check (Subprg, Imp, Expr);
+            Sem_Call_Wait_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;
+
+   function Sem_Subprogram_Call_Stage1
+     (Expr : Iir; A_Type : Iir; Is_Func_Call : Boolean)
+     return Iir
+   is
+      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
+      Nbr_Inter := 0;
+      Imp_List := Get_Overload_List (Get_Implementation (Expr));
+      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;
+
+         --  The identifier of a function call must be a function or an
+         --  enumeration literal.
+         if Is_Func_Call and then not
+           (Get_Kind (A_Func) = Iir_Kind_Function_Declaration
+            or else Get_Kind (A_Func) = Iir_Kind_Implicit_Function_Declaration
+            or else Get_Kind (A_Func) = Iir_Kind_Enumeration_Literal)
+         then
+            goto Continue;
+         end if;
+
+         --  The identifier of a procedure call must be a procedure.
+         if not Is_Func_Call and then not
+           (Get_Kind (A_Func) = Iir_Kind_Procedure_Declaration
+            or else
+            Get_Kind (A_Func) = Iir_Kind_Implicit_Procedure_Declaration)
+         then
+            goto Continue;
+         end if;
+
+         --  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 =>
+            Error_Msg_Sem ("can't find a subprogram for this overload call",
+                           Expr);
+            return Null_Iir;
+         when 1 =>
+            -- Very simple case: no overloading.
+            Inter := Get_First_Element (Imp_List);
+            Free_Iir (Get_Implementation (Expr));
+            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);
+                  return Null_Iir;
+               end if;
+               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);
+                  return Null_Iir;
+               end if;
+               Set_Type (Expr, Create_Overload_List (Res_Type));
+            else
+               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: Boolean;
+      Res_Type: Iir;
+      Res: Iir;
+      Inter_List: Iir;
+      Param_Chain : Iir;
+      Inter: Iir;
+      Assoc_Chain : Iir;
+      Match : Boolean;
+   begin
+      Is_Func := Get_Kind (Expr) = Iir_Kind_Function_Call;
+
+      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 implementation 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;
+         end if;
+         if Is_Overload_List (Inter_List) then
+            return Sem_Subprogram_Call_Stage1 (Expr, A_Type, Is_Func);
+         else
+            if Is_Func then
+               if Get_Kind (Inter_List) not in Iir_Kinds_Function_Declaration
+               then
+                  Error_Msg_Sem ("identifier is not a function", Expr);
+                  return Null_Iir;
+               end if;
+            else
+               if Get_Kind (Inter_List) not in Iir_Kinds_Procedure_Declaration
+                 and then Get_Kind (Inter_List) /=
+                 Iir_Kind_Implicit_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);
+            Sem_Subprogram_Call_Finish (Expr, Inter_List);
+            return Expr;
+         end if;
+      end if;
+
+      if Is_Func and then A_Type = Null_Iir then
+         -- Impossible case: second call to sem_function_call, without
+         -- A_TYPE set.
+         raise Internal_Error;
+      end if;
+
+      -- 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_Func then
+         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);
+                     return Null_Iir;
+                  else
+                     Res := Inter;
+                  end if;
+               end if;
+            end loop;
+         else
+            if Are_Basetypes_Compatible
+              (Get_Base_Type (Get_Return_Type (Inter_List)), A_Type)
+            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;
+      else
+         -- a procedure call.
+         if Is_Overload_List (Inter_List) then
+            Error_Overload (Expr);
+            return Null_Iir;
+         else
+            Res := Inter_List;
+         end if;
+      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.
+      if Is_Func then
+         Set_Type (Expr, Get_Return_Type (Res));
+      end if;
+      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);
+      Sem_Subprogram_Call_Finish (Expr, Res);
+      return Expr;
+   end Sem_Subprogram_Call;
+
+   procedure Sem_Procedure_Call (Call : Iir_Procedure_Call; Stmt : Iir)
+   is
+      use Iirs_Utils;
+
+      Imp: Iir;
+      Name : Iir;
+      Parameters_Chain : Iir;
+      Param : Iir;
+      Formal : Iir;
+      Prefix : Iir;
+      Inter : Iir;
+   begin
+      Name := Get_Implementation (Call);
+      Sem_Name (Name, False);
+      Imp := Get_Named_Entity (Name);
+      if Imp = Null_Iir then
+         return;
+      end if;
+      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);
+      Xref_Name (Name);
+      Free_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_Signal_Interface_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_Base_Name (Prefix)) is
+                  when Iir_Kind_Signal_Declaration
+                    | Iir_Kind_Signal_Interface_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
+              or Ref_Type = Universal_Real_Type
+            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;
+      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_Overload_List (Get_Type (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_Overload_List (Get_Type (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
+            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;
+
+            --  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 Compatibility (Res_Type, Get_Return_Type (Decl))
+            then
+               goto Next;
+            end if;
+
+            Interface_Chain := Get_Interface_Declaration_Chain (Decl);
+
+            --  Check arity.
+            if Iir_Chains.Get_Chain_Length (Interface_Chain) /= Arity then
+               goto Next;
+            end if;
+
+            -- Check operands.
+            if not Compatibility_Nodes (Interface_Chain, Left) then
+               goto Next;
+            end if;
+            if Arity = 2 then
+               if not Compatibility_Nodes (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.
+               if Flags.Flag_Explicit then
+                  Decl := Get_Explicit_Subprogram (Overload_List);
+                  if Decl /= Null_Iir then
+                     return Set_Uniq_Interpretation (Decl);
+                  end if;
+               end if;
+
+               --  It was impossible to find one solution.
+               Error_Operator_Overload (Overload_List);
+
+               --  Give an advice.
+               if not Flags.Flag_Explicit and not Explicit_Advice_Given then
+                  Decl := Get_Explicit_Subprogram (Overload_List);
+                  if Decl /= Null_Iir then
+                     Error_Msg_Sem
+                       ("(you may like 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_List := Get_Overload_List (Get_Implementation (Expr));
+         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 Compatibility (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 (Get_Type (Expr));
+         return Set_Uniq_Interpretation (Full_Compat);
+      end if;
+   end Sem_Operator;
+
+   -- Create a subtype for a string literal.
+   -- The literal must have been typed, with a type or a subtype.
+   -- FIXME: not general at all!
+   function Check_Type_For_String_Literal (A_Type : Iir; Expr : Iir)
+                                          return Boolean
+   is
+      Base_Type : 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_Unidim_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 Check_Type_For_String_Literal;
+
+   --  Semantize LIT whose elements must be of type EL_TYPE, and return
+   --  the length.
+   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;
+      Len : Natural;
+   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 Len;
+   end Sem_String_Literal;
+
+   procedure Sem_String_Literal (Lit: Iir) is
+      Lit_Type: Iir;
+      Lit_Base_Type : Iir;
+
+      -- 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
+      Lit_Type := Get_Type (Lit);
+      Lit_Base_Type := Get_Base_Type (Lit_Type);
+
+      El_Type := Get_Base_Type (Get_Element_Subtype (Lit_Base_Type));
+      Len := Sem_String_Literal (Lit, El_Type);
+
+      case Get_Kind (Lit_Type) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            -- 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);
+         when Iir_Kind_Array_Subtype_Definition =>
+            Index_Type := Get_First_Element
+              (Get_Index_Subtype_List (Lit_Type));
+            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: It this right ?
+               --  We really need a locally static type.
+               N_Type := Create_Unidim_Array_By_Length
+                 (Lit_Base_Type, Iir_Int64 (Len), Lit);
+               Set_Type (Lit, N_Type);
+            end if;
+         when others =>
+            Error_Kind ("sem_string_literal_type", Lit_Type);
+      end case;
+   end Sem_String_Literal;
+
+   procedure Sem_String_Choices_Range (Choice_Chain : Iir; Sel : Iir)
+   is
+      --  True if others choice is present.
+      Has_Others : Boolean;
+
+      --  Type of SEL.
+      Sel_Type : Iir;
+
+      --  Length of SEL (number of characters in SEL).
+      Sel_Length : Iir_Int64;
+
+      El : Iir;
+
+      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_Expression (Choice), Sel_Type);
+         if Expr = Null_Iir then
+            return;
+         end if;
+         Set_Expression (Choice, Expr);
+         if Get_Expr_Staticness (Expr) > Locally then
+            Error_Msg_Sem ("choice must be locally static expression", Expr);
+            return;
+         end if;
+         Expr := Eval_Expr (Expr);
+         Set_Expression (Choice, Expr);
+         if Eval_Discrete_Type_Length
+           (Get_String_Type_Bound_Type (Get_Type (Expr))) /= Sel_Length
+         then
+            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_Unidim_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));
+
+      Has_Others := False;
+      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 =>
+               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;
+
+      -- FIXME:
+      -- * check for duplicate choices.
+      -- * check for leaking choices.
+      -- (should eval strings and bit-strings).
+   end Sem_String_Choices_Range;
+
+   function Is_Name (Name : Iir) return Boolean
+   is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Attribute_Name
+           | Iir_Kind_Parenthesis_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Name;
+
+   procedure Sem_Choices_Range
+     (Choice_Chain : in out Iir;
+      Sub_Type : Iir;
+      Is_Sub_Range : 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;
+      --Index_Constraint : Iir;
+      Staticness : Iir_Staticness;
+
+      --  Semantize a simple (by expression or by range) choice.
+      --  Return FALSE in case of error.
+      function Sem_Simple_Choice return Boolean
+      is
+         Expr : Iir;
+      begin
+         Expr := Get_Expression (El);
+         if Get_Kind (El) = Iir_Kind_Choice_By_Range then
+            Expr := Sem_Discrete_Range_Expression (Expr, Sub_Type);
+         elsif Is_Name (Expr) then
+            declare
+               Name : Iir;
+               N_Choice : Iir;
+            begin
+               Sem_Name (Expr, False);
+               Name := Get_Named_Entity (Expr);
+               case Get_Kind (Name) is
+                  when Iir_Kind_Type_Declaration
+                    | Iir_Kind_Subtype_Declaration =>
+                     Xref_Name (Expr);
+                     Name := Get_Type (Name);
+                  when others =>
+                     null;
+               end case;
+               case Get_Kind (Name) is
+                  when Iir_Kinds_Type_And_Subtype_Definition
+                    | Iir_Kind_Range_Array_Attribute
+                    | Iir_Kind_Reverse_Range_Array_Attribute =>
+                     if not Are_Types_Compatible (Name, Sub_Type) then
+                        Not_Match (Name, Sub_Type);
+                        return False;
+                     end if;
+                     N_Choice := Create_Iir (Iir_Kind_Choice_By_Range);
+                     Location_Copy (N_Choice, El);
+                     Set_Chain (N_Choice, Get_Chain (El));
+                     Set_Associated (N_Choice, Get_Associated (El));
+                     Set_Same_Alternative_Flag
+                       (N_Choice, Get_Same_Alternative_Flag (El));
+                     Set_Expression (N_Choice, Eval_Range (Name));
+                     Set_Choice_Staticness
+                       (N_Choice, Get_Type_Staticness (Name));
+                     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;
+                  when Iir_Kind_Error =>
+                     return False;
+                  when others =>
+                     Expr := Name_To_Expression
+                       (Expr, Get_Base_Type (Sub_Type));
+               end case;
+            end;
+         else
+            Expr := Sem_Expression_Ov (Expr, Get_Base_Type (Sub_Type));
+         end if;
+         if Expr = Null_Iir then
+            return False;
+         end if;
+         Expr := Eval_Expr_If_Static (Expr);
+         Set_Expression (El, Expr);
+         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
+         Expr := Get_Expression (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;
+      end Get_Low;
+
+      function Get_High (Assoc : Iir) return Iir
+      is
+         Expr : Iir;
+      begin
+         Expr := Get_Expression (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;
+      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;
+
+      --  Bubble down element I of a partially ordered heap of length N in
+      --  array ARR.
+      procedure Bubble_Down (I, N : Natural)
+      is
+         Child : Natural;
+      begin
+         Child := 2 * I;
+         if Child < N and then Lt (Child, Child + 1) then
+            Child := Child + 1;
+         end if;
+         if Child <= N and then Lt (I, Child) then
+            Swap (I, Child);
+            Bubble_Down (Child, N);
+         end if;
+      end Bubble_Down;
+
+      --  Heap sort of ARR.
+      procedure Heap_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 Heap_Sort;
+   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
+                  Staticness := Min (Staticness, Get_Choice_Staticness (El));
+               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
+         --  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;
+         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
+            Expr := Get_Expression (Choice);
+            if Type_Has_Bounds
+              and then Get_Expr_Staticness (Expr) = Locally
+              and then Get_Type_Staticness (A_Type) = Locally
+            then
+               if Get_Kind (Choice) = Iir_Kind_Choice_By_Range then
+                  Ok := Eval_Is_Range_In_Bound (Expr, A_Type);
+               else
+                  Ok := Eval_Is_In_Bound (Expr, A_Type);
+               end if;
+               if not Ok then
+                  Error_Msg_Sem
+                    (Disp_Node (Expr) & " out of index range", Choice);
+               end if;
+            else
+               Ok := True;
+            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
+      Heap_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;
+         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 : Iir;
+
+      --  Type of the element.
+      El_Type : Iir;
+
+      Matches: Iir_Array_Acc;
+      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 : 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_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_Chain
+           (Get_Element_Declaration_Chain (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_Name (N_El, Aggr_El);
+         Set_Associated (N_El, Get_Associated (Ass));
+         Set_Chain (N_El, Get_Chain (Ass));
+         Xref_Ref (Expr, Aggr_El);
+         Free_Old_Iir (Ass);
+         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 : Iir_Element_Declaration;
+   begin
+      Ok := True;
+      Assoc_Chain := Get_Association_Choices_Chain (Aggr);
+      Base_Type := Get_Base_Type (A_Type);
+      Matches := new Iir_Array
+        (0 .. Natural (Get_Number_Element_Declaration (Base_Type)) - 1);
+      Matches.all := (others => Null_Iir);
+
+      El_Type := Null_Iir;
+      Has_Named := False;
+      Rec_El := Get_Element_Declaration_Chain (Base_Type);
+      Prev_El := Null_Iir;
+      El := Assoc_Chain;
+      while El /= Null_Iir loop
+         Expr := Get_Associated (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 = Null_Iir then
+                  Error_Msg_Sem ("too many elements", El);
+                  exit;
+               else
+                  Add_Match (El, Rec_El);
+                  Rec_El := Get_Chain (Rec_El);
+               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;
+                  Rec_El : Iir_Element_Declaration;
+               begin
+                  Rec_El := Get_Element_Declaration_Chain (Base_Type);
+                  for I in Matches.all'Range loop
+                     if Matches (I) = Null_Iir then
+                        Add_Match (El, Rec_El);
+                        Found := True;
+                     end if;
+                     Rec_El := Get_Chain (Rec_El);
+                  end loop;
+                  pragma Assert (Rec_El = Null_Iir);
+                  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 (El, Eval_Expr_If_Static (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.
+      El := Get_Element_Declaration_Chain (Base_Type);
+      for I in Matches.all'Range loop
+         if Matches (I) = Null_Iir then
+            Error_Msg_Sem ("no value for " & Disp_Node (El), Aggr);
+            Ok := False;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+      Free (Matches);
+      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
+      Res: Boolean;
+      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
+      Res := True;
+      Index_List := Get_Index_Subtype_List (A_Type);
+      Index_Type := Get_Nth_Element (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,
+                               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_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);
+
+            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_Direction (Index_Subtype_Constraint,
+                           Get_Direction (Index_Constraint));
+
+            --  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
+               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;
+            else
+               --  Dynamic aggregate.
+               declare
+                  Expr : Iir;
+                  Choice : Iir;
+               begin
+                  Choice := Assoc_Chain;
+                  Expr := Get_Expression (Choice);
+                  case Get_Kind (Choice) is
+                     when Iir_Kind_Choice_By_Expression =>
+                        Set_Left_Limit (Index_Subtype_Constraint, Expr);
+                        Set_Right_Limit (Index_Subtype_Constraint, Expr);
+                     when Iir_Kind_Choice_By_Range =>
+                        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 (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 (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 (Choice) /= Null_Iir then
+                  Assoc := Get_Associated (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 : Iir_List := Get_Index_Subtype_List (Aggr_Type);
+      Nbr_Dim : 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);
+      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_Type (Aggr, A_Subtype);
+      else
+         Set_Type (Aggr, Base_Type);
+      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_Max_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
+      if A_Type = Null_Iir then
+         raise Internal_Error;
+      end if;
+
+      --  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, True);
+         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
+      Decl: Iir;
+      Decl_Type : Iir;
+      Res: Iir;
+   begin
+      case Get_Kind (Lit) is
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            Decl := Find_Declaration (Get_Unit_Name (Lit), Decl_Unit);
+            Res := Lit;
+         when Iir_Kind_Unit_Declaration =>
+            Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+            Location_Copy (Res, Lit);
+            Set_Value (Res, 1);
+            Decl := Lit;
+         when others =>
+            Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+            Location_Copy (Res, Lit);
+            Set_Value (Res, 1);
+            Decl := Find_Declaration (Lit, Decl_Unit);
+      end case;
+      if Decl = Null_Iir then
+         return Null_Iir;
+      end if;
+      Set_Unit_Name (Res, Decl);
+      Decl_Type := Get_Type (Decl);
+      Set_Type (Res, Decl_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 (Decl));
+      --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
+      Arg := Get_Expression (Expr);
+      Set_Expr_Staticness (Expr, None);
+      if Get_Type (Expr) = Null_Iir then
+         if Get_Kind (Expr) = Iir_Kind_Allocator_By_Expression then
+            if Get_Kind (Arg) /= Iir_Kind_Qualified_Expression then
+               raise Internal_Error;
+            end if;
+            Arg := Sem_Expression (Arg, Null_Iir);
+            if Arg = Null_Iir then
+               return Null_Iir;
+            end if;
+            Check_Read (Arg);
+            Arg_Type := Get_Type (Arg);
+         else
+            Arg := Sem_Types.Sem_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 Sem_Types.Sem_Is_Constrained (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_Function (Arg) /= Null_Iir
+            then
+               Error_Msg_Sem ("subtype indication must not include"
+                              & " a resolution function", Expr);
+            end if;
+            Arg_Type := Arg;
+         end if;
+         Set_Expression (Expr, Arg);
+      else
+         if Get_Kind (Expr) = Iir_Kind_Allocator_By_Expression then
+            Arg_Type := Get_Type (Arg);
+         else
+            Arg_Type := Arg;
+         end if;
+      end if;
+
+      if A_Type = Null_Iir then
+         --  Pass 1.
+         --  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.
+         declare
+            Index : Visible_Type_Index_Type;
+            Vtype : Iir;
+            Btype : Iir;
+            Dtype : Iir;
+            List : Iir_List;
+         begin
+            List := Create_Iir_List;
+            Index := Get_First_Visible_Type;
+            while Index /= No_Visible_Type_Index loop
+               Vtype := Get_Visible_Type_Decl (Index);
+               Btype := Get_Base_Type (Get_Type (Vtype));
+               if Get_Kind (Btype) = Iir_Kind_Access_Type_Definition then
+                  Dtype := Get_Base_Type (Get_Designated_Type (Btype));
+                  if Dtype = Get_Base_Type (Arg_Type) then
+                     Add_Element (List, Dtype);
+                  end if;
+               end if;
+               Index := Get_Next_Visible_Type (Index);
+            end loop;
+            Set_Type (Expr, Simplify_Overload_List (List));
+         end;
+      else
+         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;
+            return Null_Iir;
+         end if;
+         if not Are_Types_Compatible (Arg_Type, Get_Designated_Type (A_Type))
+         then
+            Not_Match (Expr, A_Type);
+            return Null_Iir;
+         end if;
+         Free_Old_Iir (Get_Type (Expr));
+         Set_Type (Expr, A_Type);
+      end if;
+      return Expr;
+   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_Constant_Interface_Declaration
+              | Iir_Kind_Variable_Declaration
+              | Iir_Kind_Attribute_Value
+              | Iir_Kind_Iterator_Declaration
+              | Iir_Kind_Guard_Signal_Declaration =>
+               return;
+            when Iir_Kind_File_Declaration
+              | Iir_Kind_File_Interface_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_Signal_Interface_Declaration
+              | Iir_Kind_Variable_Interface_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_Integer_Literal
+              | Iir_Kind_Floating_Point_Literal
+              | Iir_Kind_Null_Literal
+              | Iir_Kind_Unit_Declaration
+              | Iir_Kind_Simple_Aggregate =>
+               return;
+            when Iir_Kinds_Monadic_Operator
+              | Iir_Kinds_Dyadic_Operator
+              | Iir_Kind_Function_Call =>
+               return;
+            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 =>
+               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 =>
+               Obj := Get_Base_Name (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)
+   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", Expr);
+      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_Character_Literal =>
+            declare
+               Interpretation: Name_Interpretation_Type;
+               Decl: Iir;
+               List: Iir_List;
+            begin
+               Interpretation := Get_Interpretation (Get_Identifier (Expr));
+
+               -- Check the identifier was declared.
+               if not Valid_Interpretation (Interpretation) then
+                  Undeclared (Expr);
+                  return Null_Iir;
+               end if;
+
+               if not Valid_Interpretation
+                 (Get_Next_Interpretation (Interpretation))
+               then
+                  Decl := Get_Declaration (Interpretation);
+                  if A_Type /= Null_Iir and then A_Type = Get_Type (Decl) then
+                     --  Free overload list of expr (if any), and expr.
+                     Replace_Type (Expr, Null_Iir);
+                     Iirs_Utils.Free_Name (Expr);
+                     return Decl;
+                  end if;
+               end if;
+
+               -- Character literal can only be an enumeration literal.
+               if A_Type /= Null_Iir then
+                  while Valid_Interpretation (Interpretation) loop
+                     Decl := Get_Non_Alias_Declaration (Interpretation);
+                     if Get_Type (Decl) = A_Type then
+                        Replace_Type (Expr, Null_Iir);
+                        Iirs_Utils.Free_Name (Expr);
+                        return Decl;
+                     end if;
+                     Interpretation :=
+                       Get_Next_Interpretation (Interpretation);
+                  end loop;
+                  Not_Match (Expr, A_Type);
+                  return Null_Iir;
+               end if;
+
+               -- Store overloaded interpretation.
+               List := Create_Iir_List;
+               while Valid_Interpretation (Interpretation) loop
+                  Decl := Get_Declaration (Interpretation);
+                  Append_Element (List, Get_Type (Decl));
+                  Interpretation := Get_Next_Interpretation (Interpretation);
+               end loop;
+               Set_Type (Expr, Create_Overload_List (List));
+               return Expr;
+            end;
+
+         when Iir_Kind_Selected_Name
+           | Iir_Kind_Simple_Name
+           | 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, False);
+                  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);
+               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 =>
+            if A_Type /= Null_Iir then
+               if not Check_Type_For_String_Literal (A_Type, Expr) then
+                  Not_Match (Expr, A_Type);
+                  return Null_Iir;
+               end if;
+               -- It is enough ?
+               -- FIXME: check against LRM.
+               Replace_Type (Expr, A_Type);
+               Sem_String_Literal (Expr);
+               return Expr;
+            end if;
+
+            -- Look on every visible declaration of unidimensional array.
+            declare
+               Vt: Visible_Type_Index_Type;
+               Vt_Type : Iir;
+               Decl: Iir;
+               List: Iir_List;
+            begin
+               Vt := Get_First_Visible_Type;
+               List := Create_Iir_List;
+               while Vt /= No_Visible_Type_Index loop
+                  Vt_Type := Get_Type (Get_Visible_Type_Decl (Vt));
+                  Decl := Get_Base_Type (Vt_Type);
+                  if Check_Type_For_String_Literal (Decl, Expr) then
+                     Append_Element (List, Decl);
+                  end if;
+                  Vt := Get_Next_Visible_Type (Vt);
+               end loop;
+               case Get_Nbr_Elements (List) is
+                  when 0 =>
+                     Destroy_Iir_List (List);
+                     Error_Msg_Sem
+                       ("no character type for string literal", Expr);
+                     return Null_Iir;
+                  when 1 =>
+                     Set_Type (Expr, Get_First_Element (List));
+                     Destroy_Iir_List (List);
+                     Sem_String_Literal (Expr);
+                     return Expr;
+                  when others =>
+                     Set_Type (Expr, Create_Overload_List (List));
+                     return Expr;
+               end case;
+            end;
+
+         when Iir_Kind_Null_Literal =>
+            Set_Expr_Staticness (Expr, Locally);
+            if A_Type = Null_Iir then
+               declare
+                  Vt: Visible_Type_Index_Type;
+                  Vt_Type : Iir;
+                  Decl: Iir;
+                  List: Iir_List;
+               begin
+                  Vt := Get_First_Visible_Type;
+                  List := Create_Iir_List;
+                  while Vt /= No_Visible_Type_Index loop
+                     Vt_Type := Get_Type (Get_Visible_Type_Decl (Vt));
+                     Decl := Get_Base_Type (Vt_Type);
+                     if Get_Kind (Decl) = Iir_Kind_Access_Type_Definition then
+                        Append_Element (List, Decl);
+                     end if;
+                     Vt := Get_Next_Visible_Type (Vt);
+                  end loop;
+                  case Get_Nbr_Elements (List) is
+                     when 0 =>
+                        Error_Msg_Sem
+                          ("no visible access type for null literal", Expr);
+                        Destroy_Iir_List (List);
+                        return Null_Iir;
+                     when 1 =>
+                        Set_Type (Expr, Get_First_Element (List));
+                        Destroy_Iir_List (List);
+                        return Expr;
+                     when others =>
+                        Set_Type (Expr, Create_Overload_List (List));
+                        return Expr;
+                  end case;
+               end;
+            elsif Get_Kind (A_Type) /= Iir_Kind_Access_Type_Definition 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_Qualified_Expression =>
+            declare
+               N_Type: Iir;
+               Res: Iir;
+            begin
+               N_Type := Sem_Types.Sem_Subtype_Indication
+                 (Get_Type_Mark (Expr));
+               if N_Type = Null_Iir then
+                  return Null_Iir;
+               end if;
+               Set_Type_Mark (Expr, 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_Kind_Aggregate =>
+            if A_Type = Null_Iir then
+               declare
+                  Vt: Visible_Type_Index_Type;
+                  Vt_Type : Iir;
+                  Decl: Iir;
+                  List: Iir_List;
+                  Res : Iir;
+               begin
+                  Vt := Get_First_Visible_Type;
+                  List := Create_Iir_List;
+                  while Vt /= No_Visible_Type_Index loop
+                     Vt_Type := Get_Type (Get_Visible_Type_Decl (Vt));
+                     Decl := Get_Base_Type (Vt_Type);
+                     case Get_Kind (Decl) is
+                        when Iir_Kind_Array_Type_Definition
+                          | Iir_Kind_Record_Type_Definition =>
+                           Append_Element (List, Decl);
+                        when others =>
+                           null;
+                     end case;
+                     Vt := Get_Next_Visible_Type (Vt);
+                  end loop;
+                  case Get_Nbr_Elements (List) is
+                     when 0 =>
+                        Destroy_Iir_List (List);
+                        Error_Msg_Sem
+                          ("no visible composite type for aggregate", Expr);
+                        return Null_Iir;
+                     when 1 =>
+                        Res := Sem_Aggregate (Expr, Get_First_Element (List));
+                        Destroy_Iir_List (List);
+                        return Res;
+                     when others =>
+                        Set_Type (Expr, Create_Overload_List (List));
+                        return Expr;
+                  end case;
+               end;
+            else
+               return Sem_Aggregate (Expr, A_Type);
+            end if;
+
+         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) = 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 Check_Type_For_String_Literal (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
+         Error_Overload (Expr);
+         return Null_Iir;
+      end if;
+      return Res;
+   end Sem_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 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);
+               return Null_Iir;
+            end if;
+         end if;
+      end loop;
+      if Res = Null_Iir then
+         Error_Overload (Expr1);
+         return Null_Iir;
+      end if;
+      return Sem_Expression_Ov (Expr1, Res);
+   end Sem_Expression_Universal;
+end Sem_Expr;
diff --git a/sem_expr.ads b/sem_expr.ads
new file mode 100644
index 000000000..97722bb1b
--- /dev/null
+++ b/sem_expr.ads
@@ -0,0 +1,154 @@
+--  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 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 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;
+
+   --  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 and return NULL_IIR.
+   --  If EXPR is NULL_IIR, NULL_IIR is silently returned.
+   function Check_Is_Expression (Expr : Iir) return 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;
+
+   --  Semantize a procedure_call or a concurrent_procedure_call_statement.
+   procedure Sem_Procedure_Call (Call : Iir_Procedure_Call; Stmt : Iir);
+
+   function Sem_Discrete_Range_Expression (Expr: Iir; A_Type: Iir)
+                                          return Iir;
+   function Get_Discrete_Range_Staticness (Expr : Iir) return Iir_Staticness;
+
+   --  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;
+
+   --  Convert a parenthesis_name to a slice_name or an index_name, according
+   --  to the suffix expression.
+   --  This is used in sem by generates.
+   --function Sem_Parenthesis_Name (Name : Iir_Parenthesis_Name) 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;
+      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);
+
+   function Compatibility_Types (Left_Types : Iir; Right_Types : 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/sem_names.adb b/sem_names.adb
new file mode 100644
index 000000000..25484e406
--- /dev/null
+++ b/sem_names.adb
@@ -0,0 +1,3318 @@
+--  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 GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Expr; use Sem_Expr;
+with Evaluation; use Evaluation;
+with Iirs_Utils; use Iirs_Utils;
+with Libraries;
+with Errorout; use Errorout;
+with Flags;
+with Sem;
+with Name_Table;
+with Std_Package; use Std_Package;
+with Types; use Types;
+with Std_Names;
+with Iir_Chains; use Iir_Chains;
+with Sem_Stmts; use Sem_Stmts;
+with Sem_Decls; use Sem_Decls;
+with Sem_Assocs; use Sem_Assocs;
+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.
+   procedure Finish_Sem_Name (Name : Iir; Res : 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;
+         Error_Msg_Sem (Disp_Subprg (El), El);
+      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
+   begin
+      return Create_Iir (Iir_Kind_Overload_List);
+   end Get_Overload_List;
+
+   function Create_Overload_List (List : Iir_List) return Iir_Overload_List
+   is
+      Res : Iir_Overload_List;
+   begin
+      Res := Create_Iir (Iir_Kind_Overload_List);
+      Set_Overload_List (Res, List);
+      return Res;
+   end Create_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 =>
+               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;
+
+   --  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)
+   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 : in out Iir);
+   pragma Unreferenced (Add_Result_List);
+
+   procedure Add_Result_List (Res : in out Iir; List : in out 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 : in out Iir; Keep : Iir)
+   is
+      procedure Sem_Name_Free (El : in out Iir) is
+      begin
+         case Get_Kind (El) is
+            when Iir_Kind_Function_Call
+              | Iir_Kind_Indexed_Name =>
+               --  FIXME: recursion ?
+               Free_Iir (El);
+            when Iir_Kinds_Function_Declaration
+              | Iir_Kinds_Procedure_Declaration
+              | Iir_Kind_Enumeration_Literal =>
+               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;
+
+   --  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_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_Suffix_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_Declaration =>
+            null;
+         when Iir_Kind_Generate_Statement =>
+            null;
+         when Iir_Kind_Package_Declaration =>
+            null;
+         when Iir_Kind_Block_Statement =>
+            declare
+               Header : Iir;
+            begin
+               Header := Get_Block_Header (Decl);
+               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_Iterator_Scheme (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_Declaration
+           | 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 =>
+            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
+         Prefix := Get_Prefix (Name);
+         Obj := Get_Named_Entity (Prefix);
+         if Obj /= Null_Iir
+           and then
+           (Get_Kind (Obj) = Iir_Kind_Variable_Declaration
+            or Get_Kind (Obj) = Iir_Kind_Variable_Interface_Declaration)
+           and then Get_Type (Obj) /= Null_Iir
+         then
+            if Get_Kind (Get_Type (Obj)) /= Iir_Kind_Protected_Type_Declaration
+            then
+               raise Internal_Error;
+            end if;
+            Set_Method_Object (Call, Obj);
+         end if;
+      end if;
+      Set_Implementation (Call, Get_Named_Entity (Name));
+   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.
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol =>
+            null;
+         when others =>
+            Error_Kind ("sem_as_function_call", Name);
+      end case;
+
+      Call := Create_Iir (Iir_Kind_Function_Call);
+      Location_Copy (Call, Name);
+      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 PREFIX is a function specification, then return a function call,
+   --  else return PREFIX.
+   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 : Iir;
+      Prefix_Type : Iir;
+      Index_Subtype : Iir;
+      Index_List : Iir_List;
+      Index : Iir;
+      Expr_Staticness : Iir_Staticness;
+   begin
+      Prefix := Get_Prefix (Expr);
+      Prefix_Type := Get_Type (Prefix);
+      Expr_Staticness := Locally;
+
+      Index_List := Get_Index_List (Expr);
+      -- 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_Nth_Element (Get_Index_Subtype_List (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);
+         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: Iir;
+      Prefix_Type: Iir;
+      Prefix_Base_Type : Iir;
+      Prefix_Bt : Iir;
+      Index_List: Iir_List;
+      Index_Type: Iir;
+      Index_Range : Iir;
+      Suffix: Iir;
+      Slice_Type : Iir;
+      Expr_Type : Iir;
+      Staticness : Iir_Staticness;
+      Suffix_Rng : Iir;
+      Prefix_Rng : Iir;
+   begin
+      -- Set a type to the prefix.
+      Prefix := Get_Prefix (Name);
+      Prefix_Type := Get_Type (Prefix);
+      Set_Base_Name (Name, Get_Base_Name (Prefix));
+
+      -- LRM93 §6.5: the prefix of an indexed name must be appropriate
+      -- for an array type.
+      Prefix_Bt := Get_Base_Type (Prefix_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_First_Element (Index_List);
+      Index_Range := Get_Range_Constraint (Index_Type);
+      Prefix_Rng := Eval_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);
+      if Suffix = Null_Iir then
+         return;
+      end if;
+      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.
+      Suffix_Rng := Eval_Range (Suffix);
+      if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition
+        and then Prefix_Rng /= Null_Iir
+        and then Suffix_Rng /= Null_Iir
+        and then Get_Direction (Suffix_Rng) /= 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.
+      Staticness := Get_Discrete_Range_Staticness (Suffix);
+      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_Type_Definition then
+         Set_Resolution_Function
+           (Expr_Type, Get_Resolution_Function (Prefix_Type));
+      else
+         Set_Resolution_Function (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);
+   end Finish_Sem_Slice_Name;
+
+   procedure Finish_Sem_Function_Call (Call : Iir)
+   is
+      Rtype : Iir;
+   begin
+      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;
+
+   procedure Finish_Sem_Array_Attribute (Attr : Iir; Param : Iir)
+   is
+      Parameter : Iir;
+      Prefix_Type : Iir;
+      Index_Type : Iir;
+      Prefix : Iir;
+   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 := Get_Prefix (Attr);
+      Prefix_Type := Get_Type (Prefix);
+      declare
+         Dim : Iir_Int64;
+         Indexes_List : Iir_List;
+      begin
+         Indexes_List := Get_Index_Subtype_List (Prefix_Type);
+         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_Nth_Element (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;
+
+      Set_Parameter (Attr, Parameter);
+
+      --  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.
+      Set_Expr_Staticness (Attr, Get_Type_Staticness (Prefix_Type));
+   end Finish_Sem_Array_Attribute;
+
+   procedure Finish_Sem_Scalar_Type_Attribute (Attr : Iir; Param : Iir)
+   is
+      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_Type := Get_Type (Get_Prefix (Attr));
+      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 Parameter = Null_Iir then
+         return;
+      end if;
+      Set_Parameter (Attr, Parameter);
+      Set_Expr_Staticness (Attr, Min (Get_Type_Staticness (Prefix_Type),
+                                      Get_Expr_Staticness (Parameter)));
+   end Finish_Sem_Scalar_Type_Attribute;
+
+   procedure Finish_Sem_Signal_Attribute (Attr : Iir; Parameter : Iir)
+   is
+      Param : Iir;
+   begin
+      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);
+         Set_Parameter (Attr, Param);
+      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 : Iir;
+      Base_Type2 : Iir;
+      Ant1, Ant2 : Boolean;
+      Index_List1, Index_List2 : Iir_List;
+      El1, El2 : Iir;
+   begin
+      Base_Type1 := Get_Base_Type (Type1);
+      Base_Type2 := Get_Base_Type (Type2);
+
+      --  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_Nth_Element (Index_List1, I);
+         exit when El1 = Null_Iir;
+         El2 := Get_Nth_Element (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;
+
+   procedure Finish_Sem_Type_Conversion (Conv: Iir_Type_Conversion)
+   is
+      Expr: Iir;
+      Staticness : Iir_Staticness;
+   begin
+      -- 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.
+      Expr := Get_Expression (Conv);
+      case Get_Kind (Expr) is
+         when Iir_Kind_Null_Literal
+           | Iir_Kind_Aggregate
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            Error_Msg_Sem
+              (Disp_Node (Expr) & " cannot be a type conversion operand",
+               Expr);
+            return;
+         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 (Expr);
+            if Expr = Null_Iir then
+               return;
+            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;
+      end case;
+
+      Set_Expression (Conv, Expr);
+
+      --  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 Flags.Vhdl_Std = Vhdl_87 then
+            Staticness := Min (Globally, Staticness);
+         end if;
+         Set_Expr_Staticness (Conv, Staticness);
+
+         if not Are_Types_Closely_Related (Get_Type (Conv), 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;
+   end Finish_Sem_Type_Conversion;
+
+   procedure Finish_Sem_Function_Specification (Name : Iir; Spec : Iir)
+   is
+      Res : Iir;
+   begin
+      if not Maybe_Function_Call (Spec) then
+         Error_Msg_Sem (Disp_Node (Spec) & " requires parameters", Name);
+         Set_Named_Entity (Name, Null_Iir);
+         return;
+      end if;
+      Res := Maybe_Insert_Function_Call (Name, Spec);
+      if Get_Kind (Res) /= Iir_Kind_Function_Call then
+         raise Internal_Error;
+      end if;
+      Finish_Sem_Function_Call (Res);
+      Set_Named_Entity (Name, Res);
+   end Finish_Sem_Function_Specification;
+
+   procedure Finish_Sem_Implicits (Name : Iir; Pfx : Iir)
+   is
+      Name_Pfx : Iir;
+   begin
+      case Get_Kind (Pfx) is
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Attribute_Value =>
+            null;
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Slice_Name =>
+            Name_Pfx := Get_Prefix (Name);
+            if Is_Overload_List (Name_Pfx) then
+               Finish_Sem_Name (Name_Pfx, Pfx);
+            end if;
+         when Iir_Kind_Implicit_Dereference =>
+            Finish_Sem_Implicits (Name, Get_Prefix (Pfx));
+            Finish_Sem_Dereference (Pfx);
+         when Iir_Kind_Dereference =>
+            null;
+         when Iir_Kind_Function_Call =>
+            if Get_Name_Staticness (Pfx) = Unknown then
+               Finish_Sem_Function_Call (Pfx);
+            else
+               Name_Pfx := Get_Prefix (Name);
+               if Is_Overload_List (Name_Pfx) then
+                  Finish_Sem_Name (Name_Pfx, Pfx);
+               end if;
+            end if;
+         when others =>
+            Error_Kind ("finish_sem_implicits", Pfx);
+      end case;
+   end Finish_Sem_Implicits;
+
+   --  OBJ is an 'impure' object (variable, signal or file) referenced at
+   --  location LOC.
+   --  Check the pure rules.
+   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 : 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_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration =>
+            null;
+         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_Declaration
+           | 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;
+
+   procedure Finish_Sem_Name (Name : Iir; Res : Iir)
+   is
+      Pfx : Iir;
+   begin
+      case Get_Kind (Res) is
+         when Iir_Kind_Design_Unit =>
+            return;
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration =>
+            return;
+         when Iir_Kind_Type_Conversion =>
+            Finish_Sem_Type_Conversion (Res);
+            return;
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Dereference =>
+            null;
+         when Iir_Kind_Function_Call =>
+            Finish_Sem_Function_Call (Res);
+            return;
+         when Iir_Kinds_Function_Declaration
+           | Iir_Kinds_Procedure_Declaration =>
+            --declare
+            --   Nres : Iir;
+            --begin
+            --   Nres := Sem_As_Function_Call (Res, Null_Iir, Name);
+            --  Set_Named_Entity (Name, Nres);
+            --  Finish_Sem_Function_Call (Nres);
+            --end;
+            return;
+         when Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute =>
+            Finish_Sem_Array_Attribute (Res, Null_Iir);
+            return;
+--          when Iir_Kind_Pos_Attribute =>
+--             if Get_Parameter (Res) = Null_Iir then
+--                Finish_Sem_Scalar_Type_Attribute (Res, Null_Iir);
+--             end if;
+--             return;
+         when others =>
+            Error_Kind ("finish_sem_name", Res);
+      end case;
+
+      Pfx := Get_Prefix (Res);
+      Finish_Sem_Implicits (Name, Pfx);
+
+      case Get_Kind (Res) is
+         when Iir_Kind_Indexed_Name =>
+            Finish_Sem_Indexed_Name (Res);
+         when Iir_Kind_Slice_Name =>
+            Finish_Sem_Slice_Name (Res);
+         when Iir_Kind_Selected_Element =>
+            Set_Name_Staticness (Res, Get_Name_Staticness (Pfx));
+            Set_Expr_Staticness (Res, Get_Expr_Staticness (Pfx));
+            Set_Base_Name (Res, Get_Base_Name (Pfx));
+         when Iir_Kind_Dereference =>
+            Finish_Sem_Dereference (Res);
+         when others =>
+            Error_Kind ("finish_sem_name(2)", Res);
+      end case;
+   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 string literal too.
+   --  GHDL: set interpretation of NAME (possibly an overload list).
+   --  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
+      Interpretation: Name_Interpretation_Type;
+      Res: Iir;
+      Res_List : Iir_List;
+      N : Natural;
+   begin
+      Interpretation := Get_Interpretation (Get_Identifier (Name));
+
+      if not Valid_Interpretation (Interpretation) then
+         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
+         -- not overloaded.
+         Res := Get_Declaration (Interpretation);
+         if not Keep_Alias
+           and then Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration
+         then
+            Res := Get_Name (Res);
+         end if;
+
+         if not Get_Visible_Flag (Res) then
+            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;
+      else
+         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
+            Res := Get_Declaration (Interpretation);
+            if not Keep_Alias
+              and then Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration
+            then
+               Res := Get_Name (Res);
+            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;
+         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_Named_Entity (Name, Res);
+   end Sem_Simple_Name;
+
+   --  LRM93 §6.3
+   --  Selected Names.
+   procedure Sem_Selected_Name (Name: Iir; Keep_Alias : Boolean)
+   is
+      Prefix: Iir;
+      Suffix: Name_Id;
+      Prefix_Loc : Location_Type;
+      Res : Iir;
+
+      procedure Sem_As_Expanded_Name (Sub_Name : Iir)
+      is
+         Sub_Res : Iir;
+      begin
+         if Get_Is_Within_Flag (Sub_Name) = True 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.
+      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_Chain
+           (Get_Element_Declaration_Chain (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 (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_Base_Name (R));
+         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_Method_Call (Sub_Name : Iir)
+      is
+         Prot_Type : Iir;
+         Method : Iir;
+      begin
+         Prot_Type := Get_Type (Sub_Name);
+         Method := Find_Name_In_Chain
+           (Get_Declaration_Chain (Prot_Type), Suffix);
+         if Method = Null_Iir then
+            Error_Msg_Sem
+              ("no method " & Name_Table.Image (Suffix) & " in "
+               & Disp_Node (Prot_Type), Name);
+            return;
+         else
+            Add_Result (Res, Method);
+         end if;
+
+--          case Get_Kind (Method) is
+--             when Iir_Kind_Function_Declaration =>
+--                Call := Create_Iir (Iir_Kind_Function_Call);
+--                Set_Type (Call, Get_Return_Type (Method));
+--                Set_Base_Name (Call, Call);
+--             when Iir_Kind_Procedure_Declaration =>
+--                Call := Create_Iir (Iir_Kind_Procedure_Call);
+--             when others =>
+--                Error_Kind ("sem_as_method_call", Method);
+--          end case;
+--          Location_Copy (Call, Sub_Name);
+--          Set_Implementation (Call, Method);
+--          --Set_Parameter_Association_Chain (Call, Xx);
+--          Add_Result (Res, Call);
+      end Sem_As_Method_Call;
+
+   begin
+      Prefix := Get_Prefix (Name);
+      Prefix_Loc := Get_Location (Prefix);
+      Sem_Name (Prefix, False);
+      Prefix := Get_Named_Entity (Prefix);
+      if Prefix = Error_Mark then
+         Set_Named_Entity (Name, Prefix);
+         return;
+      end if;
+      Suffix := Get_Suffix_Identifier (Name);
+
+      Res := Null_Iir;
+
+      --  FIXME: do better.
+      --
+      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
+               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 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 explicite
+            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);
+            end if;
+         when Iir_Kind_Process_Statement
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Design_Unit
+--            | Iir_Kind_Architecture_Declaration
+--            | Iir_Kind_Entity_Declaration
+--            | Iir_Kind_Package_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 Get_Kind (Prefix) /= Iir_Kind_Package_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 =>
+            if Get_Kind (Get_Type (Prefix))
+              = Iir_Kind_Protected_Type_Declaration
+            then
+               Sem_As_Method_Call (Prefix);
+            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 =>
+            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;
+      elsif not Is_Overload_List (Res) then
+         --  Finish sem
+         Finish_Sem_Name (Name, Res);
+      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
+      if Assoc_Chain = Null_Iir or else Get_Chain (Assoc_Chain) /= Null_Iir
+      then
+         return Null_Iir;
+      end if;
+      Assoc := Assoc_Chain;
+      if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Expression then
+         return Null_Iir;
+      end if;
+      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;
+
+   function Sem_Index_Specification (Name : Iir_Parenthesis_Name; Itype : Iir)
+                                    return Iir
+   is
+      Actual : Iir;
+      Kind : Iir_Kind;
+      Res : Iir;
+   begin
+      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, False);
+            Actual := Get_Named_Entity (Actual);
+            --  FIXME: semantization to be finished.
+            --Maybe_Finish_Sem_Name (Actual);
+         when others =>
+            null;
+      end case;
+      Kind := Slice_Or_Index (Actual);
+      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);
+            if Actual = Null_Iir then
+               return Null_Iir;
+            end if;
+            if Get_Discrete_Range_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;
+      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;
+
+      procedure Index_Or_Not
+      is
+         El : Iir;
+      begin
+         Slice_Index_Kind := Iir_Kind_Error;
+         El := Assoc_Chain;
+         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;
+                  end if;
+               when others =>
+                  --  Only expression are allowed.
+                  return;
+            end case;
+            El := Get_Chain (El);
+         end loop;
+         Slice_Index_Kind := Iir_Kind_Indexed_Name;
+      end Index_Or_Not;
+
+      --  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 prefixes 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 a name (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
+               --  Should not happen.
+               raise Internal_Error;
+            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);
+
+         case Slice_Index_Kind is
+            when Iir_Kind_Slice_Name =>
+               Set_Suffix (R, Get_Actual (Assoc_Chain));
+               Set_Type (R, 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;
+
+      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, False);
+      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 Actual /= Null_Iir
+        and then
+        (Get_Kind (Actual) = Iir_Kind_Range_Expression
+         or else
+         (Get_Kind (Actual) = Iir_Kind_Attribute_Name
+          and then (Get_Attribute_Identifier (Actual) = Std_Names.Name_Range
+                    or else
+                    Get_Attribute_Identifier (Actual)
+                    = Std_Names.Name_Reverse_Range)))
+      then
+         --  A slice.
+         Slice_Index_Kind := Iir_Kind_Slice_Name;
+         Add_Result (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True));
+      elsif Actual /= Null_Iir
+        and then (Get_Kind (Prefix) = Iir_Kind_Type_Declaration
+                  or else Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration)
+      then
+         --  A type conversion
+         Res := Create_Iir (Iir_Kind_Type_Conversion);
+         Location_Copy (Res, Name);
+         Set_Type_Mark (Res, Prefix);
+         Set_Type (Res, Get_Type (Prefix));
+         Set_Expression (Res, Actual);
+      else
+         if Actual /= Null_Iir
+           and then (Get_Kind (Actual) = Iir_Kind_Simple_Name
+                     or Get_Kind (Actual) = Iir_Kind_Selected_Name)
+         then
+            Sem_Name (Actual, False);
+            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);
+         else
+            Index_Or_Not;
+         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;
+                  Used : Boolean;
+                  R : Iir;
+                  Match : Boolean;
+                  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;
+                     Used := False;
+                     if Get_Kind (El) in Iir_Kinds_Function_Declaration then
+                        Sem_Association_Chain
+                          (Get_Interface_Declaration_Chain (El),
+                           Assoc_Chain, False, Missing_Parameter, Name, Match);
+                        if Match then
+                           Add_Result
+                             (Res, Sem_As_Function_Call (Prefix_Name, El,
+                                                         Assoc_Chain));
+                           Used := True;
+                        end if;
+                     end if;
+                     if Get_Kind (El) not in Iir_Kinds_Procedure_Declaration
+                     then
+                        R := Sem_As_Indexed_Or_Slice_Name (El, False);
+                        if R /= Null_Iir then
+                           Add_Result (Res, R);
+                           Used := True;
+                        end if;
+                     end if;
+                     if not Used then
+                        Sem_Name_Free_Result (El, Null_Iir);
+                     end if;
+                  end loop;
+               end;
+               if Res = Null_Iir then
+                  Error_Msg_Sem
+                    ("prefix is neither a function name "
+                     & "nor can it be sliced or indexed", Name);
+               end if;
+            when Iir_Kinds_Function_Declaration =>
+               Add_Result (Res, Sem_As_Function_Call (Prefix_Name,
+                                                      Prefix, Assoc_Chain));
+               Add_Result (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, False));
+               if Res = Null_Iir then
+                  Error_Msg_Sem
+                    ("prefix is neither a function name "
+                     & "nor can it be sliced or indexed", Name);
+               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, 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 Actual /= Null_Iir then
+                  Finish_Sem_Scalar_Type_Attribute (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_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, 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_Kind_Process_Statement
+              | Iir_Kind_Component_Declaration =>
+               Error_Msg_Sem
+                 (Disp_Node (Prefix) & " cannot be indexed or sliced", Name);
+               Res := Null_Iir;
+
+            when others =>
+               Error_Kind ("sem_parenthesis_name", Prefix);
+         end case;
+      end if;
+
+      if Res = Null_Iir then
+         Res := Error_Mark;
+      elsif not Is_Overload_List (Res) then
+         Finish_Sem_Name (Name, Res);
+      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;
+      Res : Iir;
+
+      procedure Sem_As_Selected_By_All_Name (Sub_Name : Iir)
+      is
+         Base_Type : Iir;
+         R : Iir;
+      begin
+         Base_Type := Get_Base_Type (Get_Type (Sub_Name));
+         if Get_Kind (Base_Type) /= Iir_Kind_Access_Type_Definition then
+            return;
+         end if;
+
+         R := Create_Iir (Iir_Kind_Dereference);
+         Location_Copy (R, Name);
+         Set_Prefix (R, Sub_Name);
+         --  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, True);
+      Prefix := Get_Named_Entity (Prefix);
+      if Prefix = Null_Iir then
+         return;
+      end if;
+      Res := Null_Iir;
+      case Get_Kind (Prefix) is
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Indexed_Name =>
+            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;
+      elsif not Is_Overload_List (Res) then
+         Finish_Sem_Name (Name, Res);
+      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 : Iir;
+      Res : Iir;
+      Base_Type : Iir;
+      Type_Decl : Iir;
+   begin
+      Prefix := Get_Named_Entity (Get_Prefix (Attr));
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            null;
+         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);
+      Base_Type := Get_Base_Type (Get_Type (Prefix));
+      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;
+      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 := 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 Null_Iir;
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Design_Unit
+           | 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 =>
+            --  FIXME: to complete
+            null;
+         when others =>
+            Error_Kind ("sem_user_attribute", Prefix);
+      end case;
+
+      Attr_Id := Get_Attribute_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;
+
+   function Sem_Scalar_Type_Attribute (Attr : Iir_Attribute_Name)
+     return Iir
+   is
+      use Std_Names;
+      Prefix_Name : Iir;
+      Prefix : Iir;
+      Prefix_Type : Iir;
+      Res : Iir;
+      Id : Name_Id;
+   begin
+      Id := Get_Attribute_Identifier (Attr);
+      Prefix_Name := Get_Prefix (Attr);
+      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_Kinds_Type_Declaration
+           | Iir_Kind_Base_Attribute =>
+            null;
+         when others =>
+            Error_Msg_Sem ("prefix of '" & Name_Table.Image (Id)
+                           & " attribute must be a type", Attr);
+            return Error_Mark;
+      end case;
+      Prefix_Type := Get_Type (Prefix);
+      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_Attribute_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);
+
+      case Get_Attribute_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;
+
+   --  Sem attributes whose prefix is a type or a subtype.
+   function Sem_Predefined_Type_Attribute (Attr : Iir_Attribute_Name)
+     return Iir
+   is
+      use Std_Names;
+      Res : Iir;
+      Prefix : Iir;
+      Prefix_Type : Iir;
+   begin
+      case Get_Attribute_Identifier (Attr) 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 =>
+            raise Internal_Error;
+      end case;
+      Location_Copy (Res, Attr);
+      Prefix := Get_Named_Entity (Get_Prefix (Attr));
+      Set_Prefix (Res, Prefix);
+      Prefix_Type := Get_Type (Prefix);
+      case Get_Attribute_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;
+      Set_Expr_Staticness (Res, Get_Type_Staticness (Prefix_Type));
+      return Res;
+   end Sem_Predefined_Type_Attribute;
+
+   --  Called for attributes Length, Left, Right, High, Low, Range,
+   --  Reverse_Range, Ascending.
+   function Sem_Array_Attribute (Attr : Iir_Attribute_Name) return Iir
+   is
+      use Std_Names;
+      Prefix: Iir;
+      Prefix_Type : Iir;
+      Res : Iir;
+   begin
+      Prefix := Get_Named_Entity (Get_Prefix (Attr));
+
+      --  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_Array_Subtype_Definition =>
+--             Prefix_Type := Prefix;
+--          when Iir_Kind_Array_Type_Definition =>
+--             Error_Type;
+--             return Null_Iir;
+         when Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Base_Attribute =>
+            Prefix_Type := Get_Type (Prefix);
+            if Get_Kind (Prefix_Type)
+              in Iir_Kinds_Unconstrained_Array_Type_Definition
+            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_Process_Statement =>
+            Error_Msg_Sem
+              (Disp_Node (Prefix) & " is not an appropriate attribute prefix",
+               Attr);
+            return Error_Mark;
+         when others =>
+            Error_Kind ("sem_array_attribute", Prefix);
+      end case;
+
+      case Get_Kind (Prefix_Type) is
+         when Iir_Kinds_Scalar_Type_Definition =>
+            --  FIXME: check 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_Attribute_Identifier (Attr))
+               & " attribute must denote a constrained array subtype",
+               Attr);
+            return Error_Mark;
+      end case;
+
+      case Get_Attribute_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);
+            Set_Type (Res, Convertible_Integer_Type_Definition);
+         when Name_Ascending =>
+            Res := Create_Iir (Iir_Kind_Ascending_Array_Attribute);
+            Set_Type (Res, Boolean_Type_Definition);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Location_Copy (Res, Attr);
+      Set_Prefix (Res, Prefix);
+      return Res;
+   end Sem_Array_Attribute;
+
+   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);
+--       Param := Get_Suffix (Attr);
+--       if Param /= Null_Iir then
+--          if Kind = Iir_Kind_Transaction_Attribute then
+--             Error_Msg_Sem ("'transaction does not allow a parameter", Attr);
+--             Param := Null_Iir;
+--          else
+--             Param := Sem_Expression
+--               (Param, Time_Subtype_Definition);
+--             Set_Parameter (Res, Param);
+--          end if;
+--       end if;
+      if Get_Kind (Prefix) = Iir_Kind_Signal_Interface_Declaration then
+         case Get_Kind (Get_Parent (Prefix)) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               Error_Msg_Sem
+                 ("'" & Name_Table.Image (Get_Attribute_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_Base_Name (Prefix);
+      case Get_Kind (Base) is
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kinds_Signal_Attribute =>
+            null;
+         when others =>
+            Error_Msg_Sem
+              ("prefix of '"
+               & Name_Table.Image (Get_Attribute_Identifier (Attr))
+               & " attribute must denote a signal", Attr);
+            return Error_Mark;
+      end case;
+      case Get_Attribute_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_Signal_Interface_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: Iir;
+      Res : Iir;
+   begin
+      Prefix := Get_Named_Entity (Get_Prefix (Attr));
+      --  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_Variable_Interface_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_Kind_Design_Unit
+           | Iir_Kind_Non_Object_Alias_Declaration =>
+            null;
+
+         when Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_Constant_Interface_Declaration =>
+            if Get_Attribute_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_Attribute_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);
+            Set_Type (Res, Create_Unidim_Array_By_Length
+                      (String_Type_Definition,
+                       Iir_Int64 (Name_Table.Name_Length),
+                       Attr));
+            Set_Expr_Staticness (Res, Locally);
+
+         when Name_Path_Name =>
+            Res := Create_Iir (Iir_Kind_Path_Name_Attribute);
+            Set_Expr_Staticness (Res, Globally);
+            Set_Type (Res, String_Type_Definition);
+
+         when Name_Instance_Name =>
+            Res := Create_Iir (Iir_Kind_Instance_Name_Attribute);
+            Set_Expr_Staticness (Res, Globally);
+            Set_Type (Res, String_Type_Definition);
+
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Location_Copy (Res, Attr);
+      Set_Prefix (Res, Prefix);
+      return Res;
+   end Sem_Name_Attribute;
+
+   procedure Sem_Attribute (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_Attribute_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_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
+         Error_Msg_Sem ("prefix of attribute is overloaded", Attr);
+         Set_Named_Entity (Attr, Error_Mark);
+         return;
+      end if;
+
+      case Get_Attribute_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 (Attr);
+
+         when Name_Ascending =>
+            if Flags.Vhdl_Std > Vhdl_87 then
+               Res := Sem_Array_Attribute (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", Attr);
+      end if;
+      Set_Named_Entity (Attr, Res);
+   end Sem_Attribute;
+
+   --  LRM93 §6
+   procedure Sem_Name (Name : Iir; Keep_Alias : Boolean)
+   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, Keep_Alias, 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);
+         when others =>
+            Error_Kind ("sem_name", Name);
+      end case;
+   end Sem_Name;
+
+   --  Finish semantisation of NAME, if necessary.
+   procedure Maybe_Finish_Sem_Name (Name : Iir)
+   is
+      Expr : Iir;
+   begin
+      Expr := Get_Named_Entity (Name);
+      case Get_Kind (Expr) is
+         when Iir_Kind_Error =>
+            null;
+         when Iir_Kinds_Object_Declaration =>
+            Sem_Check_Pure (Name, Expr);
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference =>
+            declare
+               E : Iir;
+            begin
+               --  Get over implicit and explicit dereferences.
+               E := Expr;
+               loop
+                  E := Get_Base_Name (E);
+                  if Get_Kind (E) in Iir_Kinds_Dereference then
+                     E := Get_Prefix (E);
+                  else
+                     exit;
+                  end if;
+               end loop;
+               Sem_Check_Pure (Name, E);
+            end;
+         when Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Unit_Declaration =>
+            null;
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            null;
+         when Iir_Kind_Function_Call
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Type_Conversion =>
+            null;
+         when Iir_Kinds_Type_Attribute =>
+            null;
+         when 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_Transaction_Attribute
+           | Iir_Kind_Driving_Attribute
+           | Iir_Kind_Driving_Value_Attribute =>
+            null;
+         when Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute =>
+            null;
+         when Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Delayed_Attribute =>
+            if Get_Parameter (Expr) = Null_Iir then
+               Finish_Sem_Signal_Attribute (Expr, Null_Iir);
+            end if;
+         when Iir_Kinds_Array_Attribute =>
+            if Get_Parameter (Expr) = Null_Iir then
+               Finish_Sem_Array_Attribute (Expr, Null_Iir);
+            end if;
+         when Iir_Kinds_Scalar_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute =>
+            if Get_Parameter (Expr) = Null_Iir then
+               Finish_Sem_Scalar_Type_Attribute (Expr, Null_Iir);
+            end if;
+         when Iir_Kind_Implicit_Dereference =>
+            --  Should not happen.
+            raise Internal_Error;
+         when Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Function_Declaration =>
+            Finish_Sem_Function_Specification (Name, Expr);
+         when others =>
+            Error_Kind ("maybe_finish_sem_name", Expr);
+      end case;
+   end Maybe_Finish_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, 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) = 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
+         Maybe_Finish_Sem_Name (Name);
+         Expr := Get_Named_Entity (Name);
+         if Expr = Null_Iir then
+            return Null_Iir;
+         end if;
+         if A_Type /= Null_Iir then
+            Res_Type := Get_Type (Expr);
+            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 (Expr, 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);
+               return Null_Iir;
+            else
+               Sem_Name_Free_Result (Expr, Res);
+               Set_Named_Entity (Name, Res);
+               Finish_Sem_Name (Name, Res);
+               Maybe_Finish_Sem_Name (Name);
+               Expr := Get_Named_Entity (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 EXPR.
+      Xref_Name (Name);
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            --Set_Base_Name (Name, Get_Base_Name (Expr));
+            Set_Type (Name, Get_Type (Expr));
+            Set_Expr_Staticness (Name, Get_Expr_Staticness (Expr));
+            --Set_Name_Staticness (Name, Get_Name_Staticness (Expr));
+            return Name;
+         when Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Attribute_Name
+           | Iir_Kind_Selected_By_All_Name =>
+            Free_Iir (Name);
+            return Expr;
+         when others =>
+            Error_Kind ("name_to_expression", Name);
+      end case;
+   end Name_To_Expression;
+
+   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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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 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_Constant_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_File_Interface_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;
+
+   -- Find a uniq declaration for a name.
+   function Find_Declaration (Name: Iir; Kind: Decl_Kind_Type)
+     return Iir
+   is
+      procedure Error (Res : Iir; Str : String)
+      is
+      begin
+         Error_Msg_Sem (Str & " expected, found " & Disp_Node (Res), Name);
+      end Error;
+
+      function Check_Kind (Res: Iir; Kind : Iir_Kind; Str: String)
+        return Iir
+      is
+         Res_Kind : Iir_Kind;
+      begin
+         Res_Kind := Get_Kind (Res);
+         if Res_Kind /= Kind then
+            Error (Res, Str);
+            return Null_Iir;
+         else
+            return Res;
+         end if;
+      end Check_Kind;
+
+      function Check_Kind_Unit (Res: Iir; Kind : Iir_Kind; Str: String)
+        return Iir
+      is
+         Res_Kind : Iir_Kind;
+      begin
+         if Get_Kind (Res) /= Iir_Kind_Design_Unit then
+            Error (Res, Str);
+            return Null_Iir;
+         end if;
+
+         Res_Kind := Get_Kind (Get_Library_Unit (Res));
+         if Res_Kind /= Kind then
+            Error (Res, Str);
+            return Null_Iir;
+         else
+            return Res;
+         end if;
+      end Check_Kind_Unit;
+
+      Res: Iir;
+   begin
+      Sem_Name (Name, False);
+      Res := Get_Named_Entity (Name);
+
+      if Res = Error_Mark then
+         --  A message must have been displayed.
+         --  FIXME: is it the case for find_selected_declarations ???
+         --  Error_Msg_Sem ("identifier is not defined", Name);
+         return Null_Iir;
+      end if;
+
+      Xref_Name (Name);
+
+      case Kind is
+         when Decl_Type
+           | Decl_Incomplete_Type =>
+            case Get_Kind (Res) is
+               when Iir_Kind_Type_Declaration
+                 | Iir_Kind_Subtype_Declaration =>
+                  Res := Get_Type (Res);
+                  --  Note: RES cannot be NULL_IIR, this is just to be more
+                  --  bullet-proof.
+                  if Kind /= Decl_Incomplete_Type
+                    and then
+                    (Res = Null_Iir or else
+                     Get_Kind (Res) = Iir_Kind_Incomplete_Type_Definition)
+                  then
+                     Error_Msg_Sem
+                       ("invalid use of an incomplete type definition", Name);
+                  end if;
+               when others =>
+                  Error_Msg_Sem
+                    ("type expected, found " & Disp_Node (Res), Name);
+                  return Null_Iir;
+            end case;
+         when Decl_Component =>
+            Res := Check_Kind (Res, Iir_Kind_Component_Declaration,
+                               "component");
+         when Decl_Unit =>
+            null;
+         when Decl_Label =>
+            null;
+         when Decl_Entity =>
+            Res := Check_Kind_Unit
+              (Res, Iir_Kind_Entity_Declaration, "entity");
+         when Decl_Configuration =>
+            Res := Check_Kind_Unit (Res, Iir_Kind_Configuration_Declaration,
+                                    "configuration");
+         when Decl_Group_Template =>
+            Res := Check_Kind (Res, Iir_Kind_Group_Template_Declaration,
+                               "group template");
+         when Decl_Attribute =>
+            Res := Check_Kind (Res, Iir_Kind_Attribute_Declaration,
+                               "attribute");
+      end case;
+      return Res;
+   end Find_Declaration;
+end Sem_Names;
diff --git a/sem_names.ads b/sem_names.ads
new file mode 100644
index 000000000..eb50ec2de
--- /dev/null
+++ b/sem_names.ads
@@ -0,0 +1,113 @@
+--  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 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 Sem_Names is
+   --  Semantize NAME as long as it consists in named entities.
+   --  Set Named_Entity field of NAME, with:
+   --  * the named entity (if any)
+   --  * an overload_list of named entity
+   --  * error_mark (in case of error, the message error is displayed).
+   procedure Sem_Name (Name : Iir; Keep_Alias : Boolean);
+
+   --  Finish semantisation of NAME, if necessary.
+   procedure Maybe_Finish_Sem_Name (Name : 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.
+   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 AN_IIR is an overload list.
+   function Is_Overload_List (An_Iir: Iir) return Boolean;
+   pragma Inline (Is_Overload_List);
+
+   -- Create an overload list.
+   -- must be destroyed with free_iir.
+   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);
+
+   procedure Error_Overload (Expr: Iir);
+
+   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;
+
+   --  Return TRUE iff TYPE1 and TYPE2 are closely related.
+   function Are_Types_Closely_Related (Type1, Type2 : Iir) return Boolean;
+
+   --  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 EXPR 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;
+
+   --  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;
+
+   --  Return TRUE if NAME is a name that designate an object.
+   --  Only in this case, base_name is defined.
+   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;
+
+   --  Kind of declaration to find.
+   --  Decl_entity: an entity declaration (used for binding_indication).
+   --  Decl_Any : no checks is performed.
+
+   type Decl_Kind_Type is
+     (Decl_Type, Decl_Incomplete_Type,
+      Decl_Component, Decl_Unit, Decl_Label,
+      Decl_Group_Template, Decl_Entity, Decl_Configuration, Decl_Attribute);
+
+   --  Find a uniq declaration for name NAME, which can be a simple_name,
+   --  an identifier or a selected_name.
+   --  Disp an error message if:
+   --   NAME (or any prefix of it) is undefined
+   --   NAME is overloaded
+   --   NAME does not belong to KIND.
+   --  In these case, null_iir  is returned.
+   --  Otherwise, the declaration is returned, and NAME is freed.
+   --  If NAME is a selected_name, dependencies can be added to the current
+   --  design unit.
+   function Find_Declaration (Name: Iir; Kind: Decl_Kind_Type) return Iir;
+end Sem_Names;
diff --git a/sem_scopes.adb b/sem_scopes.adb
new file mode 100644
index 000000000..fe4bcc77d
--- /dev/null
+++ b/sem_scopes.adb
@@ -0,0 +1,1260 @@
+--  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 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;
+with Types; use Types;
+with Name_Table; -- use Name_Table;
+with Errorout; use Errorout;
+with 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_Visible_Types;
+   pragma Unreferenced (Disp_Visible_Types);
+
+   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;
+
+   type Visible_Type_Cell is record
+      Id: Name_Id;
+      Decl: Iir;
+   end record;
+
+   package Visible_Types is new GNAT.Table
+     (Table_Component_Type => Visible_Type_Cell,
+      Table_Index_Type => Visible_Type_Index_Type,
+      Table_Low_Bound => No_Visible_Type_Index + 1,
+      Table_Initial => 32,
+      Table_Increment => 10);
+
+   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;
+   Current_Composite_Types_Start : Visible_Type_Index_Type :=
+     No_Visible_Type_Index;
+
+   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 => Name_Id (Visible_Types.Last));
+      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;
+               Visible_Types.Set_Last
+                 (Visible_Type_Index_Type (Scopes.Table (Scopes.Last).Id));
+               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 Get_Non_Alias_Declaration (Ni: Name_Interpretation_Type)
+                                      return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Get_Declaration (Ni);
+      if Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then
+         Res := Get_Name (Res);
+      end if;
+      return Res;
+   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 => Name_Id (Current_Composite_Types_Start));
+
+      -- Start a completly new scope.
+      Current_Scope_Start := Interpretations.Last + 1;
+
+      -- Keep the last barrier.
+      Current_Barrier := Scopes.Last + 1;
+      Current_Composite_Types_Start := Visible_Types.Last;
+
+      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);
+      Current_Composite_Types_Start :=
+        Visible_Type_Index_Type (Scopes.Table (Scopes.Last).Id);
+      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_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 DECL declare a type that is visible.
+   --  This is used to build the list of visible types, ie types that must
+   --  be considered for certains expression: access for NULL literals,
+   --  arrays and records for aggregates, arrays for string literals.
+--    function Is_Visible_Type (Decl: Iir) return Boolean
+--    is
+--       Def: Iir;
+--    begin
+--       case Get_Kind (Decl) is
+--          when Iir_Kind_Array_Type_Definition
+--            | Iir_Kind_Array_Subtype_Definition =>
+--             raise Internal_Error;
+--          when Iir_Kind_Type_Declaration =>
+--             Def := Get_Type (Decl);
+--          when others =>
+--             return False;
+--       end case;
+--       case Get_Kind (Def) is
+--          when Iir_Kind_Array_Type_Definition
+--            | Iir_Kind_Array_Subtype_Definition =>
+--             return True;
+--          when Iir_Kind_Record_Type_Definition =>
+--             return True;
+--          when Iir_Kind_Access_Type_Definition
+--            | Iir_Kind_Access_Subtype_Definition =>
+--             return True;
+--          when others =>
+--             return False;
+--       end case;
+--    end Is_Visible_Type;
+
+   function Get_Visible_Type (Vt: Visible_Type_Index_Type)
+     return Visible_Type_Index_Type
+   is
+      Pt: Visible_Type_Index_Type := Vt;
+   begin
+      if True then
+         return Pt;
+      else
+         while Pt > Current_Composite_Types_Start loop
+            if Get_Declaration
+              (Get_Interpretation (Visible_Types.Table (Pt).Id))
+              = Visible_Types.Table (Pt).Decl
+            then
+               return Pt;
+            end if;
+            Pt := Pt - 1;
+         end loop;
+         return No_Visible_Type_Index;
+      end if;
+   end Get_Visible_Type;
+
+   -- Get the first visible declaration of unidim array.
+   function Get_First_Visible_Type return Visible_Type_Index_Type is
+   begin
+      return Get_Visible_Type (Visible_Types.Last);
+   end Get_First_Visible_Type;
+
+   -- Get the next visible declaration of unidim array in the list.
+   function Get_Next_Visible_Type (Index: Visible_Type_Index_Type)
+     return Visible_Type_Index_Type is
+   begin
+      return Get_Visible_Type (Index - 1);
+   end Get_Next_Visible_Type;
+
+   -- Get the declaration corresponding to an uni_array_visible_type.
+   function Get_Visible_Type_Decl (Index : Visible_Type_Index_Type)
+     return Iir is
+   begin
+      return Visible_Types.Table (Index).Decl;
+   end Get_Visible_Type_Decl;
+
+   -- 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;
+
+   procedure Add_Visible_Type (Decl : Iir) is
+   begin
+      Visible_Types.Append ((Id => Get_Identifier (Decl), Decl => Decl));
+   end Add_Visible_Type;
+
+   -- 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;
+
+      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;
+
+      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 hide, no overloading.
+         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
+         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:
+      --  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.
+
+         --  LRM 10.3
+         --  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;
+
+            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;
+
+            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
+               if Get_Kind (D) = Iir_Kind_Non_Object_Alias_Declaration then
+                  return Get_Subprogram_Hash (Get_Name (D));
+               else
+                  return Get_Subprogram_Hash (D);
+               end if;
+            end Get_Hash_Non_Alias;
+
+            Decl_Hash : Iir_Int32;
+            Hash : Iir_Int32;
+         begin
+            Decl_Hash := Get_Hash_Non_Alias (Decl);
+            if Decl_Hash = 0 then
+               raise Internal_Error;
+            end if;
+
+            --  Find an homograph of this declaration.
+            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 Iirs_Utils.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;
+            else
+               --  There is an homograph.
+               if Potentially then
+                  --  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.
+                  if Is_In_Current_Declarative_Region (Homograph) then
+                     if not Is_Potentially_Visible (Homograph) then
+                        return;
+                     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 LRM.
+                     if Get_Parent (Decl) = Get_Parent (Current_Decl) then
+                        --  Note: no need to save previous interpretation!
+                        Add_New_Interpretation;
+                        Hide_Homograph;
+                        return;
+                     end if;
+
+                     --  The homograph is potentially visible and was declared
+                     --  in a scope different from the DECL scope.
+                     --  (ie, it was certainly made visible by another use
+                     --   clause).
+                     Add_New_Interpretation;
+                     return;
+                  else
+                     --  The homograph was made visible in an outer declarative
+                     --  region.  Therefore, it must not be hidden.
+                     Maybe_Save_And_Add_New_Interpretation;
+                  end if;
+               else
+                  if not Is_Potentially_Visible (Homograph) then
+                     if Is_In_Current_Declarative_Region (Homograph) then
+                        if Get_Kind (Current_Decl)
+                          /= Iir_Kind_Implicit_Function_Declaration
+                          and then
+                          Get_Kind (Current_Decl)
+                          /= Iir_Kind_Implicit_Procedure_Declaration
+                        then
+                           Error_Msg_Sem
+                             ("redeclaration of " & Disp_Node (Current_Decl)
+                              & " defined at " & Disp_Location (Current_Decl),
+                              Decl);
+                           return;
+                        end if;
+                     else
+                        --  Overload.
+                        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.
+                     null;
+                  end if;
+                  Maybe_Save_And_Add_New_Interpretation;
+
+                  Hide_Homograph;
+                  return;
+               end if;
+            end if;
+         end;
+         return;
+      end if;
+
+      -- The current interpretation and the new one are homograph.
+      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, item #2
+               -- 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;
+               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);
+      if Get_Declaration (Inter) /= Old then
+         raise Internal_Error;
+      end if;
+      if Get_Next_Interpretation (Inter) /= No_Name_Interpretation then
+         raise Internal_Error;
+      end if;
+      Interpretations.Table (Inter).Decl := Decl;
+   end Replace_Name;
+
+   procedure Name_Visible (Ident : Name_Id; Decl : Iir)
+   is
+      pragma Unreferenced (Ident);
+   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 Name_Visible (Decl : Iir) is
+   begin
+      Name_Visible (Get_Identifier (Decl), Decl);
+   end Name_Visible;
+
+   procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type)
+   is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kinds_Procedure_Declaration
+           | Iir_Kinds_Function_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | 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_Constant_Interface_Declaration
+           | Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_File_Interface_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kinds_Concurrent_Statement
+           | Iir_Kinds_Sequential_Statement =>
+            Handle_Decl (Decl, Arg);
+         when Iir_Kind_Type_Declaration =>
+            declare
+               Def : Iir;
+               List : Iir_List;
+               El : Iir;
+            begin
+               Def := Get_Type (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 (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_Design_Unit =>
+            Handle_Decl (Decl, Arg);
+
+         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 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_Type_Declaration =>
+            Add_Name (Decl, Get_Identifier (Decl), Potentially);
+            Add_Visible_Type (Decl);
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            Add_Visible_Type (Decl);
+         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 is new Iterator_Decl_Chain
+     (Arg_Type => Boolean, Handle_Decl => Add_Declaration);
+
+   procedure Add_Declarations_List is new Iterator_Decl_List
+     (Arg_Type => Boolean, Handle_Decl => Add_Declaration);
+
+   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
+      if Get_Kind (Name) = Iir_Kind_Overload_List then
+         Add_Declarations_List (Get_Overload_List (Name), True);
+      else
+         Add_Declaration (Name, True);
+      end if;
+   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_Design_Unit =>
+            --  The design unit is a package.
+            Add_Declarations
+              (Get_Declaration_Chain (Get_Library_Unit (Name)), True);
+         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;
+
+   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.
+   -- This is needed when a package body is analysed.
+   procedure Add_Package_Declarations (Decl: Iir_Package_Declaration) is
+   begin
+      Add_Declarations (Get_Declaration_Chain (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_Declaration =>
+            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;
+
+   -- Debugging
+   procedure Disp_Visible_Types
+   is
+      use Ada.Text_IO;
+      Index: Visible_Type_Index_Type;
+   begin
+      Index := Get_First_Visible_Type;
+      while Index /= No_Visible_Type_Index loop
+         Put_Line (Disp_Node (Get_Visible_Type_Decl (Index)));
+         Index := Get_Next_Visible_Type (Index);
+      end loop;
+   end Disp_Visible_Types;
+
+   procedure Disp_Detailed_Interpretations (Ident : Name_Id)
+   is
+      use Ada.Text_IO;
+      use Name_Table;
+      procedure Disp_Type (Str : String; Node : Iir) is
+      begin
+         Put (Str);
+         Put_Line
+           (Image (Get_Identifier (Get_Type_Declarator (Node))));
+      end Disp_Type;
+
+      Inter: Name_Interpretation_Type;
+      Decl : Iir;
+   begin
+      Put (Name_Table.Image (Ident));
+      Put_Line (":");
+
+      Inter := Get_Interpretation (Ident);
+      while Valid_Interpretation (Inter) loop
+         Decl := Get_Declaration (Inter);
+         Put (' ');
+         Put (Iir_Kind'Image (Get_Kind (Decl)));
+         Put_Line (", loc: " & Get_Location_Str (Get_Location (Decl)));
+         case Get_Kind (Decl) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Implicit_Function_Declaration =>
+               Disp_Type ("  return type: ", Get_Return_Type (Decl));
+               null;
+            when others =>
+               null;
+         end case;
+         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/sem_scopes.ads b/sem_scopes.ads
new file mode 100644
index 000000000..d4792046f
--- /dev/null
+++ b/sem_scopes.ads
@@ -0,0 +1,239 @@
+--  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 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 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 interpretation DECL for ID to the current declarative region.
+   -- ID is an identifier or a character literal.
+   -- Note: ID may be different from get_identifier (DECL), since for example
+   --  DECL may be a type definition.
+   procedure Add_Name (Decl: Iir);
+   pragma Inline (Add_Name);
+
+   -- 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);
+
+   --  Set the visible_flag of DECL to true.
+   procedure Name_Visible (Decl : Iir);
+
+   --  Add DECL is the list of visible types.
+   procedure Add_Visible_Type (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 is necessary 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.
+   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.
+   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 declaration of interface chain CHAIN into the current
+   --  declarative region.
+   procedure Add_Declarations_From_Interface_Chain (Chain : Iir);
+
+   --  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);
+
+   -- It is necessary to keep trace of all visible type definition of
+   -- arrays, record and access.  This is used by string, bit string, aggregate
+   -- and null literal.
+   -- This is for the user a simple linked list.
+
+   -- list element type.
+   type Visible_Type_Index_Type is private;
+
+   -- End of the list element.
+   No_Visible_Type_Index: constant Visible_Type_Index_Type;
+
+   -- Get the first visible type declaration.
+   function Get_First_Visible_Type return Visible_Type_Index_Type;
+   pragma Inline (Get_First_Visible_Type);
+
+   -- Get the visible type declaration after INDEX.
+   function Get_Next_Visible_Type (Index: Visible_Type_Index_Type)
+     return Visible_Type_Index_Type;
+   pragma Inline (Get_Next_Visible_Type);
+
+   -- Get the declaration corresponding to INDEX.
+   function Get_Visible_Type_Decl (Index: Visible_Type_Index_Type)
+     return Iir;
+   pragma Inline (Get_Visible_Type_Decl);
+
+   --  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;
+
+   type Visible_Type_Index_Type is new Nat32;
+   No_Visible_Type_Index: constant Visible_Type_Index_Type := 0;
+end Sem_Scopes;
diff --git a/sem_specs.adb b/sem_specs.adb
new file mode 100644
index 000000000..9365e6bf3
--- /dev/null
+++ b/sem_specs.adb
@@ -0,0 +1,1636 @@
+--  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 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 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 Tokens;
+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 Sem_Types;
+with Flags;
+with Name_Table;
+with Std_Names;
+with Sem_Decls;
+with Xrefs; use Xrefs;
+with Back_End;
+
+package body Sem_Specs is
+   --  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_Type_Mark (Atype) = Null_Iir then
+            raise Internal_Error;
+         end if;
+         return Get_Type_Mark (Atype) = Type_Mark;
+      else
+         return Atype = Type_Mark;
+      end if;
+   end Is_Same_Type_Mark;
+
+   function Get_Entity_Class_Kind (Decl : Iir) return Tokens.Token_Type
+   is
+      use Tokens;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Design_Unit =>
+            case Get_Kind (Get_Library_Unit (Decl)) is
+               when Iir_Kind_Entity_Declaration =>
+                  return Tok_Entity;
+               when Iir_Kind_Architecture_Declaration =>
+                  return Tok_Architecture;
+               when Iir_Kind_Configuration_Declaration =>
+                  return Tok_Configuration;
+               when Iir_Kind_Package_Declaration =>
+                  return Tok_Package;
+               when others =>
+                  Error_Kind ("get_entity_class_kind(unit)", Decl);
+            end case;
+         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_Constant_Interface_Declaration =>
+            return Tok_Constant;
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Signal_Interface_Declaration =>
+            return Tok_Signal;
+         when Iir_Kind_Variable_Declaration
+           | Iir_Kind_Variable_Interface_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_File_Interface_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;
+      Name : Iir;
+      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 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_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 : Iir_Attribute_Declaration;
+         begin
+            El_Attr := Get_Attribute_Designator
+              (Get_Attribute_Specification (El));
+            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 Name /= Null_Iir then
+         Xref_Ref (Name, Decl);
+      end if;
+
+      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
+         declare
+            use Back_End;
+            Decl1 : Iir;
+         begin
+            --  LRM93 12.4
+            --  The 'FOREIGN attribute may be associated only with
+            --  architectures or with subprograms.
+            case Get_Entity_Class (Attr) is
+               when Tok_Architecture =>
+                  Decl1 := Get_Library_Unit (Decl);
+
+               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.
+                  Decl1 := Decl;
+
+               when others =>
+                  Error_Msg_Sem
+                    ("'FOREIGN allowed only for architectures and subprograms",
+                     Attr);
+                  return;
+            end case;
+
+            Set_Foreign_Flag (Decl1, True);
+            if Back_End.Sem_Foreign /= null then
+               Back_End.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;
+
+      procedure Sem_Named_Entity1 (Ent : Iir; Decl : Iir)
+      is
+         Ent_Id : Name_Id;
+      begin
+         Ent_Id := Get_Identifier (Ent);
+         if (Name = Null_Iir or else Ent_Id = Get_Identifier (Name))
+           and then Ent_Id /= Null_Identifier
+         then
+            if Get_Visible_Flag (Ent) = False then
+               Error_Msg_Sem
+                 (Disp_Node (Ent) & " is not yet visible", Attr);
+            else
+               Attribute_A_Decl
+                 (Decl, Attr, Name, Is_Designators, Check_Defined);
+               Res := True;
+            end if;
+         end if;
+      end Sem_Named_Entity1;
+
+      procedure Sem_Named_Entity (Ent : Iir) is
+      begin
+         case Get_Kind (Ent) is
+            when Iir_Kind_Design_Unit
+              | Iir_Kinds_Concurrent_Statement
+              | Iir_Kinds_Function_Declaration
+              | Iir_Kinds_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 =>
+               Sem_Named_Entity1 (Ent, Ent);
+            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 : Iir;
+               begin
+                  Decl := Get_Name (Ent);
+                  if Get_Base_Name (Decl) /= Decl then
+                     Error_Msg_Sem
+                       (Disp_Node (Ent) & " does not denote the entire object",
+                        Attr);
+                     return;
+                  end if;
+                  Sem_Named_Entity1 (Ent, Decl);
+               end;
+            when Iir_Kind_Non_Object_Alias_Declaration =>
+               Sem_Named_Entity1 (Ent, 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 (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 (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 (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_Declaration
+              | Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Package_Declaration =>
+               Sem_Named_Entity (Get_Design_Unit (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 : Iir;
+               begin
+                  Header := Get_Block_Header (Scope);
+                  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_Declaration
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            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
+      Inter : Name_Interpretation_Type;
+      List : Iir_List;
+      Ov_List : Iir_Overload_List;
+      Name : Iir;
+   begin
+      List := Create_Iir_List;
+      Inter := Get_Interpretation (Get_Identifier (Get_Name (Sig)));
+      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;
+      Ov_List := Create_Overload_List (List);
+      Name := Sem_Decls.Sem_Signature (Ov_List, Sig);
+      Destroy_Iir_List (List);
+      Free_Iir (Ov_List);
+      if Name = Null_Iir then
+         return;
+      end if;
+      Attribute_A_Decl (Name, Attr, Get_Name (Sig), True, True);
+   end Sem_Signature_Entity_Designator;
+
+   procedure Sem_Attribute_Specification
+     (Spec : Iir_Attribute_Specification;
+      Scope : Iir)
+   is
+      use Tokens;
+
+      Name : Iir_Attribute_Declaration;
+      List : Iir_List;
+      Expr : Iir;
+      Res : Boolean;
+   begin
+      --  LRM93 5.1
+      --  The attribute designator must denote an attribute.
+      Name := Find_Declaration (Get_Attribute_Designator (Spec),
+                                Decl_Attribute);
+      if Name = Null_Iir then
+         return;
+      end if;
+
+      Set_Attribute_Designator (Spec, Name);
+
+      --  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 (Name));
+      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;
+
+   --  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.
+   --
+   --  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.
+   procedure Check_Post_Attribute_Specification
+     (Attr_Spec_Chain : Iir; Decl : Iir)
+   is
+      use Tokens;
+
+      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 =>
+            return;
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            --  A physical type definition declares units.
+            if Get_Kind (Get_Type (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 (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
+         Ent_Class := Get_Entity_Class (Spec);
+         if Ent_Class = Decl_Class or Ent_Class = Decl_Class2 then
+            if Get_Kind (Decl) = Iir_Kind_Attribute_Specification then
+               Error_Msg_Sem
+                 ("no attribute specification may follow an all/others spec",
+                  Decl);
+            else
+               Error_Msg_Sem
+                 ("no named entity may follow an all/others attribute "
+                  & "specification", Decl);
+            end if;
+            Error_Msg_Sem
+              ("(previous all/others specification for the given "
+               &"entity class)", Spec);
+         end if;
+         Spec := Get_Attribute_Specification_Chain (Spec);
+      end loop;
+   end Check_Post_Attribute_Specification;
+
+   procedure Sem_Disconnect_Specification
+     (Dis : Iir_Disconnection_Specification)
+   is
+      Atype : Iir;
+      Time_Expr : Iir;
+      List : Iir_List;
+      El : Iir;
+      Sig : Iir;
+      Prefix : Iir;
+   begin
+      --  Sem type mark.
+      Atype := Get_Type (Dis);
+      Atype := Sem_Types.Sem_Subtype_Indication (Atype);
+      if Atype /= Null_Iir then
+         Set_Type (Dis, Atype);
+      end if;
+
+      --  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, False);
+
+            Sig := Get_Named_Entity (El);
+            Sig := Name_To_Object (Sig);
+            if Sig /= Null_Iir then
+               Set_Type (El, Get_Type (Sig));
+               Prefix := Get_Base_Name (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_Signal_Interface_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 sugnal 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_Disconnect_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
+      Entity : Iir;
+      New_Entity : Iir;
+      Conf : Iir;
+      Arch : Iir;
+      Arch_Unit : Iir;
+   begin
+      case Get_Kind (Aspect) is
+         when Iir_Kind_Entity_Aspect_Entity =>
+            Entity := Get_Entity (Aspect);
+            New_Entity := Find_Declaration (Entity, Decl_Entity);
+            if New_Entity = Null_Iir then
+               return Null_Iir;
+            end if;
+            Set_Entity (Aspect, New_Entity);
+
+            --  Check architecture.
+            Arch := Get_Architecture (Aspect);
+            if Arch /= Null_Iir then
+               Arch_Unit := Libraries.Find_Secondary_Unit
+                 (New_Entity, Get_Identifier (Arch));
+               if Arch_Unit /= Null_Iir then
+                  Xref_Ref (Arch, Arch_Unit);
+               end if;
+
+               --  FIXME: may emit a warning if the architecture does not
+               --  exists.
+               --  Note: the design needs the architecture.
+               Add_Dependence (Aspect);
+            end if;
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Conf := Get_Configuration (Aspect);
+            Conf := Find_Declaration (Conf, Decl_Configuration);
+            if Conf = Null_Iir then
+               return Null_Iir;
+            end if;
+
+            Set_Configuration (Aspect, Conf);
+
+            Libraries.Load_Design_Unit (Conf, Aspect);
+            New_Entity := Get_Entity (Get_Library_Unit (Conf));
+         when Iir_Kind_Entity_Aspect_Open =>
+            return Null_Iir;
+         when others =>
+            Error_Kind ("sem_entity_aspect", Aspect);
+      end case;
+      Libraries.Load_Design_Unit (New_Entity, Aspect);
+      return Get_Library_Unit (New_Entity);
+   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;
+         return;
+      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_Library_Unit
+                          (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);
+         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 : Iir;
+         El : Iir;
+         Res : Boolean;
+      begin
+         Comp := Get_Component_Name (Spec);
+         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 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;
+      Inst : Iir;
+   begin
+      Primary_Entity_Aspect := Null_Iir;
+      Comp := Find_Declaration (Get_Component_Name (Spec), Decl_Component);
+      if Comp = Null_Iir then
+         return;
+      end if;
+      Set_Component_Name (Spec, Comp);
+
+      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
+               Comp := Get_Declaration (Inter);
+               if Get_Kind (Comp) /= Iir_Kind_Component_Instantiation_Statement
+               then
+                  Error_Msg_Sem
+                    ("label does not denote an instantiation", El);
+               else
+                  Inst := Get_Instantiated_Unit (Comp);
+                  if Get_Kind (Inst) /= Iir_Kind_Component_Declaration then
+                     Error_Msg_Sem
+                       ("specification does not apply to direct instantiation",
+                        El);
+                  elsif Inst /= Get_Component_Name (Spec) then
+                     Error_Msg_Sem ("component names mismatch", El);
+                  else
+                     Apply_Configuration_Specification
+                       (Comp, Spec, Primary_Entity_Aspect);
+                     Xref_Ref (El, Comp);
+                     Free_Iir (El);
+                     Replace_Nth_Element (List, I, Comp);
+                  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;
+   begin
+      Sem_Component_Specification (Parent_Stmts, Conf, Primary_Entity_Aspect);
+      --  Extend scope of component interface declaration.
+      Sem_Scopes.Open_Scope_Extension;
+      Sem_Scopes.Add_Component_Declarations (Get_Component_Name (Conf));
+      Sem_Binding_Indication (Get_Binding_Indication (Conf),
+                              Get_Component_Name (Conf),
+                              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;
+      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);
+      Set_Entity (Aspect, Design_Unit);
+      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 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 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.
+   type Map_Kind_String_Type is array (Map_Kind_Type) of String_Cst;
+   Map_Kind_Name : constant Map_Kind_String_Type :=
+     (Map_Generic => new String'("generic"),
+      Map_Port => new String'("port"));
+
+   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.
+      --  Just check there is no actuals.
+      if Ent_Chain = Null_Iir then
+         if Comp_Chain /= Null_Iir then
+            Error_Msg_Sem ("no " & Map_Kind_Name (Kind).all & "s of "
+                           & Disp_Node (Entity)
+                           & " to be associated with "
+                           & Map_Kind_Name (Kind).all
+                           & "s of " & Disp_Node (Comp), Parent);
+         end if;
+         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, Comp);
+         else
+            if not Are_Nodes_Compatible (Comp_El, Ent_El) then
+               Error_Msg_Sem
+                 ("type of "
+                  & Disp_Node (Comp_El) & " from " & Disp_Node (Comp)
+                  & " and "
+                  & Disp_Node (Ent_El) & " from " & Disp_Node (Entity)
+                  & " are not compatible for an association",
+                  Parent);
+               Error := True;
+            elsif Kind = Map_Port
+              and then
+              not Check_Port_Association_Restriction (Ent_El, Comp_El, Parent)
+            then
+               Error := True;
+            end if;
+            Assoc := Create_Iir (Iir_Kind_Association_Element_By_Expression);
+            Location_Copy (Assoc, Comp_El);
+            Set_Whole_Association_Flag (Assoc, True);
+            Set_Actual (Assoc, Comp_El);
+            Found := Found + 1;
+         end if;
+         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;
+
+      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 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/sem_specs.ads b/sem_specs.ads
new file mode 100644
index 000000000..ab02fb2c4
--- /dev/null
+++ b/sem_specs.ads
@@ -0,0 +1,82 @@
+--  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 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 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.
+   procedure Check_Post_Attribute_Specification
+     (Attr_Spec_Chain : Iir; Decl : Iir);
+
+   procedure Sem_Disconnect_Specification
+     (Dis : Iir_Disconnection_Specification);
+
+   procedure Sem_Configuration_Specification
+     (Parent_Stmts : Iir; Conf : Iir_Configuration_Specification);
+
+   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/sem_stmts.adb b/sem_stmts.adb
new file mode 100644
index 000000000..b0e5b3c86
--- /dev/null
+++ b/sem_stmts.adb
@@ -0,0 +1,1942 @@
+--  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 GCC; 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;
+with Sem_Specs; use Sem_Specs;
+with Sem; use Sem;
+with Sem_Decls; use Sem_Decls;
+with Sem_Expr; use Sem_Expr;
+with Std_Package; use Std_Package;
+with Sem_Names; use Sem_Names;
+with Sem_Scopes; use Sem_Scopes;
+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 (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 (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 (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;
+      end if;
+      return True;
+   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 (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_Base_Name (Target_Object);
+      Targ_Obj_Kind := Get_Kind (Target_Prefix);
+      case Targ_Obj_Kind is
+         when Iir_Kind_Signal_Interface_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 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_Signal_Interface_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_Base_Name (Target_Object);
+      case Get_Kind (Target_Prefix) is
+         when Iir_Kind_Variable_Interface_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);
+      Target := Sem_Expression (Target, Sig_Type);
+      if Target /= Null_Iir then
+         Set_Target (Stmt, Target);
+         Check_Target (Stmt, Target);
+      else
+         Ok := False;
+      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 type qualifier", 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
+               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.
+                  Expr := Eval_Static_Expr (Expr);
+                  Time := Get_Value (Expr);
+                  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;
+               Set_Time (We, Expr);
+            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);
+      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_Expression (Get_Expression (Stmt), Null_Iir);
+         if Expr = Null_Iir then
+            return;
+         end if;
+         Check_Read (Expr);
+         Set_Expression (Stmt, Expr);
+         Target_Type := Get_Type (Expr);
+      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
+         Error_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);
+         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_Expression (Expr, Boolean_Type_Definition);
+      Check_Read (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 : 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 indexsing 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, Loc, Low, High);
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            if not Is_Unidim_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;
+      Loc : Location_Type;
+   begin
+      Expr := Get_Expression (Stmt);
+      Loc := Get_Location (Expr);
+      -- FIXME: overload.
+      Expr := Sem_Expression (Expr, Null_Iir);
+      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 (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
+      for I in Natural loop
+         -- El is an iir_identifier.
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         Sem_Name (El, False);
+         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
+            Prefix := Get_Base_Name (Res);
+            case Get_Kind (Prefix) is
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Guard_Signal_Declaration
+                 | Iir_Kinds_Signal_Attribute =>
+                  Xref_Name (El);
+               when Iir_Kind_Signal_Interface_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;
+                  Xref_Name (El);
+               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 (El)
+                              & " 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_Expression (Expr, Boolean_Type_Definition);
+         Check_Read (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;
+      Label: Iir;
+      P : Iir;
+   begin
+      Cond := Get_Condition (Stmt);
+      if Cond /= Null_Iir then
+         Cond := Sem_Expression (Cond, Boolean_Type_Definition);
+         Check_Read (Cond);
+         Set_Condition (Stmt, Cond);
+      end if;
+      Label := Get_Loop (Stmt);
+      if Label /= Null_Iir then
+         Label := Find_Declaration (Label, Decl_Label);
+      end if;
+      if Label /= Null_Iir then
+         case Get_Kind (Label) is
+            when Iir_Kind_While_Loop_Statement
+              | Iir_Kind_For_Loop_Statement =>
+               Set_Loop (Stmt, Label);
+            when others =>
+               Error_Msg_Sem ("loop label expected", Stmt);
+               Label := Null_Iir;
+         end case;
+      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 Label = Null_Iir or else Label = P 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_Expression (Cond, Boolean_Type_Definition);
+                        Check_Read (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_Iterator_Scheme (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_Expression (Cond, Boolean_Type_Definition);
+                     Check_Read (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;
+   begin
+      Inst := Get_Instantiated_Unit (Stmt);
+
+      if Get_Kind (Inst) = Iir_Kind_Component_Declaration then
+         --  Already semantized before, while trying to separate
+         --  concurrent procedure calls from instantiation stmts.
+         return Inst;
+      elsif Get_Kind (Inst) in Iir_Kinds_Name then
+         --  The component may be an entity or a configuration.
+         Inst := Find_Declaration (Inst, Decl_Component);
+         if Inst = Null_Iir then
+            return Null_Iir;
+         end if;
+         Set_Instantiated_Unit (Stmt, Inst);
+         return Inst;
+      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_Implementation (Call);
+         Sem_Name (Imp, False);
+         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, Decl);
+            Location_Copy (N_Stmt, Stmt);
+            Xref_Name (Imp);
+
+            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, Interface_Generic);
+         Port_Chain := Get_Port_Chain (Header);
+         Sem_Interface_Chain (Port_Chain, Interface_Port);
+
+         --  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_Expression (Expr, Boolean_Type_Definition);
+         if Expr /= Null_Iir then
+            Check_Read (Expr);
+            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_Base_Name (Guard, Guard);
+         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_Expression (Scheme, Boolean_Type_Definition);
+         Check_Read (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
+         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_Signal_Interface_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_Expression (Expr, Boolean_Type_Definition);
+            if Expr /= Null_Iir then
+               Check_Read (Expr);
+               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 (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 (El), Waveform_Type);
+            Sem_Check_Waveform_Chain (Stmt, Get_Associated (El));
+            El := Get_Chain (El);
+         end loop;
+      end if;
+
+      --  The choices.
+      Expr := Sem_Expression (Get_Expression (Stmt), Null_Iir);
+      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 Sem_Concurrent_Statement_Chain
+     (Parent : Iir; Is_Passive : Boolean)
+   is
+      El: Iir;
+      Prev_El : Iir;
+      Prev_Concurrent_Statement : Iir;
+   begin
+      Prev_Concurrent_Statement := Current_Concurrent_Statement;
+
+      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 others =>
+               Error_Kind ("sem_concurrent_statement", El);
+         end case;
+         Prev_El := El;
+         El := Get_Chain (El);
+      end loop;
+      Current_Concurrent_Statement := Prev_Concurrent_Statement;
+   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
+         Label := Get_Label (Stmt);
+
+         if Label /= Null_Identifier then
+            Sem_Scopes.Add_Name (Stmt);
+            Name_Visible (Stmt);
+            Xref_Decl (Stmt);
+         end if;
+
+         --  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;
+
+   --  Semantize declarations and concurrent statements of ARCH, which is
+   --  either an architecture_declaration or a block_statement.
+   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, False);
+
+      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;
+      Parent : Iir;
+      Driver_List : Iir_List;
+      Driver : Iir;
+   begin
+      if Sig = Null_Iir then
+         return;
+      end if;
+      Sig_Object := Get_Base_Name (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
+            --  Within a procedure.
+            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);
+               return;
+            end if;
+         end if;
+      end if;
+
+      --  The driver is attached to the current process (if any), or to
+      --  the current subprogram (if any) or to nothing.
+      if Current_Concurrent_Statement /= Null_Iir
+        and then (Get_Kind (Current_Concurrent_Statement)
+                  in Iir_Kinds_Process_Statement)
+      then
+         Driver := Current_Concurrent_Statement;
+      elsif Current_Subprogram /= Null_Iir then
+         Driver := Current_Subprogram;
+      else
+         return;
+      end if;
+
+      case Get_Kind (Sig_Object) is
+         when Iir_Kind_Signal_Interface_Declaration =>
+            Parent := Get_Parent (Sig_Object);
+            case Get_Kind (Parent) is
+               when Iir_Kind_Block_Statement
+                 | Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Block_Header =>
+                  null;
+               when Iir_Kind_Procedure_Declaration =>
+                  return;
+               when others =>
+                  Error_Kind ("sem_add_driver", Parent);
+            end case;
+         when Iir_Kind_Signal_Declaration =>
+            null;
+         when others =>
+            Error_Kind ("sem_add_driver(2)", Sig_Object);
+      end case;
+
+      Driver_List := Get_Driver_List (Driver);
+      if Driver_List = Null_Iir_List then
+         Driver_List := Create_Iir_List;
+         Set_Driver_List (Driver, Driver_List);
+      end if;
+
+      Add_Element (Driver_List, Get_Longuest_Static_Prefix (Sig));
+   end Sem_Add_Driver;
+end Sem_Stmts;
diff --git a/sem_stmts.ads b/sem_stmts.ads
new file mode 100644
index 000000000..57f51fd10
--- /dev/null
+++ b/sem_stmts.ads
@@ -0,0 +1,79 @@
+--  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 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 Sem_Stmts is
+   --  Semantize declarations and concurrent statements of BLK, which is
+   --  either an architecture_declaration or a block_statement.
+   --  If SEM_DECLS is true, then semantize the declarations of BLK.
+   procedure Sem_Block (Blk: Iir; Sem_Decls : Boolean);
+
+   procedure Sem_Concurrent_Statement_Chain
+     (Parent : Iir; Is_Passive : Boolean);
+
+   --  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);
+
+   -- 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);
+
+   --  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/sem_types.adb b/sem_types.adb
new file mode 100644
index 000000000..a465b0fde
--- /dev/null
+++ b/sem_types.adb
@@ -0,0 +1,1479 @@
+--  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 GCC; 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 Evaluation; use Evaluation;
+with Sem;
+with Sem_Expr; use Sem_Expr;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Decls;
+with Libraries;
+with Flags;
+with Types; use Types;
+with Std_Names;
+with Iirs_Utils; use Iirs_Utils;
+with Std_Package; use Std_Package;
+with Sem_Names; use Sem_Names;
+with Xrefs; use Xrefs;
+
+package body Sem_Types is
+   --  Sem a range expression.
+   --  Both left and right bounds must be of the same type kind, ie
+   --  integer types, or if INT_ONLY is false, real types.
+   --  However, the two bounds need not have the same type.
+   function Sem_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;
+      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",
+                           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_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
+      Left, Right : Iir;
+   begin
+      if Sem_Range_Expression (Expr, False) = Null_Iir then
+         return Null_Iir;
+      end if;
+      Left := Get_Left_Limit (Expr);
+      Right := Get_Right_Limit (Expr);
+      if Get_Expr_Staticness (Expr) = Locally then
+         Left := Eval_Expr (Left);
+         Set_Left_Limit (Expr, Left);
+         Right := Eval_Expr (Right);
+         Set_Right_Limit (Expr, Right);
+      end if;
+
+      case Get_Kind (Get_Base_Type (Get_Type (Left))) is
+         when Iir_Kind_Integer_Type_Definition =>
+            return Create_Integer_Type (Expr, Expr, 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, Expr);
+               Set_Resolved_Flag (Ntype, False);
+               Set_Type_Staticness (Ntype, Get_Expr_Staticness (Expr));
+               Set_Signal_Type_Flag (Ntype, True);
+               return Ntype;
+            end;
+         when others =>
+            --  sem_range_expression should catch such errors.
+            raise Internal_Error;
+      end case;
+   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;
+
+   -- Sem 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;
+      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);
+
+      --  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_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_Expr (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);
+
+      --  Sem primary units.
+      Unit := Get_Unit_Chain (Def);
+
+      Lit := Create_Physical_Literal (1, Unit);
+      Set_Physical_Unit_Value (Unit, Lit);
+
+      Add_Name (Unit);
+      Set_Type (Unit, Def);
+      Set_Expr_Staticness (Unit, Locally);
+      Set_Visible_Flag (Unit, True);
+      Xref_Decl (Unit);
+
+      --  Sem secondary units.
+      Unit := Get_Chain (Unit);
+      while Unit /= Null_Iir loop
+         --  Val := Sem_Physical_Literal (Get_Multiplier (Unit));
+         Val := Sem_Expression (Get_Physical_Literal (Unit), Def);
+         if Val /= Null_Iir then
+            Val := Eval_Expr (Val);
+            Set_Physical_Literal (Unit, Val);
+            if Get_Kind (Val) = Iir_Kind_Unit_Declaration then
+               Val := Create_Physical_Literal (1, Val);
+            end if;
+            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;
+
+         Sem_Scopes.Add_Name (Unit);
+         Set_Type (Unit, Def);
+         Set_Expr_Staticness (Unit, Locally);
+         Sem_Scopes.Name_Visible (Unit);
+         Xref_Decl (Unit);
+         Unit := Get_Chain (Unit);
+      end loop;
+
+      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 (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));
+         end;
+      end if;
+      Set_Resolved_Flag (Sub_Type, False);
+
+      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 DEF.
+   --  Set type_staticness and resolved_flag of DEF.
+   --  type_staticness of DEF (before calling this function) must be the
+   --  staticness of the array indexes.
+   procedure Sem_Array_Element (Def : Iir)
+   is
+      El_Type : Iir;
+   begin
+      El_Type := Get_Element_Subtype (Def);
+      El_Type := Sem_Subtype_Indication (El_Type);
+      if El_Type = Null_Iir then
+         Set_Type_Staticness (Def, None);
+         Set_Resolved_Flag (Def, False);
+         Set_Element_Subtype (Def, Error_Type);
+         return;
+      end if;
+      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 not Sem_Is_Constrained (El_Type) then
+         Error_Msg_Sem ("array element of unconstrained "
+                        & Disp_Node (El_Type) & " is not allowed", Def);
+      end if;
+      Set_Type_Staticness (Def, Min (Get_Type_Staticness (El_Type),
+                                     Get_Type_Staticness (Def)));
+      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 (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 (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;
+
+   function Sem_Type_Definition (Def: Iir; Decl: Iir) return Iir
+   is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Set_Base_Type (Def, Def);
+            Set_Type_Staticness (Def, Locally);
+            Set_Signal_Type_Flag (Def, True);
+
+            Create_Range_Constraint_For_Enumeration_Type (Def);
+
+            --  Makes all literal visible.
+            declare
+               El: Iir;
+               Literal_List: Iir_List;
+            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_Base_Name (El, El);
+                  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);
+               end loop;
+            end;
+            Set_Resolved_Flag (Def, False);
+            return Def;
+
+         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);
+               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 =>
+            declare
+               Index_Type : Iir;
+               Index_List : Iir_List;
+               Base_Index_List : Iir_List;
+               Staticness : Iir_Staticness;
+
+               -- array_type_definition, which is the same as the subtype,
+               -- but without any constraint in the indexes.
+               Base_Type: Iir;
+            begin
+               -- 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_List (Base_Type, Base_Index_List);
+
+               Staticness := Locally;
+               Index_List := Get_Index_Subtype_List (Def);
+               for I in Natural loop
+                  Index_Type := Get_Nth_Element (Index_List, I);
+                  exit when Index_Type = Null_Iir;
+
+                  Index_Type := Sem_Discrete_Range_Integer (Index_Type);
+                  if Index_Type /= Null_Iir then
+                     Index_Type := Range_To_Subtype_Definition (Index_Type);
+                  else
+                     --  Avoid errors.
+                     Index_Type := Natural_Subtype_Definition;
+                  end if;
+
+                  Replace_Nth_Element (Index_List, I, Index_Type);
+                  Staticness := Min (Staticness,
+                                     Get_Type_Staticness (Index_Type));
+
+                  -- Set the index type in the array type.
+                  -- must "unconstraint" the subtype.
+                  Append_Element (Base_Index_List, Index_Type);
+               end loop;
+               Set_Type_Staticness (Def, Staticness);
+
+               -- Element type.
+               Sem_Array_Element (Def);
+
+               Set_Element_Subtype (Base_Type, Get_Element_Subtype (Def));
+               Set_Signal_Type_Flag (Base_Type, Get_Signal_Type_Flag (Def));
+               --  According to LRM93 §7.4.1, an unconstrained array type
+               --  is not static.
+               Set_Type_Staticness (Base_Type, None);
+               Set_Type_Declarator (Base_Type, Decl);
+               Set_Resolved_Flag (Base_Type, Get_Resolved_Flag (Def));
+
+               Set_Base_Type (Def, Base_Type);
+               Set_Type_Mark (Def, Base_Type);
+               return Def;
+            end;
+
+         when Iir_Kind_Array_Type_Definition =>
+            declare
+               Index_Type : Iir;
+               Index_List : Iir_List;
+            begin
+               Set_Base_Type (Def, Def);
+               Index_List := Get_Index_Subtype_List (Def);
+
+               for I in Natural loop
+                  Index_Type := Get_Nth_Element (Index_List, I);
+                  exit when Index_Type = Null_Iir;
+
+                  Index_Type := Sem_Subtype_Indication (Index_Type);
+                  if Index_Type /= Null_Iir then
+                     if Get_Kind (Index_Type) not in
+                       Iir_Kinds_Discrete_Type_Definition
+                     then
+                        Error_Msg_Sem
+                          ("index type of an array must be discrete",
+                           Index_Type);
+                     end if;
+                  else
+                     --  Avoid errors.
+                     Index_Type := Natural_Subtype_Definition;
+                  end if;
+
+                  Replace_Nth_Element (Index_List, I, Index_Type);
+               end loop;
+
+               --  According to LRM93 §7.4.1, an unconstrained array type
+               --  is not static.
+               Set_Type_Staticness (Def, None);
+
+               Sem_Array_Element (Def);
+               return Def;
+            end;
+
+         when Iir_Kind_Record_Type_Definition =>
+            declare
+               --  Non semantized type of previous element.
+               Last_El_Type : Iir;
+               --  Semantized type of previous element
+               Last_Type : Iir;
+
+               El: Iir;
+               El_Type : Iir;
+               Resolved_Flag : Boolean;
+               Staticness : Iir_Staticness;
+            begin
+               --  LRM 10.1
+               --  5. A record type declaration,
+               Open_Declarative_Region;
+
+               Resolved_Flag := True;
+               Last_El_Type := Null_Iir;
+               Last_Type := Null_Iir;
+               Staticness := Locally;
+               Set_Signal_Type_Flag (Def, True);
+               El := Get_Element_Declaration_Chain (Def);
+               while El /= Null_Iir loop
+                  El_Type := Get_Type (El);
+                  if El_Type /= Last_El_Type then
+                     --  Be careful for a declaration list (r,g,b: integer).
+                     Last_El_Type := El_Type;
+                     El_Type := Sem_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 not Sem_Is_Constrained (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));
+                  else
+                     Staticness := None;
+                  end if;
+                  Sem_Scopes.Add_Name (El);
+                  Name_Visible (El);
+                  Xref_Decl (El);
+                  El := Get_Chain (El);
+               end loop;
+               Close_Declarative_Region;
+               Set_Base_Type (Def, Def);
+               Set_Resolved_Flag (Def, Resolved_Flag);
+               Set_Type_Staticness (Def, Staticness);
+               return Def;
+            end;
+
+         when Iir_Kind_Access_Type_Definition =>
+            declare
+               D_Type : Iir;
+            begin
+               D_Type := Sem_Subtype_Indication (Get_Designated_Type (Def),
+                                                 True);
+               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;
+
+         when Iir_Kind_File_Type_Definition =>
+            declare
+               Type_Mark : Iir;
+            begin
+               Type_Mark := Sem_Subtype_Indication (Get_Type_Mark (Def));
+               Set_Type_Mark (Def, Type_Mark);
+               if Type_Mark /= Null_Iir then
+                  if 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_Unidim_Array_Type (Type_Mark) then
+                        Error_Msg_Sem
+                          ("multi-dimensional " & Disp_Node (Type_Mark)
+                           & " cannot be a file type", Def);
+                     end if;
+                  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;
+
+         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;
+
+   --  Convert a range expression to a subtype definition whose constraint is
+   --  A_RANGE.
+   --  This function extract the type of the range expression.
+   function Range_To_Subtype_Definition (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_Kinds_Discrete_Type_Definition =>
+            --  A_RANGE is already a subtype definition.
+            return A_Range;
+         when others =>
+            Error_Kind ("range_to_subtype_definition", 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 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_Definition;
+
+   -- 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;
+   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_Constant_Interface_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 Get_Nbr_Elements (Get_Index_Subtype_List (Decl_Type)) /= 1 then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  whose element type is that of the resolved signal.
+      if Get_Base_Type (Get_Element_Subtype (Decl_Type))
+        /= Get_Base_Type (Atype)
+      then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  The type of the return value of the function must also be that of
+      --  the signal.
+      if Get_Base_Type (Get_Return_Type (Func)) /= 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
+         Error_Msg_Sem
+           ("resolution " & Disp_Node (Func) & " must be pure", Atype);
+         return False;
+      end if;
+      return True;
+   end Is_A_Resolution_Function;
+
+   procedure Sem_Resolution_Function (Decl: Iir)
+   is
+      Func: Iir;
+      Name : Iir;
+      Res: Iir;
+      El : Iir;
+      List : Iir_List;
+   begin
+      Name := Get_Resolution_Function (Decl);
+      if Name = Null_Iir then
+         -- This is not a resolved type.
+         return;
+      end if;
+
+      -- FIXME: add this check (maybe based on resolved_flag ?)
+      --if Get_Kind (Name) in Iir_Kinds_Function_Declaration then
+      --   --  The resolution function was already semantized.
+      --   --  This can happen if comes from an unconstrained array subtype.
+      --   return;
+      --end if;
+
+      Sem_Name (Name, False);
+      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);
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            if Is_A_Resolution_Function (El, Decl) then
+               if Func /= Null_Iir then
+                  Error_Msg_Sem
+                    ("can't resolve overload for resolution function", Decl);
+                  return;
+               else
+                  Func := El;
+               end if;
+            end if;
+         end loop;
+      else
+         if Is_A_Resolution_Function (Func, Decl) then
+            Res := Func;
+         end if;
+      end if;
+
+      if Res = Null_Iir then
+         Error_Msg_Sem ("no matching resolution function for "
+                        & Disp_Node (Name), Decl);
+      else
+         Set_Named_Entity (Name, Res);
+         Set_Use_Flag (Res, True);
+         Set_Resolved_Flag (Decl, True);
+         Xref_Name (Name);
+      end if;
+   end Sem_Resolution_Function;
+
+   --  Semantize array_subtype_definition DEF using BASE_TYPE as the base type
+   --  of DEF.
+   --  DEF must have an index list and may have a resolution function.
+   --  Return DEF.
+   function Sem_Array_Subtype_Indication (Type_Mark : Iir; Def : Iir)
+     return Iir
+   is
+      Type_Index, Subtype_Index: Iir;
+      Base_Type : Iir;
+      El_Type : Iir;
+      Staticness : Iir_Staticness;
+      Error_Seen : Boolean;
+      Type_Index_List : Iir_List;
+      Subtype_Index_List : Iir_List;
+   begin
+      case Get_Kind (Type_Mark) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            null;
+         when others =>
+            Error_Msg_Sem
+              (Disp_Node (Type_Mark) & " cannot be constrained", Def);
+            --  Continue as if BASE_TYPE is really a base type, it is safe.
+      end case;
+
+      Base_Type := Get_Base_Type (Type_Mark);
+      Set_Base_Type (Def, Base_Type);
+      El_Type := Get_Element_Subtype (Base_Type);
+      Staticness := Get_Type_Staticness (El_Type);
+      Error_Seen := False;
+      Type_Index_List := Get_Index_Subtype_List (Base_Type);
+      Subtype_Index_List := Get_Index_Subtype_List (Def);
+      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;
+            --  Use type_index as a fake subtype
+            --  FIXME: it is too fake.
+            Append_Element (Subtype_Index_List, Type_Index);
+            Staticness := None;
+         else
+            Subtype_Index := Sem_Discrete_Range_Expression
+              (Subtype_Index, Type_Index);
+            if Subtype_Index /= Null_Iir then
+               Subtype_Index := Range_To_Subtype_Definition (Subtype_Index);
+               Staticness := Min (Staticness,
+                                  Get_Type_Staticness (Subtype_Index));
+            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;
+            Replace_Nth_Element (Subtype_Index_List, I, Subtype_Index);
+         end if;
+      end loop;
+      Set_Type_Staticness (Def, Staticness);
+      Set_Element_Subtype (Def, El_Type);
+      Sem_Resolution_Function (Def);
+      if Get_Resolution_Function (Def) /= Null_Iir
+        or else Get_Resolved_Flag (El_Type)
+      then
+         Set_Resolved_Flag (Def, True);
+      else
+         Set_Resolved_Flag (Def, False);
+      end if;
+      Set_Type_Mark (Def, Type_Mark);
+      Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Type_Mark));
+      return Def;
+   end Sem_Array_Subtype_Indication;
+
+   --  Semantize a subtype indication.
+   --  DEF can be either a name or an iir_subtype_definition.
+   --  Return a new (an anonymous) subtype definition (with the correct kind),
+   --  or an already defined type definition (if DEF is a name).
+   function Sem_Subtype_Indication (Def: Iir; Incomplete : Boolean := False)
+     return Iir
+   is
+      Type_Mark: Iir;
+      Res: Iir;
+      Decl_Kind : Decl_Kind_Type;
+   begin
+      if Incomplete then
+         Decl_Kind := Decl_Incomplete_Type;
+      else
+         Decl_Kind := Decl_Type;
+      end if;
+
+      -- Simple case that correspond to no indication except a subtype
+      -- identifier
+      if Get_Kind (Def) in Iir_Kinds_Name then
+         Type_Mark := Find_Declaration (Def, Decl_Kind);
+         if Type_Mark = Null_Iir then
+            return Create_Error_Type (Def);
+         else
+            return Type_Mark;
+         end if;
+      end if;
+
+      --  Semantize the type mark.
+      Type_Mark := Find_Declaration (Get_Type_Mark (Def), Decl_Kind);
+      if Type_Mark = Null_Iir then
+         --  FIXME: handle inversion such as "subtype BASETYPE RESOLV", which
+         --  should emit "resolution function must precede type name".
+         return Create_Error_Type (Get_Type_Mark (Def));
+      end if;
+      Set_Type_Mark (Def, Type_Mark);
+
+      --  Check constraint.
+      case Get_Kind (Def) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            case Get_Kind (Type_Mark) is
+               when Iir_Kind_Unconstrained_Array_Subtype_Definition
+                 | Iir_Kind_Array_Type_Definition
+                 | Iir_Kind_Access_Type_Definition =>
+                  null;
+               when others =>
+                  --  LRM 3.2.1.1  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;
+         when Iir_Kind_Subtype_Definition =>
+            case Get_Kind (Type_Mark) is
+               when Iir_Kind_Integer_Subtype_Definition
+                 | Iir_Kind_Floating_Subtype_Definition
+                 | Iir_Kind_Enumeration_Subtype_Definition
+                 | Iir_Kind_Physical_Subtype_Definition =>
+                  null;
+               when Iir_Kind_Enumeration_Type_Definition =>
+                  null;
+               when others =>
+                  --  FIXME: find the correct sentence from LRM
+                  --  GHDL: subtype_definition may also be used just to add
+                  --    a resolution function.
+                  if Get_Range_Constraint (Def) /= Null_Iir then
+                     Error_Msg_Sem
+                       ("only scalar types may be constrained by range", Def);
+                     Error_Msg_Sem
+                       (" (type mark is " & Disp_Node (Type_Mark) & ")",
+                        Type_Mark);
+                     return Type_Mark;
+                  end if;
+            end case;
+         when others =>
+            Error_Kind ("sem_subtype_indication", Def);
+      end case;
+
+      case Get_Kind (Type_Mark) is
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+--             --  If the base type is an unconstrained array subtype, then get
+--            --  the *real* base type, and copy the resolution function (since
+--             --  a base type has no resolution function).
+--             if Get_Kind (Type_Mark) =
+--               Iir_Kind_Unconstrained_Array_Subtype_Definition
+--               and then Get_Kind (Def) = Iir_Kind_Subtype_Definition
+--             then
+--                if Get_Resolution_Function (Def) = Null_Iir then
+--                   if Get_Range_Constraint (Def) = Null_Iir then
+--                      --  In this case, DEF must simply be a name.  There is
+--                      --  a parser internal error.
+--                      raise Internal_Error;
+--                   end if;
+--                   Set_Resolution_Function
+--                     (Def, Get_Resolution_Function (Type_Mark));
+--                end if;
+--             end if;
+
+            if Get_Kind (Def) = Iir_Kind_Subtype_Definition then
+               -- 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 an array", Def);
+                  return Type_Mark;
+               end if;
+               if Get_Resolution_Function (Def) = Null_Iir then
+                  --  In this case, DEF must simply be a name.  There is
+                  --  a parser internal error.
+                  raise Internal_Error;
+               end if;
+               case Get_Kind (Type_Mark) is
+                  when Iir_Kind_Array_Type_Definition =>
+                     Res := Create_Iir
+                       (Iir_Kind_Unconstrained_Array_Subtype_Definition);
+                  when Iir_Kind_Array_Subtype_Definition =>
+                     Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+                     Set_Element_Subtype
+                       (Res, Get_Element_Subtype (Type_Mark));
+                     Set_Index_Subtype_List
+                       (Res, Get_Index_Subtype_List (Type_Mark));
+                  when others =>
+                     Error_Kind ("sem_subtype_indication(array)", Type_Mark);
+               end case;
+               Location_Copy (Res, Def);
+               Set_Base_Type (Res, Get_Base_Type (Type_Mark));
+               Set_Resolution_Function (Res, Get_Resolution_Function (Def));
+               Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark));
+               Sem_Resolution_Function (Res);
+               Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+               if Get_Resolution_Function (Res) /= Null_Iir
+                 or else Get_Resolved_Flag (Get_Element_Subtype (Type_Mark))
+               then
+                  Set_Resolved_Flag (Res, True);
+               else
+                  Set_Resolved_Flag (Res, False);
+               end if;
+               Set_Type_Mark (Res, Type_Mark);
+               Free_Name (Def);
+               return Res;
+            elsif Get_Kind (Def) = Iir_Kind_Array_Subtype_Definition then
+               -- Case of a constraint for an array.
+               -- Check each index constraint against array type.
+               return Sem_Array_Subtype_Indication (Type_Mark, Def);
+            else
+               Error_Kind ("sem_subtype_indication(1)", Def);
+               return Type_Mark;
+            end if;
+
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            if Get_Range_Constraint (Def) = Null_Iir
+              and then Get_Resolution_Function (Def) = Null_Iir
+            then
+               --  This defines an alias, and must have been handled just
+               --  before the case statment.
+               raise Internal_Error;
+            end if;
+            declare
+               A_Range : Iir;
+            begin
+               -- There are limits.  Create a new subtype.
+               Res := Create_Iir (Get_Kind (Type_Mark));
+               Location_Copy (Res, Def);
+               Set_Base_Type (Res, Get_Base_Type (Type_Mark));
+               Set_Type_Mark (Res, Type_Mark);
+               Set_Resolution_Function (Res, Get_Resolution_Function (Def));
+               A_Range := Get_Range_Constraint (Def);
+               if A_Range = Null_Iir then
+                  A_Range := Get_Range_Constraint (Type_Mark);
+               else
+                  A_Range := Sem_Discrete_Range_Expression
+                    (A_Range, Type_Mark);
+                  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);
+               Sem_Resolution_Function (Res);
+               Set_Resolved_Flag
+                 (Res, Get_Resolution_Function (Res) /= Null_Iir);
+               Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+               return Res;
+            end;
+
+         when Iir_Kind_Enumeration_Type_Definition =>
+            if Get_Range_Constraint (Def) = Null_Iir and then
+              Get_Resolution_Function (Def) = Null_Iir
+            then
+               raise Internal_Error;
+            end if;
+
+            declare
+               Constraint : Iir_Range_Expression;
+            begin
+               -- There are limits.  Create a new subtype.
+               Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+               Location_Copy (Res, Def);
+               Set_Base_Type (Res, Type_Mark);
+               Set_Type_Mark (Res, Type_Mark);
+               Set_Resolution_Function (Res, Get_Resolution_Function (Def));
+               Constraint := Get_Range_Constraint (Def);
+               if Constraint = Null_Iir then
+                  Constraint := Get_Range_Constraint (Type_Mark);
+               else
+                  Constraint := Sem_Discrete_Range_Expression
+                    (Constraint, Type_Mark);
+                  -- FIXME: check bounds, check static
+               end if;
+               Set_Range_Constraint (Res, Constraint);
+               Set_Type_Staticness (Res, Get_Expr_Staticness (Constraint));
+            end;
+            Free_Name (Def);
+            Sem_Resolution_Function (Res);
+            Set_Resolved_Flag
+              (Res, Get_Resolution_Function (Res) /= Null_Iir);
+            Set_Signal_Type_Flag (Res, True);
+            return Res;
+
+         when Iir_Kind_Record_Type_Definition =>
+            declare
+               Func: Iir;
+            begin
+               if Get_Kind (Def) /= Iir_Kind_Subtype_Definition then
+                  Error_Kind ("sem_subtype_indication1", Def);
+                  return Null_Iir;
+               end if;
+               Func := Get_Resolution_Function (Def);
+               if Func = Null_Iir then
+                  --  This is an alias.
+                  raise Internal_Error;
+               end if;
+               Res := Create_Iir (Iir_Kind_Record_Subtype_Definition);
+               Location_Copy (Res, Def);
+               Set_Base_Type (Res, Type_Mark);
+               Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark));
+               Set_Type_Mark (Res, Type_Mark);
+               Set_Resolution_Function (Res, Func);
+               Sem_Resolution_Function (Res);
+               Set_Resolved_Flag (Res, Func /= Null_Iir);
+               Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+               Free_Name (Def);
+               return Res;
+            end;
+
+         when Iir_Kind_Access_Type_Definition =>
+            --  LRM93 4.2
+            --  A subtype indication denoting an access type [or a file type]
+            --  may not contain a resolution function.
+            if Get_Resolution_Function (Def) /= 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 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;
+                  begin
+                     Base_Type := Get_Designated_Type (Type_Mark);
+                     Sub_Type := Sem_Array_Subtype_Indication (Base_Type, Def);
+                     Res := Create_Iir (Iir_Kind_Access_Subtype_Definition);
+                     Location_Copy (Res, Def);
+                     Set_Base_Type (Res, Type_Mark);
+                     Set_Signal_Type_Flag (Res, False);
+                     Free_Old_Iir (Def);
+                     return Res;
+                  end;
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Kind_File_Type_Definition =>
+            if Get_Kind (Def) = Iir_Kind_Subtype_Definition then
+               Free_Name (Def);
+               return Type_Mark;
+            else
+               raise Internal_Error;
+            end if;
+
+         when others =>
+            Error_Kind ("sem_subtype_indication", Type_Mark);
+            return Def;
+      end case;
+   end Sem_Subtype_Indication;
+
+   function Sem_Is_Constrained (A_Type: Iir) return Boolean is
+   begin
+      case Get_Kind (A_Type) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            return True;
+         when Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_File_Type_Definition =>
+            --| Iir_Kind_File_Subtype_Definition =>
+            return True;
+         when Iir_Kind_Protected_Type_Declaration =>
+            return True;
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+            return False;
+         when Iir_Kind_Incomplete_Type_Definition =>
+            return False;
+         when Iir_Kind_Error =>
+            return True;
+         when others =>
+            Error_Kind ("sem_is_constrained", A_Type);
+      end case;
+   end Sem_Is_Constrained;
+
+end Sem_Types;
diff --git a/sem_types.ads b/sem_types.ads
new file mode 100644
index 000000000..390976e11
--- /dev/null
+++ b/sem_types.ads
@@ -0,0 +1,41 @@
+--  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 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 Sem_Types is
+   --  Semantization of types (LRM chapter 3)
+
+   -- Semantize subtype indication DEF.
+   -- If INCOMPLETE is TRUE, then DEF may designate an incomplete type
+   -- definition.
+   -- This is used by sem_expr for qualified expression and allocators.
+   function Sem_Subtype_Indication (Def: Iir; Incomplete : Boolean := False)
+     return Iir;
+
+   -- Return FALSE if A_TYPE is an unconstrained array type or subtype.
+   function Sem_Is_Constrained (A_Type: Iir) return Boolean;
+
+   procedure Sem_Protected_Type_Body (Bod : Iir);
+
+   function Sem_Type_Definition (Def: Iir; Decl: Iir) return Iir;
+
+   --  Convert a range expression to a subtype definition whose constraint is
+   --  A_RANGE.
+   --  This function extract the type of the range expression.
+   function Range_To_Subtype_Definition (A_Range: Iir) return Iir;
+end Sem_Types;
diff --git a/std_names.adb b/std_names.adb
new file mode 100644
index 000000000..51aa22472
--- /dev/null
+++ b/std_names.adb
@@ -0,0 +1,352 @@
+--  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 GCC; 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;
+
+package body Std_Names is
+   procedure Std_Names_Initialize is
+      function GI (S : String) return Name_Id
+         renames Name_Table.Get_Identifier;
+
+--       function GI (S : String) return Name_Id is
+--       begin
+--          Ada.Text_IO.Put_Line ("add " & S);
+--          return Name_Table.Get_Identifier (S);
+--       end GI;
+
+   begin
+      Name_Table.Initialize;
+
+      -- Create keywords.
+      for I in Tok_Mod .. Tok_Protected loop
+         if GI (Image (I)) /=
+           Name_First_Keyword +
+           Token_Type'Pos (I) - Token_Type'Pos (Tok_First_Keyword)
+         then
+            raise Program_Error;
+         end if;
+      end loop;
+
+      -- Create operators.
+      if GI ("=") /= Name_Op_Equality
+        or GI ("/=") /= Name_Op_Inequality
+        or GI ("<") /= Name_Op_Less
+        or GI ("<=") /= Name_Op_Less_Equal
+        or GI (">") /= Name_Op_Greater
+        or GI (">=") /= Name_Op_Greater_Equal
+        or GI ("+") /= Name_Op_Plus
+        or GI ("-") /= Name_Op_Minus
+        or GI ("*") /= Name_Op_Mul
+        or GI ("/") /= Name_Op_Div
+        or GI ("**") /= Name_Op_Exp
+        or GI ("&") /= Name_Op_Concatenation
+      then
+         raise Program_Error;
+      end if;
+
+      -- Create Attributes.
+      if   GI ("base") /= Name_Base
+        or GI ("left") /= Name_Left
+        or GI ("right") /= Name_Right
+        or GI ("high") /= Name_High
+        or GI ("low") /= Name_Low
+        or GI ("pos") /= Name_Pos
+        or GI ("val") /= Name_Val
+        or GI ("succ") /= Name_Succ
+        or GI ("pred") /= Name_Pred
+        or GI ("leftof") /= Name_Leftof
+        or GI ("rightof") /= Name_Rightof
+        or GI ("reverse_range") /= Name_Reverse_Range
+        or GI ("length") /= Name_Length
+        or GI ("delayed") /= Name_Delayed
+        or GI ("stable") /= Name_Stable
+        or GI ("quiet") /= Name_Quiet
+        or GI ("transaction") /= Name_Transaction
+        or GI ("event") /= Name_Event
+        or GI ("active") /= Name_Active
+        or GI ("last_event") /= Name_Last_Event
+        or GI ("last_active") /= Name_Last_Active
+        or GI ("last_value") /= Name_Last_Value
+
+        or GI ("behavior") /= Name_Behavior
+        or GI ("structure") /= Name_Structure
+
+        or GI ("ascending") /= Name_Ascending
+        or GI ("image") /= Name_Image
+        or GI ("value") /= Name_Value
+        or GI ("driving") /= Name_Driving
+        or GI ("driving_value") /= Name_Driving_Value
+        or GI ("simple_name") /= Name_Simple_Name
+        or GI ("instance_name") /= Name_Instance_Name
+        or GI ("path_name") /= Name_Path_Name
+      then
+         raise Program_Error;
+      end if;
+
+      --  Create standard.
+      if GI ("std") /= Name_Std
+        or GI ("standard") /= Name_Standard
+        or GI ("boolean") /= Name_Boolean
+        or GI ("false") /= Name_False
+        or GI ("true") /= Name_True
+        or GI ("bit") /= Name_Bit
+        or GI ("character") /= Name_Character
+        or GI ("severity_level") /= Name_Severity_Level
+        or GI ("note") /= Name_Note
+        or GI ("warning") /= Name_Warning
+        or GI ("error") /= Name_Error
+        or GI ("failure") /= Name_Failure
+        or GI ("UNIVERSAL_INTEGER") /= Name_Universal_Integer
+        or GI ("UNIVERSAL_REAL") /= Name_Universal_Real
+        or GI ("CONVERTIBLE_INTEGER") /= Name_Convertible_Integer
+        or GI ("CONVERTIBLE_REAL") /= Name_Convertible_Real
+        or GI ("integer") /= Name_Integer
+        or GI ("real") /= Name_Real
+        or GI ("time") /= Name_Time
+        or GI ("fs") /= Name_Fs
+        or GI ("ps") /= Name_Ps
+        or GI ("ns") /= Name_Ns
+        or GI ("us") /= Name_Us
+        or GI ("ms") /= Name_Ms
+        or GI ("sec") /= Name_Sec
+        or GI ("min") /= Name_Min
+        or GI ("hr") /= Name_Hr
+        or GI ("delay_length") /= Name_Delay_Length
+        or GI ("now") /= Name_Now
+        or GI ("natural") /= Name_Natural
+        or GI ("positive") /= Name_Positive
+        or GI ("string") /= Name_String
+        or GI ("bit_vector") /= Name_Bit_Vector
+        or GI ("file_open_kind") /= Name_File_Open_Kind
+        or GI ("read_mode") /= Name_Read_Mode
+        or GI ("write_mode") /= Name_Write_Mode
+        or GI ("append_mode") /= Name_Append_Mode
+        or GI ("file_open_status") /= Name_File_Open_Status
+        or GI ("open_ok") /= Name_Open_Ok
+        or GI ("status_error") /= Name_Status_Error
+        or GI ("name_error") /= Name_Name_Error
+        or GI ("mode_error") /= Name_Mode_Error
+        or GI ("foreign") /= Name_Foreign
+      then
+         raise Program_Error;
+      end if;
+
+      if GI ("nul") /= Name_Nul
+        or GI ("soh") /= Name_Soh
+        or GI ("stx") /= Name_Stx
+        or GI ("etx") /= Name_Etx
+        or GI ("eot") /= Name_Eot
+        or GI ("enq") /= Name_Enq
+        or GI ("ack") /= Name_Ack
+        or GI ("bel") /= Name_Bel
+        or GI ("bs") /= Name_Bs
+        or GI ("ht") /= Name_Ht
+        or GI ("lf") /= Name_Lf
+        or GI ("vt") /= Name_Vt
+        or GI ("ff") /= Name_Ff
+        or GI ("cr") /= Name_Cr
+        or GI ("so") /= Name_So
+        or GI ("si") /= Name_Si
+        or GI ("dle") /= Name_Dle
+        or GI ("dc1") /= Name_Dc1
+        or GI ("dc2") /= Name_Dc2
+        or GI ("dc3") /= Name_Dc3
+        or GI ("dc4") /= Name_Dc4
+        or GI ("nak") /= Name_Nak
+        or GI ("syn") /= Name_Syn
+        or GI ("etb") /= Name_Etb
+        or GI ("can") /= Name_Can
+        or GI ("em") /= Name_Em
+        or GI ("sub") /= Name_Sub
+        or GI ("esc") /= Name_Esc
+        or GI ("fsp") /= Name_Fsp
+        or GI ("gsp") /= Name_Gsp
+        or GI ("rsp") /= Name_Rsp
+        or GI ("usp") /= Name_Usp
+        or GI ("del") /= Name_Del
+      then
+         raise Program_Error;
+      end if;
+
+      if GI ("c128") /= Name_C128
+        or GI ("c129") /= Name_C129
+        or GI ("c130") /= Name_C130
+        or GI ("c131") /= Name_C131
+        or GI ("c132") /= Name_C132
+        or GI ("c133") /= Name_C133
+        or GI ("c134") /= Name_C134
+        or GI ("c135") /= Name_C135
+        or GI ("c136") /= Name_C136
+        or GI ("c137") /= Name_C137
+        or GI ("c138") /= Name_C138
+        or GI ("c139") /= Name_C139
+        or GI ("c140") /= Name_C140
+        or GI ("c141") /= Name_C141
+        or GI ("c142") /= Name_C142
+        or GI ("c143") /= Name_C143
+        or GI ("c144") /= Name_C144
+        or GI ("c145") /= Name_C145
+        or GI ("c146") /= Name_C146
+        or GI ("c147") /= Name_C147
+        or GI ("c148") /= Name_C148
+        or GI ("c149") /= Name_C149
+        or GI ("c150") /= Name_C150
+        or GI ("c151") /= Name_C151
+        or GI ("c152") /= Name_C152
+        or GI ("c153") /= Name_C153
+        or GI ("c154") /= Name_C154
+        or GI ("c155") /= Name_C155
+        or GI ("c156") /= Name_C156
+        or GI ("c157") /= Name_C157
+        or GI ("c158") /= Name_C158
+        or GI ("c159") /= Name_C159
+      then
+         raise Program_Error;
+      end if;
+
+      -- Create misc.
+      if GI ("guard") /= Name_Guard
+        or GI ("deallocate") /= Name_Deallocate
+        or GI ("file_open") /= Name_File_Open
+        or GI ("file_close") /= Name_File_Close
+        or GI ("read") /= Name_Read
+        or GI ("write") /= Name_Write
+        or GI ("endfile") /= Name_Endfile
+        or GI ("p") /= Name_P
+        or GI ("f") /= Name_F
+        or GI ("external_name") /= Name_External_Name
+        or GI ("open_kind") /= Name_Open_Kind
+        or GI ("status") /= Name_Status
+        or GI ("first") /= Name_First
+        or GI ("last") /= Name_Last
+        or GI ("textio") /= Name_Textio
+        or GI ("work") /= Name_Work
+        or GI ("text") /= Name_Text
+        or GI ("untruncated_text_read") /= Name_Untruncated_Text_Read
+      then
+         raise Program_Error;
+      end if;
+
+      if GI ("ieee") /= Name_Ieee
+        or GI ("std_logic_1164") /= Name_Std_Logic_1164
+        or GI ("std_ulogic") /= Name_Std_Ulogic
+        or GI ("std_ulogic_vector") /= Name_Std_Ulogic_Vector
+        or GI ("std_logic") /= Name_Std_Logic
+        or GI ("std_logic_vector") /= Name_Std_Logic_Vector
+        or GI ("rising_edge") /= Name_Rising_Edge
+        or GI ("falling_edge") /= Name_Falling_Edge
+        or GI ("vital_timing") /= Name_VITAL_Timing
+        or GI ("vital_level0") /= Name_VITAL_Level0
+        or GI ("vital_level1") /= Name_VITAL_Level1
+      then
+         raise Program_Error;
+      end if;
+
+      if GI ("always") /= Name_Always
+        or GI ("assign") /= Name_Assign
+        or GI ("buf") /= Name_Buf
+        or GI ("bufif0") /= Name_Bufif0
+        or GI ("bufif1") /= Name_Bufif1
+        or GI ("casex") /= Name_Casex
+        or GI ("casez") /= Name_Casez
+        or GI ("cmos") /= Name_Cmos
+        or GI ("deassign") /= Name_Deassign
+        or GI ("default") /= Name_Default
+        or GI ("defparam") /= Name_Defparam
+        or GI ("disable") /= Name_Disable
+        or GI ("endcase") /= Name_Endcase
+        or GI ("endfunction") /= Name_Endfunction
+        or GI ("endmodule") /= Name_Endmodule
+        or GI ("endprimitive") /= Name_Endprimitive
+        or GI ("endspecify") /= Name_Endspecify
+        or GI ("endtable") /= Name_Endtable
+        or GI ("endtask") /= Name_Endtask
+        or GI ("forever") /= Name_Forever
+        or GI ("fork") /= Name_Fork
+        or GI ("highz0") /= Name_Highz0
+        or GI ("highz1") /= Name_Highz1
+        or GI ("initial") /= Name_Initial
+        or GI ("input") /= Name_Input
+        or GI ("join") /= Name_Join
+        or GI ("large") /= Name_Large
+        or GI ("medium") /= Name_Medium
+        or GI ("module") /= Name_Module
+        or GI ("negedge") /= Name_Negedge
+        or GI ("nmos") /= Name_Nmos
+        or GI ("notif0") /= Name_Notif0
+        or GI ("notif1") /= Name_Notif1
+        or GI ("output") /= Name_Output
+        or GI ("parameter") /= Name_Parameter
+        or GI ("pmos") /= Name_Pmos
+        or GI ("posedge") /= Name_Posedge
+        or GI ("primitive") /= Name_Primitive
+        or GI ("pull0") /= Name_Pull0
+        or GI ("pull1") /= Name_Pull1
+        or GI ("pulldown") /= Name_Pulldown
+        or GI ("pullup") /= Name_Pullup
+        or GI ("reg") /= Name_Reg
+        or GI ("repeat") /= Name_Repeat
+        or GI ("rcmos") /= Name_Rcmos
+        or GI ("rnmos") /= Name_Rnmos
+        or GI ("rpmos") /= Name_Rpmos
+        or GI ("rtran") /= Name_Rtran
+        or GI ("rtranif0") /= Name_Rtranif0
+        or GI ("rtranif1") /= Name_Rtranif1
+        or GI ("small") /= Name_Small
+        or GI ("specify") /= Name_Specify
+        or GI ("specparam") /= Name_Specparam
+        or GI ("strong0") /= Name_Strong0
+        or GI ("strong1") /= Name_Strong1
+        or GI ("supply0") /= Name_Supply0
+        or GI ("supply1") /= Name_Supply1
+        or GI ("table") /= Name_Tablex
+        or GI ("task") /= Name_Task
+        or GI ("tran") /= Name_Tran
+        or GI ("tranif0") /= Name_Tranif0
+        or GI ("tranif1") /= Name_Tranif1
+        or GI ("tri") /= Name_Tri
+        or GI ("tri0") /= Name_Tri0
+        or GI ("tri1") /= Name_Tri1
+        or GI ("trireg") /= Name_Trireg
+        or GI ("wand") /= Name_Wand
+        or GI ("weak0") /= Name_Weak0
+        or GI ("weak1") /= Name_Weak1
+        or GI ("wire") /= Name_Wire
+        or GI ("wor") /= Name_Wor
+      then
+         raise Program_Error;
+      end if;
+
+      if GI ("define") /= Name_Define
+        or GI ("endif") /= Name_Endif
+        or GI ("ifdef") /= Name_Ifdef
+        or GI ("include") /= Name_Include
+        or GI ("timescale") /= Name_Timescale
+        or GI ("undef") /= Name_Undef
+      then
+         raise Program_Error;
+      end if;
+
+      if GI ("display") /= Name_Display
+        or GI ("finish") /= Name_Finish
+      then
+         raise Program_Error;
+      end if;
+
+   end Std_Names_Initialize;
+end Std_Names;
diff --git a/std_names.ads b/std_names.ads
new file mode 100644
index 000000000..d1f6bd2db
--- /dev/null
+++ b/std_names.ads
@@ -0,0 +1,491 @@
+--  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 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;
+
+-- 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;
+
+   -- VHDL93 keywords.
+   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;
+
+   Name_Protected :      constant Name_Id := Name_First_Keyword + 097;
+
+   Name_Last_Keyword :   constant Name_Id := Name_Protected;
+
+   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_Last_Operator :  constant Name_Id := Name_Op_Concatenation;
+
+   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;
+   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_Vhdl93_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;
+   Name_Last_Standard :  constant Name_Id := Name_Foreign;
+
+   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_Endfile :        constant Name_Id := Name_First_Misc + 006;
+   Name_P :              constant Name_Id := Name_First_Misc + 007;
+   Name_F :              constant Name_Id := Name_First_Misc + 008;
+   Name_External_Name :  constant Name_Id := Name_First_Misc + 009;
+   Name_Open_Kind :      constant Name_Id := Name_First_Misc + 010;
+   Name_Status :         constant Name_Id := Name_First_Misc + 011;
+   Name_First :          constant Name_Id := Name_First_Misc + 012;
+   Name_Last :           constant Name_Id := Name_First_Misc + 013;
+   Name_Textio :         constant Name_Id := Name_First_Misc + 014;
+   Name_Work :           constant Name_Id := Name_First_Misc + 015;
+   Name_Text :           constant Name_Id := Name_First_Misc + 016;
+   Name_Untruncated_Text_Read : constant Name_Id := Name_First_Misc + 017;
+   Name_Last_Misc :      constant Name_Id := Name_Untruncated_Text_Read;
+
+   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;
+
+   -- Initialize the name table with the values defined here.
+   procedure Std_Names_Initialize;
+end Std_Names;
diff --git a/std_package.adb b/std_package.adb
new file mode 100644
index 000000000..4cf1b4521
--- /dev/null
+++ b/std_package.adb
@@ -0,0 +1,921 @@
+--  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 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 Types; use Types;
+with Files_Map;
+with Name_Table;
+with Str_Table;
+with Std_Names; use Std_Names;
+with 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;
+
+   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_Iir (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_Base_Name (Res, Res);
+         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_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);
+
+         Type_Decl := Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Type_Decl, Type_Name);
+         Set_Type (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);
+
+         --  type is
+         Subtype_Decl := Create_Std_Iir (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;
+
+   begin
+      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);
+      Std_Standard_Unit := Create_Std_Iir (Iir_Kind_Design_Unit);
+      Set_Std_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);
+
+      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;
+
+      Set_Date (Std_Standard_Unit, Date_Valid'First);
+
+      -- Adding "package STANDARD is"
+      Standard_Package := Create_Std_Iir (Iir_Kind_Package_Declaration);
+      Set_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);
+
+         -- type boolean is
+         Boolean_Type := Create_Std_Iir (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (Boolean_Type, Name_Boolean);
+         Set_Type (Boolean_Type, Boolean_Type_Definition);
+         Add_Decl (Boolean_Type);
+         Set_Type_Declarator (Boolean_Type_Definition, Boolean_Type);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (Boolean_Type_Definition);
+         Add_Implicit_Operations (Boolean_Type);
+      end;
+
+      -- 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);
+
+         -- type bit is
+         Bit_Type := Create_Std_Iir (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (Bit_Type, Name_Bit);
+         Set_Type (Bit_Type, Bit_Type_Definition);
+         Add_Decl (Bit_Type);
+         Set_Type_Declarator (Bit_Type_Definition, Bit_Type);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (Bit_Type_Definition);
+         Add_Implicit_Operations (Bit_Type);
+      end;
+
+      -- characters.
+      declare
+         El: Iir;
+      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 Flags.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);
+
+         -- type character is
+         Character_Type := Create_Std_Iir (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (Character_Type, Name_Character);
+         Set_Type (Character_Type, Character_Type_Definition);
+         Add_Decl (Character_Type);
+         Set_Type_Declarator (Character_Type_Definition,
+                              Character_Type);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (Character_Type_Definition);
+         Add_Implicit_Operations (Character_Type);
+      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);
+
+         -- type severity_level is
+         Severity_Level_Type := Create_Std_Iir (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (Severity_Level_Type, Name_Severity_Level);
+         Set_Type (Severity_Level_Type, Severity_Level_Type_Definition);
+         Add_Decl (Severity_Level_Type);
+         Set_Type_Declarator (Severity_Level_Type_Definition,
+                              Severity_Level_Type);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (Severity_Level_Type_Definition);
+         Add_Implicit_Operations (Severity_Level_Type);
+      end;
+
+      -- universal types.
+      begin
+         Create_Integer_Type (Universal_Integer_Type_Definition,
+                              Universal_Integer_Type,
+                              Name_Universal_Integer);
+         Add_Decl (Universal_Integer_Type);
+
+         Create_Integer_Subtype (Universal_Integer_Type_Definition,
+                                 Universal_Integer_Type,
+                                 Universal_Integer_Subtype_Definition,
+                                 Universal_Integer_Subtype);
+
+         Add_Decl (Universal_Integer_Subtype);
+         Set_Subtype_Definition (Universal_Integer_Type,
+                                 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);
+
+         Universal_Real_Type :=
+           Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Universal_Real_Type, Name_Universal_Real);
+         Set_Type (Universal_Real_Type, Universal_Real_Type_Definition);
+         Set_Type_Declarator (Universal_Real_Type_Definition,
+                              Universal_Real_Type);
+         Add_Decl (Universal_Real_Type);
+
+         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);
+
+         --  type is
+         Universal_Real_Subtype :=
+           Create_Std_Iir (Iir_Kind_Subtype_Declaration);
+         Set_Identifier (Universal_Real_Subtype, Name_Universal_Real);
+         Set_Type (Universal_Real_Subtype, Universal_Real_Subtype_Definition);
+         Set_Type_Declarator (Universal_Real_Subtype_Definition,
+                              Universal_Real_Subtype);
+         Set_Subtype_Definition (Universal_Real_Type,
+                                 Universal_Real_Subtype_Definition);
+
+         Add_Decl (Universal_Real_Subtype);
+
+         --  Do not create implicit operations yet, since "**" needs integer
+         --  type.
+      end;
+
+      -- Convertible type.
+      begin
+         Create_Integer_Type (Convertible_Integer_Type_Definition,
+                              Convertible_Integer_Type,
+                              Name_Convertible_Integer);
+         Create_Integer_Subtype (Convertible_Integer_Type_Definition,
+                                 Convertible_Integer_Type,
+                                 Convertible_Integer_Subtype_Definition,
+                                 Convertible_Integer_Subtype);
+
+         --  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);
+
+         Convertible_Real_Type :=
+           Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Convertible_Real_Type, Name_Convertible_Real);
+         Set_Type (Convertible_Real_Type, Convertible_Real_Type_Definition);
+         Set_Type_Declarator (Convertible_Real_Type_Definition,
+                              Convertible_Real_Type);
+      end;
+
+      -- integer type.
+      begin
+         Integer_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Integer_Type_Definition);
+         Create_Integer_Type (Integer_Type_Definition,
+                              Integer_Type,
+                              Name_Integer);
+         Add_Decl (Integer_Type);
+
+         Add_Implicit_Operations (Integer_Type);
+         Add_Implicit_Operations (Universal_Integer_Type);
+         Add_Implicit_Operations (Universal_Real_Type);
+
+         Create_Integer_Subtype (Integer_Type_Definition,
+                                 Integer_Type,
+                                 Integer_Subtype_Definition,
+                                 Integer_Subtype);
+         Add_Decl (Integer_Subtype);
+      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);
+
+         Real_Type := Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Real_Type, Name_Real);
+         Set_Type (Real_Type, Real_Type_Definition);
+         Set_Type_Declarator (Real_Type_Definition, Real_Type);
+         Add_Decl (Real_Type);
+
+         Add_Implicit_Operations (Real_Type);
+
+         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);
+
+         Real_Subtype := Create_Std_Iir (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Real_Subtype, Name_Real);
+         Set_Type (Real_Subtype, Real_Subtype_Definition);
+         Set_Type_Declarator (Real_Subtype_Definition, Real_Subtype);
+         Add_Decl (Real_Subtype);
+
+         Set_Subtype_Definition (Real_Type, Real_Subtype_Definition);
+      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);
+         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);
+
+         Natural_Subtype := Create_Std_Iir (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Natural_Subtype, Name_Natural);
+         Set_Type (Natural_Subtype, Natural_Subtype_Definition);
+         Add_Decl (Natural_Subtype);
+         Set_Type_Declarator (Natural_Subtype_Definition, Natural_Subtype);
+      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);
+         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);
+
+         Positive_Subtype := Create_Std_Iir (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Positive_Subtype, Name_Positive);
+         Set_Type (Positive_Subtype, Positive_Subtype_Definition);
+         Add_Decl (Positive_Subtype);
+         Set_Type_Declarator (Positive_Subtype_Definition, Positive_Subtype);
+      end;
+
+      -- string type.
+      -- type string is array (positive range <>) of character;
+      begin
+         String_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Array_Type_Definition);
+         Set_Base_Type (String_Type_Definition, String_Type_Definition);
+         Set_Index_Subtype_List (String_Type_Definition, Create_Iir_List);
+         Append_Element (Get_Index_Subtype_List (String_Type_Definition),
+                         Positive_Subtype_Definition);
+         Set_Element_Subtype (String_Type_Definition,
+                              Character_Type_Definition);
+         Set_Type_Staticness (String_Type_Definition, None);
+         Set_Signal_Type_Flag (String_Type_Definition, True);
+
+         String_Type := Create_Std_Iir (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (String_Type, Name_String);
+         Set_Type (String_Type, String_Type_Definition);
+         Add_Decl (String_Type);
+         Set_Type_Declarator (String_Type_Definition, String_Type);
+
+         Add_Implicit_Operations (String_Type);
+      end;
+
+      -- bit_vector type.
+      -- type bit_vector is array (natural range <>) of bit;
+      begin
+         Bit_Vector_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Array_Type_Definition);
+         Set_Base_Type (Bit_Vector_Type_Definition,
+                        Bit_Vector_Type_Definition);
+         Set_Index_Subtype_List (Bit_Vector_Type_Definition, Create_Iir_List);
+         Append_Element (Get_Index_Subtype_List (Bit_Vector_Type_Definition),
+                         Natural_Subtype_Definition);
+         Set_Element_Subtype (Bit_Vector_Type_Definition, Bit_Type_Definition);
+         Set_Type_Staticness (Bit_Vector_Type_Definition, None);
+         Set_Signal_Type_Flag (Bit_Vector_Type_Definition, True);
+
+         Bit_Vector_Type := Create_Std_Iir (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (Bit_Vector_Type, Name_Bit_Vector);
+         Set_Type (Bit_Vector_Type, Bit_Vector_Type_Definition);
+         Add_Decl (Bit_Vector_Type);
+         Set_Type_Declarator (Bit_Vector_Type_Definition, Bit_Vector_Type);
+
+         Add_Implicit_Operations (Bit_Vector_Type);
+      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_Unit_Declaration)
+           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);
+            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;
+         begin
+            Unit := Create_Std_Iir (Iir_Kind_Unit_Declaration);
+            Set_Std_Identifier (Unit, Name);
+            Set_Type (Unit, Time_Type_Definition);
+
+            Lit := Create_Std_Phys_Lit (Multiplier_Value, Multiplier);
+            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);
+            Append (Last_Unit, Time_Type_Definition, Unit);
+         end Create_Unit;
+
+         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 Flags.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);
+
+         Build_Init (Last_Unit);
+
+         Time_Fs_Unit := Create_Std_Iir (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_Physical_Unit_Value
+           (Time_Fs_Unit, Create_Std_Phys_Lit (1, Time_Fs_Unit));
+         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 := Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Time_Type, Name_Time);
+         Set_Type (Time_Type, Time_Type_Definition);
+         Set_Type_Declarator (Time_Type_Definition, Time_Type);
+         Add_Decl (Time_Type);
+
+         Add_Implicit_Operations (Time_Type);
+
+         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_Unit),
+            Create_Std_Phys_Lit (High_Bound (Flags.Flag_Time_64),
+                                 Time_Fs_Unit),
+            Time_Type_Definition);
+         Set_Range_Constraint (Time_Subtype_Definition, Constraint);
+         Set_Base_Type (Time_Subtype_Definition, Time_Type_Definition);
+         --Set_Type_Mark (Time_Subtype_Definition, Time_Type_Definition);
+         Set_Type_Staticness (Time_Subtype_Definition, Time_Staticness);
+         Set_Signal_Type_Flag (Time_Subtype_Definition, True);
+
+         --  subtype
+         Time_Subtype := Create_Std_Iir (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Time_Subtype, Name_Time);
+         Set_Type (Time_Subtype, Time_Subtype_Definition);
+         Set_Type_Declarator (Time_Subtype_Definition, Time_Subtype);
+         Add_Decl (Time_Subtype);
+         Set_Subtype_Definition (Time_Type, 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 Flags.Vhdl_Std >= Vhdl_93c then
+            Delay_Length_Subtype_Definition :=
+              Create_Std_Iir (Iir_Kind_Physical_Subtype_Definition);
+            Set_Type_Mark (Delay_Length_Subtype_Definition,
+                           Time_Subtype_Definition);
+            Constraint := Create_Std_Range_Expr
+              (Create_Std_Phys_Lit (0, Time_Fs_Unit),
+               Create_Std_Phys_Lit (High_Bound (Flags.Flag_Time_64),
+                                    Time_Fs_Unit),
+               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);
+
+            Delay_Length_Subtype :=
+              Create_Std_Iir (Iir_Kind_Subtype_Declaration);
+            Set_Std_Identifier (Delay_Length_Subtype, Name_Delay_Length);
+            Set_Type (Delay_Length_Subtype, Delay_Length_Subtype_Definition);
+            Set_Type_Declarator
+              (Delay_Length_Subtype_Definition, Delay_Length_Subtype);
+            Add_Decl (Delay_Length_Subtype);
+         else
+            Delay_Length_Subtype_Definition := Null_Iir;
+            Delay_Length_Subtype := 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_Iir (Iir_Kind_Implicit_Function_Declaration);
+         Set_Std_Identifier (Function_Now, Std_Names.Name_Now);
+         if Flags.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 Flags.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;
+
+      --  VHDL93:
+      --  type file_open_kind is (read_mode, write_mode, append_mode);
+      if Flags.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);
+
+         --  type file_open_kind is
+         File_Open_Kind_Type := Create_Std_Iir (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (File_Open_Kind_Type, Name_File_Open_Kind);
+         Set_Type (File_Open_Kind_Type, File_Open_Kind_Type_Definition);
+         Add_Decl (File_Open_Kind_Type);
+         Set_Type_Declarator (File_Open_Kind_Type_Definition,
+                              File_Open_Kind_Type);
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (File_Open_Kind_Type_Definition);
+         Add_Implicit_Operations (File_Open_Kind_Type);
+      else
+         File_Open_Kind_Type := 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 Flags.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);
+
+         --  type file_open_kind is
+         File_Open_Status_Type := Create_Std_Iir (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (File_Open_Status_Type, Name_File_Open_Status);
+         Set_Type (File_Open_Status_Type, File_Open_Status_Type_Definition);
+         Add_Decl (File_Open_Status_Type);
+         Set_Type_Declarator (File_Open_Status_Type_Definition,
+                              File_Open_Status_Type);
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (File_Open_Status_Type_Definition);
+         Add_Implicit_Operations (File_Open_Status_Type);
+      else
+         File_Open_Status_Type := 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 Flags.Vhdl_Std >= Vhdl_93c then
+         Foreign_Attribute := Create_Std_Iir (Iir_Kind_Attribute_Declaration);
+         Set_Std_Identifier (Foreign_Attribute, Name_Foreign);
+         Set_Type (Foreign_Attribute, String_Type_Definition);
+         Add_Decl (Foreign_Attribute);
+      else
+         Foreign_Attribute := Null_Iir;
+      end if;
+   end Create_Std_Standard_Package;
+end Std_Package;
diff --git a/std_package.ads b/std_package.ads
new file mode 100644
index 000000000..1429f8044
--- /dev/null
+++ b/std_package.ads
@@ -0,0 +1,169 @@
+--  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 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 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: 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: 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: Iir_Type_Declaration;
+   Character_Type_Definition : Iir_Enumeration_Type_Definition;
+
+   -- severity level.
+   Severity_Level_Type : 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 : Iir_Anonymous_Type_Declaration;
+   Universal_Integer_Type_Definition : constant Iir_Integer_Type_Definition;
+   Universal_Integer_Subtype : Iir_Subtype_Declaration;
+   Universal_Integer_Subtype_Definition : Iir_Integer_Subtype_Definition;
+
+   Universal_Integer_One : Iir_Integer_Literal;
+
+   Universal_Real_Type : Iir_Anonymous_Type_Declaration;
+   Universal_Real_Type_Definition : constant Iir_Floating_Type_Definition;
+   Universal_Real_Subtype : Iir_Subtype_Declaration;
+   Universal_Real_Subtype_Definition : Iir_Floating_Subtype_Definition;
+
+   -- Predefined integer type.
+   Integer_Type: Iir_Anonymous_Type_Declaration;
+   Integer_Type_Definition : Iir_Integer_Type_Definition;
+   Integer_Subtype : 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: Iir_Anonymous_Type_Declaration;
+   Real_Type_Definition : Iir_Floating_Type_Definition;
+   Real_Subtype : Iir_Subtype_Declaration;
+   Real_Subtype_Definition : Iir_Floating_Subtype_Definition;
+
+   -- Predefined natural subtype.
+   Natural_Subtype: Iir_Subtype_Declaration;
+   Natural_Subtype_Definition : Iir_Integer_Subtype_Definition;
+
+   -- Predefined positive subtype.
+   Positive_Subtype: Iir_Subtype_Declaration;
+   Positive_Subtype_Definition : Iir_Integer_Subtype_Definition;
+
+   -- Predefined positive subtype.
+   String_Type: Iir_Type_Declaration;
+   String_Type_Definition : Iir_Array_Type_Definition;
+
+   -- Predefined positive subtype.
+   Bit_Vector_Type: Iir_Type_Declaration;
+   Bit_Vector_Type_Definition : Iir_Array_Type_Definition;
+
+   -- predefined time subtype
+   Time_Type: Iir_Anonymous_Type_Declaration;
+   Time_Type_Definition: Iir_Physical_Type_Definition;
+   Time_Subtype_Definition: Iir_Physical_Subtype_Definition;
+   Time_Subtype : Iir_Subtype_Declaration;
+
+   --  For VHDL-93
+   Delay_Length_Subtype_Definition : Iir_Physical_Subtype_Definition;
+   Delay_Length_Subtype : Iir_Subtype_Declaration;
+
+   --  For VHDL-93:
+   --  type File_Open_Kind
+   File_Open_Kind_Type : 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 : 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;
+
+   --  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 : Iir_Anonymous_Type_Declaration;
+   Convertible_Real_Type : Iir_Anonymous_Type_Declaration;
+
+   Convertible_Integer_Subtype_Definition : Iir_Integer_Subtype_Definition;
+   Convertible_Integer_Subtype : 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/str_table.adb b/str_table.adb
new file mode 100644
index 000000000..1a1cde4af
--- /dev/null
+++ b/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 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_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 : Natural;
+   begin
+      Ptr := Get_String_Fat_Acc (Id);
+      Len := 1;
+      loop
+         if Ptr (Len) = Nul then
+            return 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 : Natural;
+   begin
+      Len := Get_Length (Id);
+      Ptr := Get_String_Fat_Acc (Id);
+      return Ptr (1 .. Len);
+   end Image;
+
+   procedure Initialize is
+   begin
+      String_Table.Free;
+      String_Table.Init;
+   end Initialize;
+end Str_Table;
diff --git a/str_table.ads b/str_table.ads
new file mode 100644
index 000000000..5044f8308
--- /dev/null
+++ b/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 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;
+
+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/tokens.adb b/tokens.adb
new file mode 100644
index 000000000..c426200c0
--- /dev/null
+++ b/tokens.adb
@@ -0,0 +1,325 @@
+--  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 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 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_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>";
+
+         -- 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 ">=";
+
+            -- sign token
+         when Tok_Plus =>
+            return "+";
+         when Tok_Minus =>
+            return "-";
+            -- and adding_operator
+         when Tok_Ampersand =>
+            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";
+
+            -- Key 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";
+
+         when Tok_Protected =>
+            return "protected";
+      end case;
+   end Image;
+
+end Tokens;
diff --git a/tokens.ads b/tokens.ads
new file mode 100644
index 000000000..2e7b2d640
--- /dev/null
+++ b/tokens.ads
@@ -0,0 +1,212 @@
+--  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 GCC; 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_Arrow,               -- =>
+       Tok_Tick,                -- '
+       Tok_Double_Star,         -- **
+       Tok_Assign,              -- :=
+       Tok_Bar,                 -- |
+       Tok_Box,                 -- <>
+       Tok_Dot,                 -- .
+
+       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,       -- >=
+
+   -- sign token
+       Tok_Plus,                -- +
+       Tok_Minus,               -- -
+   -- and adding_operator
+       Tok_Ampersand,           -- &
+
+   -- 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);
+
+   -- subtype Token_Relation_Type is Token_Type range Tok_And .. Tok_Xnor;
+   subtype Token_Relational_Operator_Type is Token_Type range
+     Tok_Equal .. Tok_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/translate/Makefile b/translate/Makefile
new file mode 100644
index 000000000..32128c439
--- /dev/null
+++ b/translate/Makefile
@@ -0,0 +1,65 @@
+#  -*- 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.. -gnaty3befhkmr -gnata -gnatf -gnatwlcru
+#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
+
+#ortho_nodes.ads: ortho_nodes.tmp
+#	if cmp -s $@ $< ; then \
+#	 rm -f $<; \
+#	else \
+#	 mv $< $@; \
+#	fi
+
+#BE_Case:=$(shell echo $(BE) | sed -e "h" -e "s/.\(.*\)/\1/" -e "x" -e "s/\(.\).*/\1/" -e "y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/" -e 'G'  -e 's/\n//"
+
+#BE_Case:=$(shell echo $(BE) | sed -e "s/debug/Debug/" -e "s/regen/Regen/")
+
+#ortho_nodes.tmp: force
+#	echo "with Ortho_$(BE_Case);" > $@
+#	echo "" >> $@
+#	echo "package Ortho_Nodes renames Ortho_$(BE_Case);" >> $@
+
+#ortho_$(BE)_front.ads: Makefile
+#	echo "with Ortho_Front;" > $@
+#	echo "package Ortho_$(BE_Case)_Front renames Ortho_Front;" >> $@
+
+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/translate/TODO b/translate/TODO
new file mode 100644
index 000000000..c2da8aa21
--- /dev/null
+++ b/translate/TODO
@@ -0,0 +1,342 @@
+BUGS:
+* GCC 4.0.1
+* bug may25 rob chapman (interface).
+* bug jun14 peter TB brett (unconstr out assigned with (others => x))
+* bug stephen leak
+* bug elab of pr/warnings-0/conf1.vhdl (unconstrained signals)
+* bug ~/conf2.vhdl: arch subprogram is not translated for config (check with
+  ghdl1-debug).
+* bug ~/conf3.vhdl: problem while counting signals.
+* from a typical vhdl file, create new files with 1 or more tokens removed.
+  Check diags.
+* bug IR2069
+* bug unconstrained port and func conv: see IR2064
+* bug david-kuehling with signals (array_subtype_ptr)
+* translate_object: no parent.
+* waves: verilog types, physical types.
+* waves: ghwdump util to be put into ghdl exec ?
+* grt: --dump-rti, --dump-signals: modules?
+todo: web site: add ghdl.ps, ghdl.pdf
+
+PEFS:
+* DONE: add an hash table for primary unit (cf unisim).
+* use hash table for get_lastest_arch
+* DONE: ieee_xxx_resolv for ghdl_run
+
+* TOP:
+* vhdl93
+* DONE: new node format
+* DONE: grt: do not depends on libgnat [malloc/free; gnat.table; rcheck; stdio]
+* sem_name: check all possibilities, recursion on prefix for finish_ and free.
+
+* length : use left and right from type range if any.
+* subtype descriptor : can be a const.
+* checks on type (values out of bounds).
+* deallocate: in depth.
+* iterator on array elements.
+
+* GHDL:
+* DONE: val_staticness for aggregates
+* libraries: the first line of the .cf files must contains options/standard.
+* global file for setup (vhdl version, mapping)
+* eval static expressions automaticaly.
+* check for no return in a function, generate code to catch this error.
+* DONE: detect no wait in processes.
+* clean-up dependences check (cf libraries.is_obsolete)
+* AMS-VHDL: reserved keywords
+* replace implicit_functions of type decl with implicit_subprograms
+* add an option to disable eval_if_static_expr (to check more).
+* handle "-- pragma xxx"
+* handle locally static disconnection_spec in canon
+* use MD5/SHA1 instead of dates
+* add_dependence: add a flag to mark dependence (to be restored/backuped)
+* visible_flag: check for operator
+* individual assocs: multi-dim arrays
+* static name: if the value is an access, the name is not static.
+* DONE: preference for universal primitives (function call).
+* check rules for building default sensitivity list.
+* overload in case/select signal assignment
+* array access subtype.
+* DONE: triple use clauses
+* DONE: use clauses (list)
+* visibility in configuration declaration.
+* DONE: hide implicit defined subprograms when overridden by explicit one.
+* DONE: script to do all checks from a tar file
+* DONE: sem_name -> sem_scopes
+* DONE: sem_names.ads/adb
+* DONE: eval string literal (add list)
+* DONE: export files for GCC, build in GCC.
+* DONE: name visibility
+* DONE: create iir_kind_error 
+* DONE: add base_name field for _name iirs.
+* DONE: check accesses with base_name.
+* attributes: check all entity name kind (labels, file...)
+* DONE: attributes: only one per simple name.
+* incremental binding: different entity in entity aspect of primary binding.
+* DONE: overload number in IIRS.
+* subprogram_instances: remove decl_type (only use ptr_type).
+* pure during elab: load package only if necessary.
+* purity state of implicit subprograms.
+* seen_flag: remove (unused).
+* DONE: location_end: add for design units.
+* 'image, 'value: eval_static_expr, to be completed.
+
+* IIRS:
+* formats: Declaration, Integer, Real, Small, Medium
+* + lists
+* common: kind/flags/staticness/digits (32), loc(32)
+          4 fields (4 * 32) + back_end (??) + parent (??)
+* Integer: + int (64) (?? for physicals: origin,unit,type)
+* real:    + real (64)
+* small:   + 2 fields (2 * 32)
+* medium:  + 2 + 7 fields (9 * 32)
+* Decls:   + link (32), ident (32), attr (32), parent (32),
+	     1+2+4 fields (7 * 32) + second link (?)
+
+* ghdlmake:
+* DONE: add object files from grt
+* selection of run time?
+* DONE: object files location (fix how std is currently handled).
+* verbose or long flag for -d: disp file name
+* handle multiple libraries
+* -n: do not compile/elaborate.
+* DONE: -cargs: additional args for compiler (+ -largs)
+* add dependences for all design units.
+* create or accept WAVES header for compilation order
+* -i: incremental analyse: analyse only if not up to date
+* -m: re-read library file before final elaboration, because dependences may
+  have changed.
+* -m : to be renamed to -u
+* use default configurations for dependences
+* DONE: add other files
+* add these options: --AS=, --LD=, --POST=, -static, -shared
+* -m bugs: hc11core, fphdl
+* create configuration
+* DONE: chop
+
+* VITAL:
+* CELLTYPE
+* finish Level0
+* SDF 3.0, 4.0
+* SDF: bus, all types
+* negative delay
+
+* elaboration:
+* DONE: late binding
+* DONE: should load the top entity to check for no generics nor in ports.
+* DONE: should load package body to check passive subprg/no wait in subprg.
+* elab port based on assoc list
+* bug if instantiated entity is the same as the current instance ?
+
+* grt:
+* DONE: vcd: dump only when value has changed.
+* vcd: handle record
+* create vcd/tdml header
+* set fpu in exception mode
+* DONE: resize process stacks/trap stack underflow
+* create a global event list, to increase speed (each signal is an element of
+  the list)
+* DONE: add name of processes (as an instance)
+
+* Optimizations:
+* DONE: reduce number of signals (components, instantiation...)
+* DONE: std_logic signals with only one driver.
+* range checks.
+
+* translate:
+* record/array file types
+* DONE: aggregate target for variables
+* DONE: create description of instance with an array instead of names
+* DONE: create names for prefix instead of uniq id
+* DONE: no type_desc for types that can't be used for signals (ex: types
+  defined in subprg or processes).
+* do not create signals types for constant/variable, but always create value
+  types.
+* rewrite procedure/function interfaces.
+* attribute names
+* do not translate all predefined subprograms: flag_use to be added
+  be careful to packages and entity.
+* WRONG: do not add instance for pure functions -> maybe required for types.
+* free info
+* DONE: finalization (files)
+* DONE: extended identifiers
+* check for no return in a function (and catch at execution time)
+* range check: be smarter
+* range for for-loop, slices, generates.
+* flag_review: add more comments.
+* DONE: alias : handle more than arrays.
+* add a length field in array bounds for multi-dim array
+* DONE: create an elaborator for components
+* NOT RELEVANT: check for unused types infrastructures (_STB for array index)
+* create signal builder for record/array (see composite_types.vhdl)
+* DONE: handle package body while not necessary
+* individual assoc in subprograms
+* individual assoc for predefined proc (file procedures)
+* check for file with same basename (ex: a.vhd and a.tvhd), since the object
+  file will overwrite (or add a number ex: 00_a.o 01_a.o)
+
+* ortho_gcc:
+* overflow
+* conversion
+
+* ortho:
+* DONE: check for use of variable out of its scope (add a in_use flag ?).
+* -> check for no enode after a statement.
+* standard types metrics.
+* DONE: check scope for variables/constant/subprograms.
+* enum -> new_lit
+* for debug: disp/read enum size.
+* new_ref -> from variable/interface/const to l_node
+* offset type
+* debug: check ident (redefine, overridden)
+
+* tests
+* all interfaces.
+* arrays: constant, variable, signal, alias, default value,
+          slice, assign, index, 'range,left,right,length attributes
+* alias
+
+* VHDL quizz:
+* A and B and C, where and is not predefined and not associative -> order
+  defined by lrm
+* event without value change -> not possible to create such a design
+* for I in 0 to 4 + 5 loop 
+* my_int; function "not" (v : my_int := 0) return my_int; var := "not";
+* read operation for array with multiple indexes -> not allowed
+* A <= (others => 0) where A is a subprogram formal interface whose type is
+  an unconstrained array.
+*B function returning a file type.
+* null string when index base type left bound has no pred.
+* arch x of y is
+    attribute my_attr of my_inst : label is 25;
+    component my_comp ... end component;
+  begin
+    my_inst : my_comp;
+  end x;
+  Is my_comp a component or a procedure call ? -> label
+* element declaration scope does not extend beyond a package scope -> the
+  package scope is extended along with the scope of the logical library.
+* labeled statement inside a for-loop can be attributed.
+* "wait on S'transaction' not allowed since an attribute is not a static name.
+*B constant c : integer := 3 ** 4; which "**" (universal or integer)?
+   or: constant c : integer := - 1; (which "-" ?)
+*B type chrptr is access character;
+  type chrptr_array is array (natural range <>) of chrptr;
+  -> creates an implicit function "&" whose interface is constant of type
+     access. 
+* package ch1003_002_pkg is
+     type my_bit is ('0', '1', 'X');
+     function "=" (l, r : my_bit) return boolean;
+  end ch1003_002_pkg;
+  ...
+  use work.ch1003_002_pkg.all;
+  ...
+       A = B --  A and B of type my_bit
+  Both the implicit and explicit "=" operator are visible!
+* package p is
+    function f return integer;
+  end p;
+  
+  use work.p.all;
+  package p is
+    constant c : integer := f;
+  end p;
+* redeclaration of a design unit in vhdl02 (not allowed ?)
+* 'FOREIGN for implicit subprograms ?
+* 'FOREIGN with non-locally static value
+*B alias of a physical type (not possible, since only the subtype is named).
+* 'a''attr -> not allowed.
+*B2 visibility in context clause:
+  library my_lib;
+  entity ent is end ent;
+
+  use my_lib.my_pkg.all;
+  architecture arch of ent is ...
+* 4.2 Subtype declarations: "if a type mark is the name of a type, the type
+  mark denotes this type and also the corresponding unconstrained subtype."
+  What is the corresponding subtype of an enumeration type ?
+  -> 3.0  "A type is a subtype of itself"
+* name'a'length has no characters...
+*B2 with expr select (a,b) <= "01" when c1, val when others;
+  -> type of aggregate is not determinable!!
+  -> or type of aggregate depends on the selected expression
+   (ex: (a,b) std_logic_vector and then std_ulogic_vector)
+* case statement: expression which is an indexed name and of unidim array type
+  (why are the indexes locally static expressions ?)
+* Is an alias overloadable (?) -> yes
+* 5.2 Configuration specification: 'others' -> meaning of 'previous'
+  incremental binding for different entity aspect.
+  component_configuration that is a primary binding for some instantiation
+    and an incremental binding indic for others.
+*B 14.1 'instance_name example: missing ';' after generic clause of BComp
+  component; missing ":" before gbottom'path_instance;
+  signature is added for subprograms but not for enumeration literals.
+  loop_label ?
+  staticness
+  root design entity (E'PATH_NAME) vs top design entity (E'INSTANCE_NAME)
+  meaning of signature ?
+* 10.3 (last paragraph of p 155): 'of a design unit_or' (place of '_').
+*B 3.5.1 vs 3.5.2: in examples: VariableSizedBitArray vs VariableSizeBitArray.
+* 4.2.2: is a default_expression globally static ?
+* 5.1: alias of attribute are allowed ->
+  constant obj : bit := '0';
+  attribute attr : integer;
+  alias attr1 is attr;
+  attribute attr of obj : constant is 5;
+  ...  obj'attr1 ...
+* 5.1: entity designator that denotes an alias .. required to denote the
+  entire object.  What means entire ? staticness of entire ?
+  constant obj : bit_vector (1 to 3);
+  alias obj1 : bit_vector (2 to 4) is obj (1 to 3);
+* 8.1:
+  process
+  begin
+     wait for time'high - now;
+  end process;
+  -> infinite loop or execute only once ?
+  (ie does it execute at time'high ?)
+*B Does a generate statement have a declarative_part ?
+  according to the BNF of 9.7 and glossary -> no
+  according to introduction of clause 9 -> yes
+  -> does configuration specification applies recursively ?
+* Can a design unit be decorated with an attribute specification whose entity
+  name list is all/others ? (cf notes of 5.1)
+* Can an alias be declared after an all/others attribute specification ?
+* Can a named entity be decorated through an alias not declared in the same
+  declarative part ?
+* Can an anonymous type declaration be decorated ?
+*B character literal can be decorated but not referenced.
+*B wait on sig (now < 10 ns);
+*B pure function can allocate memory and may return different value
+*B2 what it the meaning of a name when several non-overloadable declarations
+  are visible (one directly, one by selection).
+* 'value: only *one* leading/trailing whitespace allowed ?
+
+* libraries:
+* V:version, O:option, S:set/standard
+* F:file, D:depend, T:time, U:unit, L:location/line
+* A:architecture, E:entity, P:package, B:body, C:configuration
+* M:module/map (library name to filename), W:with (weak depend), X:translate
+* I:instanciated component
+* H:homedir
+* G J K N Q R Y Z
+* + search path, vhdl version, ieee libraries.
+
+* aggregates:
+- dynamic bounds -> special case
+- bounds are determinated by target
+- static bounds and determinated by the aggregate
+- static bounds and static values.
+
+BUGS:
+* no type descriptor is created for access.  However, a type descriptor is
+  created for array and use the type descriptor of its element.  What about
+  for array whose element is an access ?
+
+OPTIMIZATIONS:
+* for loop whose range is an array index.
+* avoid to initialize variable if not read before write.
+* avoid stupid range check (ex: a := b, when subtype b = subtype a).
+
+ERROR STORMS:
+* complex_tests: real_vector -> real_vectorX
diff --git a/translate/gcc/ANNOUNCE b/translate/gcc/ANNOUNCE
new file mode 100644
index 000000000..7b1060e20
--- /dev/null
+++ b/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/translate/gcc/Make-lang.in b/translate/gcc/Make-lang.in
new file mode 100644
index 000000000..2aa27a1e0
--- /dev/null
+++ b/translate/gcc/Make-lang.in
@@ -0,0 +1,182 @@
+# 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
+
+agcc_srcdir=$(srcdir)/vhdl
+agcc_objdir=.
+
+AGCC_GCCSRC_DIR=$(srcdir)/..
+AGCC_GCCOBJ_DIR=..
+
+####agcc Makefile.inc
+
+# 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): $(AGCC_OBJS) $(AGCC_DEPS) force
+	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 $(AGCC_OBJS) $(LIBS)
+
+# The driver for ghdl.
+ghdl$(exeext): force
+	$(MAKE_IN_VHDL) ../ghdl$(exeext)
+
+# Ghdl libraries.
+ghdllib: ghdl$(exeext) $(GCC_PASSES) force
+	$(MAKE_IN_VHDL) GRT_FLAGS="-O -g" 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:
+
+# 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: ghdl.info
+	-rm -rf $(infodir)/ghdl.info*
+	$(INSTALL_DATA) 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:
+
+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: agcc-clean
+vhdl.distclean:
+	-$(RM) vhdl/Makefile
+	-$(RM) ghdl$(exeext)
+vhdl.extraclean:
+
+vhdl.maintainer-clean:
+	$(RM) $(agcc_srcdir)/agcc-trees.ads $(agcc_srcdir)/agcc-hwint.ads
+	$(RM) $(agcc_srcdir)/agcc-hwint.ads $(agcc_srcdir)/agcc-gconfig.ads
+	$(RM) $(agcc_srcdir)/agcc-real.ads $(agcc_srcdir)/agcc-machmode.ads
+	$(RM) $(agcc_srcdir)/agcc-tm.ads
+	$(RM) $(agcc_exedir)/gen_tree.o $(agcc_exedir)/gen_tree
+
+
+# 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/translate/gcc/Makefile.in b/translate/gcc/Makefile.in
new file mode 100644
index 000000000..f459e6a09
--- /dev/null
+++ b/translate/gcc/Makefile.in
@@ -0,0 +1,275 @@
+# 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 =
+
+CC = cc
+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@
+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 = ..
+
+# 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 "   Compiler_Gcc : constant String :=" >> tmp-dpathes.ads
+	echo "     \"$(libexecsubdir)/ghdl1$(exeext)\";" >> tmp-dpathes.ads
+	echo "   Compiler_Debug : constant String :=\"\";" >> tmp-dpathes.ads
+	echo "   Compiler_Mcode : constant String :=\"\";" >> tmp-dpathes.ads
+	echo "   Post_Processor : constant String :=\"\";" >> tmp-dpathes.ads
+	echo "   Prefix : constant String :=">> tmp-dpathes.ads
+	echo "     \"$(libsubdir)/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
+
+LIB93_DIR:=./lib/v93
+LIB87_DIR:=./lib/v87
+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 $@
+
+ghdllib: std87_standard.o std93_standard.o libgrt.a
+
+ghdllibs-clean: force
+	$(RM) -rf $(LIB87_DIR) $(LIB93_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)
+	$(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 VHDL sources.
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/std
+	for i in $(STD93_SRCS) $(STD87_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
+# Create library dirs
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/lib/v93
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/lib/v87
+# 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 \
+	 ANALYZE="$$PDIR/../ghdl -a --GHDL1=$$PDIR/../ghdl1 --ieee=none" \
+	 std.v93 std.v87 ieee.v93 ieee.v87 synopsys.v93 synopsys.v87 mentor.v93
+# 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
diff --git a/translate/gcc/README b/translate/gcc/README
new file mode 100644
index 000000000..a3df511af
--- /dev/null
+++ b/translate/gcc/README
@@ -0,0 +1,54 @@
+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:
+***************************
+
+Required:
+* the sources of @GCCVERSION@ (at least the core part).
+  Note: other versions of gcc sources have not been tested.
+* the Ada95 GNAT compiler (only GNAT v3.15p is known to work).
+* GNU/Linux for ix86 (pc systems) (porting is necessary for other systems)
+
+Procedure:
+* 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.
+  Refer to the gcc installation documentation.
+* compile gcc.
+  'make CFLAGS="-O"' is OK (gcc 2.8.1 bugs with -O2 on some files).
+* install gcc.  This installs the ghdl driver too.
+  'make install' is OK.
+
+Send bugs and comments to ghdl@free.fr.
+If you cannot compile, please report the gcc version, GNAT version and gcc
+source version.
+
+Tristan Gingold.
diff --git a/translate/gcc/config-lang.in b/translate/gcc/config-lang.in
new file mode 100644
index 000000000..393d2277f
--- /dev/null
+++ b/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/agcc-bindings.c"
diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh
new file mode 100755
index 000000000..a946e4602
--- /dev/null
+++ b/translate/gcc/dist.sh
@@ -0,0 +1,670 @@
+#!/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
+
+VERSION=`sed -n -e 's/.*GHDL \([0-9.]*\) (.*/\1/p' ../../version.ads`
+
+CWD=`pwd`
+
+distdir=ghdl-$VERSION
+tarfile=$distdir.tar
+
+GCCVERSION=3.4.3
+DISTDIR=/home/gingold/dist
+GCCDIST=$DISTDIR/gcc-$GCCVERSION
+GCCDISTOBJ=$GCCDIST-objs
+PREFIX=/usr/local
+GCCLIBDIR=$PREFIX/lib/gcc/i686-pc-linux-gnu/$GCCVERSION
+GCCLIBEXECDIR=$PREFIX/libexec/gcc/i686-pc-linux-gnu/$GCCVERSION
+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 $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/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
+  sed -e "/^####agcc Makefile.inc/r ../../ortho/agcc/Makefile.inc" \
+     < Make-lang.in > $VHDLDIR/Make-lang.in
+}
+
+# Copy (or link) sources files into $VHDLDIR
+do_files ()
+{
+# Local files
+lfiles="config-lang.in lang-options.h lang-specs.h"
+for i in $lfiles; do ln -sf $CWD/$i $VHDLDIR/$i; done
+
+# ghdl core files
+cfiles="
+evaluation.adb
+evaluation.ads
+scan.ads
+scan.adb
+scan-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_specs.ads
+sem_specs.adb
+sem_stmts.ads
+sem_stmts.adb
+sem_types.ads
+sem_types.adb
+sem_assocs.ads
+sem_assocs.adb
+canon.adb
+canon.ads
+flags.adb
+flags.ads
+configuration.adb
+configuration.ads
+nodes.ads
+nodes.adb
+lists.ads
+lists.adb
+iirs.adb
+iirs.ads
+iir_chains.ads
+iir_chains.adb
+iir_chain_handling.ads
+iir_chain_handling.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
+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
+"
+
+for i in $cfiles; do ln -sf $CWD/../../$i $VHDLDIR/$i; done
+
+ln -sf $CWD/../../doc/ghdl.texi $VHDLDIR/ghdl.texi
+
+# translation file
+tfiles="
+translation.adb
+ortho_front.adb
+translation.ads
+trans_decls.ads
+trans_be.ads
+trans_be.adb"
+
+for i in $tfiles; do ln -sf $CWD/../$i $VHDLDIR/$i; done
+
+ortho_files="
+ortho_front.ads"
+
+for i in $ortho_files; do ln -sf $CWD/../../ortho/$i $VHDLDIR/$i; done
+
+ortho_gcc_files="
+agcc-fe.adb
+lang.opt
+ortho_ident.adb
+ortho_ident.ads
+ortho_gcc_front.ads
+ortho_nodes.ads
+ortho_gcc-main.adb
+ortho_gcc-main.ads
+ortho_gcc.ads
+ortho_gcc.adb"
+
+for i in $ortho_gcc_files; do
+  ln -sf $CWD/../../ortho/gcc/$i $VHDLDIR/$i
+done
+
+agcc_files="
+agcc-autils.adb
+agcc-autils.ads
+agcc-convert.ads
+agcc-fe.ads
+agcc-ggc.ads
+agcc-output.ads
+agcc-rtl.ads
+agcc-stor_layout.ads
+agcc-toplev.ads
+agcc-trees.adb
+agcc-diagnostic.ads
+agcc-libiberty.ads
+agcc.ads
+agcc.adb
+c.adb
+c.ads
+agcc-hconfig.ads.in
+agcc-hwint.ads.in
+agcc-machmode.ads.in
+agcc-real.ads.in
+agcc-tm.ads.in
+agcc-trees.ads.in
+agcc-options.ads.in
+agcc-input.ads
+agcc-bindings.c
+agcc-ghdl.c
+gen_tree.c"
+
+
+for i in $agcc_files; do
+  ln -sf $CWD/../../ortho/agcc/$i $VHDLDIR/$i
+done
+
+ghdl_files="
+ghdl_gcc.adb
+ghdldrv.ads
+ghdldrv.adb
+ghdlprint.ads
+ghdlprint.adb
+ghdllocal.ads
+ghdllocal.adb
+ghdlmain.ads
+ghdlmain.adb
+"
+
+for i in $ghdl_files; do
+  ln -sf $CWD/../ghdldrv/$i $VHDLDIR/ghdldrv/$i
+done
+
+libraries_files="
+std/textio.vhdl
+std/textio_body.vhdl
+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
+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
+"
+
+for i in $libraries_files; do
+    echo "adding $i"
+    ln -sf $CWD/../../libraries/$i $VHDLDIR/libraries/$i
+done
+
+grt_files="
+grt-cbinding.c
+grt-cvpi.c
+grt.adc
+grt-avhpi.adb
+grt-avhpi.ads
+grt-disp.adb
+grt-disp.ads
+grt-disp_rti.adb
+grt-disp_rti.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-values.adb
+grt-values.ads
+grt-lib.adb
+grt-lib.ads
+grt-main.adb
+grt-main.ads
+grt-names.adb
+grt-names.ads
+grt-options.adb
+grt-options.ads
+grt-processes.adb
+grt-processes.ads
+grt-rtis.ads
+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-stdio.ads
+grt-astdio.ads
+grt-astdio.adb
+grt-types.ads
+grt-vcd.adb
+grt-vcd.ads
+grt-vital_annotate.adb
+grt-vital_annotate.ads
+grt-vpi.adb
+grt-vpi.ads
+grt-vstrings.adb
+grt-vstrings.ads
+grt-stats.ads
+grt-stats.adb
+grt-waves.ads
+grt-waves.adb
+grt-avls.ads
+grt-avls.adb
+grt.ads
+main.adb
+main.ads
+ghdl_main.ads
+ghdl_main.adb
+ghwlib.h
+ghwlib.c
+ghwdump.c
+"
+
+for i in $grt_files; do
+    echo "adding $i"
+    ln -sf $CWD/../grt/$i $VHDLDIR/grt/$i
+done
+
+grt_config_files="
+i386.S
+sparc.S
+ppc.S
+times.c
+clock.c
+linux.c
+pthread.c
+win32.c"
+
+for i in $grt_config_files; do
+    echo "adding $i"
+    ln -sf $CWD/../grt/config/$i $VHDLDIR/grt/config/$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;
+
+  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 ()
+{
+#  check_root;
+  PATH=/usr/gnat/bin:$PATH
+  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/i686-pc-linux-gnu-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"
+}
+
+# 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 waveform.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;;
+      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;;
+      *)
+	echo "usage: $0 clean|Makefile|files|all"
+	exit 1 ;;
+     esac
+   done
+fi
diff --git a/translate/gcc/lang-options.h b/translate/gcc/lang-options.h
new file mode 100644
index 000000000..c92b12132
--- /dev/null
+++ b/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/translate/gcc/lang-specs.h b/translate/gcc/lang-specs.h
new file mode 100644
index 000000000..e8e79a2a8
--- /dev/null
+++ b/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},
+  {".vhdl", "@vhdl", 0},
+  {"@vhdl",
+   "ghdl1 %i %(cc1_options) %{!fsyntax-only:%(invoke_as)}", 0},
diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile
new file mode 100644
index 000000000..dc1b07df6
--- /dev/null
+++ b/translate/ghdldrv/Makefile
@@ -0,0 +1,114 @@
+#  -*- 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 -gnatwu -gnatwl -aI../..  -aI.. -aI../grt -aO.. -g -gnatf
+GRT_FLAGS=-g
+
+# 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
+
+GNAT_BARGS=-bargs -E
+
+#GNAT_LARGS= -static
+all: ghdl_mcode
+
+target=i686-pc-linux-gnu
+GRTSRCDIR=../grt
+include $(GRTSRCDIR)/Makefile.inc
+
+ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) mmap_binding.o force 
+	gnatmake -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs mmap_binding.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(GRT_EXTRA_LIB) 
+
+mmap_binding.o: ../../ortho/mcode/mmap_binding.c
+	$(CC) -c -g -o $@ $<
+
+ghdl_gcc: default_pathes.ads force 
+	gnatmake $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) -largs $(GNAT_LARGS)
+
+ghdl_simul: default_pathes.ads force
+	gnatmake -aI../../simulate $(GNATFLAGS) ghdl_simul $(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%@POST_PROCESSOR@%$$curdir/../ortho/oread/oread-gcc%" \
+	 -e "s%@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
+
+LIB_CFLAGS=-g -O2
+
+LIB93_DIR:=../lib/v93
+LIB87_DIR:=../lib/v87
+LIBSRC_DIR:=../../libraries
+REL_DIR:=../..
+ANALYZE:=../../../ghdldrv/ghdl -a $(LIB_CFLAGS)
+LN=ln -s
+CP=cp
+
+$(LIB87_DIR):
+	[ -d ../lib ] || mkdir ../lib
+	[ -d $(LIB87_DIR) ] || mkdir $(LIB87_DIR)
+
+$(LIB93_DIR):
+	[ -d ../lib ] || mkdir ../lib
+	[ -d $(LIB93_DIR) ] || mkdir $(LIB93_DIR)
+
+include ../../libraries/Makefile.inc
+
+GHDL1=../ghdl1-gcc
+$(LIB87_DIR)/std/std_standard.o: $(GHDL1)
+	$(GHDL1) --std=87 -quiet $(LIB_CFLAGS) -o std_standard.s \
+	 --compile-standard
+	$(CC) -c -o $@ std_standard.s
+	$(RM) std_standard.s
+
+$(LIB93_DIR)/std/std_standard.o: $(GHDL1)
+	$(GHDL1) --std=93 -quiet $(LIB_CFLAGS)  -o std_standard.s \
+	 --compile-standard
+	$(CC) -c -o $@ std_standard.s
+	$(RM) std_standard.s
+
+install.v93: std.v93 ieee.v93 synopsys.v93 mentor.v93
+install.v87: std.v87 ieee.v87 synopsys.v87
+
+install.standard: $(LIB93_DIR)/std/std_standard.o \
+ $(LIB87_DIR)/std/std_standard.o
+
+install.all: install.v87 install.v93 install.standard
+install.mcode: install.v87 install.v93
+
+clean: force
+	$(RM) -f *.o *.ali ghdl_gcc ghdl_mcode 
+	$(RM) -f b~*.ad? *~ default_pathes.ads
+
+force:
+
+.PHONY: force clean
diff --git a/translate/ghdldrv/default_pathes.ads.in b/translate/ghdldrv/default_pathes.ads.in
new file mode 100644
index 000000000..38085957d
--- /dev/null
+++ b/translate/ghdldrv/default_pathes.ads.in
@@ -0,0 +1,30 @@
+--  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
+   Compiler_Mcode : constant String :=
+     "@COMPILER_MCODE@";
+   Compiler_Gcc : constant String :=
+     "@COMPILER_GCC@";
+   Compiler_Debug : constant String :=
+     "@COMPILER_DEBUG@";
+   Post_Processor : constant String :=
+     "@POST_PROCESSOR@";
+   Prefix : constant String :=
+     "@PREFIX@";
+end Default_Pathes;
diff --git a/translate/ghdldrv/ghdl_gcc.adb b/translate/ghdldrv/ghdl_gcc.adb
new file mode 100644
index 000000000..5edb6bf38
--- /dev/null
+++ b/translate/ghdldrv/ghdl_gcc.adb
@@ -0,0 +1,33 @@
+--  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'("(Use the GCC back-end.)");
+   Ghdldrv.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Gcc;
diff --git a/translate/ghdldrv/ghdl_mcode.adb b/translate/ghdldrv/ghdl_mcode.adb
new file mode 100644
index 000000000..3506856ce
--- /dev/null
+++ b/translate/ghdldrv/ghdl_mcode.adb
@@ -0,0 +1,33 @@
+--  GHDL driver for mcode/jit.
+--  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 Ghdlrun;
+
+procedure Ghdl_Mcode is
+begin
+   --  Manual elaboration so that the order is known (because it is the order
+   --  used to display help).
+   Ghdlmain.Version_String := new String'("(Use the mcode code generator.)");
+   Ghdlrun.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Mcode;
diff --git a/translate/ghdldrv/ghdl_simul.adb b/translate/ghdldrv/ghdl_simul.adb
new file mode 100644
index 000000000..757feb223
--- /dev/null
+++ b/translate/ghdldrv/ghdl_simul.adb
@@ -0,0 +1,32 @@
+--  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).
+   Ghdlsimul.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Simul;
diff --git a/translate/ghdldrv/ghdlcomp.adb b/translate/ghdldrv/ghdlcomp.adb
new file mode 100644
index 000000000..93e40bba8
--- /dev/null
+++ b/translate/ghdldrv/ghdlcomp.adb
@@ -0,0 +1,745 @@
+--  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 Flags;
+with Back_End;
+with Sem;
+with Name_Table;
+with Errorout; use Errorout;
+with Libraries;
+with Std_Package;
+with Files_Map;
+with Version;
+
+package body Ghdlcomp is
+
+   Flag_Expect_Failure : Boolean := False;
+
+   --  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 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;
+   exception
+      when Errorout.Option_Error =>
+         raise;
+   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 : 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;
+   exception
+      when Errorout.Option_Error =>
+         raise;
+   end Perform_Action;
+
+   --  Command -a
+   type Command_Analyze is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Analyze) return String;
+   procedure Decode_Option (Cmd : in out Command_Analyze;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   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 Decode_Option (Cmd : in out Command_Analyze;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "--expect-failure" then
+         Flag_Expect_Failure := True;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   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;
+
+            --  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;
+         end if;
+      end loop;
+
+      if Flag_Expect_Failure then
+         raise Compilation_Error;
+      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;
+      when Errorout.Option_Error =>
+         raise;
+   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;
+      when Errorout.Option_Error =>
+         raise;
+   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;
+
+      Setup_Libraries (False);
+      Put ("library directory: ");
+      Put_Line (Prefix_Path.all);
+      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_Lib 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;
+   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_Version);
+      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 : 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/translate/ghdldrv/ghdlcomp.ads b/translate/ghdldrv/ghdlcomp.ads
new file mode 100644
index 000000000..f803ca4fa
--- /dev/null
+++ b/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/translate/ghdldrv/ghdldrv.adb b/translate/ghdldrv/ghdldrv.adb
new file mode 100644
index 000000000..d863f6189
--- /dev/null
+++ b/translate/ghdldrv/ghdldrv.adb
@@ -0,0 +1,1705 @@
+--  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 Version;
+
+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 : String_Access;
+
+   --  "-S" string.
+   Dash_S : String_Access;
+
+   --  "-quiet" option.
+   Dash_Quiet : String_Access;
+
+   type Compile_Kind_Type is (Compile_Mcode, Compile_Gcc, Compile_Debug);
+   Compile_Kind : Compile_Kind_Type := Compile_Gcc;
+
+   --  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;
+      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_Mcode =>
+            null;
+      end case;
+
+      --  Create obj file.
+      if Compile_Kind = Compile_Mcode or else not Flag_Asm
+      then
+         Obj_File := Append_Suffix (File, Get_Object_Suffix.all);
+      end if;
+
+      --  Compile.
+      declare
+         P : Natural;
+         Nbr_Args : 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.
+         if not Flag_Not_Quiet then
+            P := P + 1;
+            Args (P) := Dash_Quiet;
+         end if;
+
+         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 =>
+               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 : 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 : 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);
+
+   --  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 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;
+
+      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);
+         return;
+      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 Line (1) = '@' then
+                  File := new String'(Prefix_Path.all & Line (2 .. L));
+               else
+                  if To_Obj then
+                     File := new String'(Dir (1 .. Dir_Len)
+                                         & Get_Base_Name (Line (1 .. L))
+                                         & Get_Object_Suffix.all);
+                  else
+                     File := new String'(Line (1 .. L));
+                  end if;
+               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;
+
+      Dir : Name_Id;
+      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;
+
+      Dir := Get_Library_Directory (Get_Library (Design_File));
+      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;
+
+   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);
+         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;
+
+   procedure Locate_Tools
+   is
+   begin
+      Compiler_Path := Locate_Exec_On_Path (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_On_Path (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;
+      Dash_O := new String'("-o");
+      Dash_S := new String'("-S");
+      Dash_Quiet := new String'("-quiet");
+   end Locate_Tools;
+
+   procedure Setup_Compiler (Load : Boolean)
+   is
+      use Libraries;
+   begin
+      Set_Tools_Name;
+      Locate_Tools;
+      Setup_Libraries (Load);
+      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;
+      Compile_Kind := Compile_Gcc;
+      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;
+   begin
+      Res := Option_Bad;
+      if Option = "-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 Option'Length > 8 and then Option (1 .. 8) = "--GHDL1=" then
+         Compiler_Cmd := new String'(Option (9 .. Option'Last));
+         Res := Option_Ok;
+      elsif Option = "-S" then
+         Flag_Asm := True;
+         Res := Option_Ok;
+      elsif Option = "--post" then
+         Compile_Kind := Compile_Debug;
+         Res := Option_Ok;
+      elsif Option = "--mcode" then
+         Compile_Kind := Compile_Mcode;
+         Res := Option_Ok;
+      elsif Option = "-o" then
+         if Arg'Length = 0 then
+            Res := Option_Arg_Req;
+         else
+            Output_File := new String'(Arg);
+            Res := Option_Arg;
+         end if;
+      elsif Option'Length > 4
+        and then Option (2) = 'W' and then Option (4) = ','
+      then
+         if Option (3) = 'c' then
+            Add_Arguments (Compiler_Args, Option);
+         elsif Option (3) = 'a' then
+            Add_Arguments (Assembler_Args, Option);
+         elsif Option (3) = 'p' then
+            Add_Arguments (Postproc_Args, Option);
+         elsif Option (3) = 'l' then
+            Add_Arguments (Linker_Args, Option);
+         else
+            Error
+              ("unknown tool name in '-W" & Option (3) & ",' option");
+            raise Option_Error;
+         end if;
+         Res := Option_Ok;
+      elsif Option'Length >= 2 and then Option (2) = 'g' then
+         --  Debugging option.
+         Str := new String'(Option);
+         Add_Argument (Compiler_Args, Str);
+         Add_Argument (Linker_Args, Str);
+         Res := Option_Ok;
+      elsif Option'Length >= 2
+        and then (Option (2) = 'O' or Option (2) = 'f')
+      then
+         --  Optimization option.
+         Add_Argument (Compiler_Args, new String'(Option));
+         Res := Option_Ok;
+      elsif Option = "-Q" then
+         Flag_Not_Quiet := True;
+         Res := Option_Ok;
+      elsif Option = "--expect-failure" then
+         Add_Argument (Compiler_Args, new String'(Option));
+         Flag_Expect_Failure := True;
+         Res := Option_Ok;
+      elsif Flags.Parse_Option (Option) then
+         Add_Argument (Compiler_Args, new String'(Option));
+         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));
+      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 (" -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";
+   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 Option_Error;
+      end if;
+
+      Set_Tools_Name;
+      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);
+      Setup_Libraries (False);
+      Put ("library directory: ");
+      Put_Line (Prefix_Path.all);
+      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);
+      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 .. 2 * Files'Length + 2);
+      Flag_C : String_Access;
+      Index : Natural;
+   begin
+      Comp_List (1) := new String'("--anaelab");
+      Comp_List (2) := Unit_Name;
+      Flag_C := new String'("-c");
+      Index := 3;
+      for I in Files'Range loop
+         Comp_List (Index) := Flag_C;
+         Comp_List (Index + 1) := Files (I);
+         Index := Index + 2;
+      end loop;
+      Do_Compile (Comp_List, Elab_Name.all);
+      Free (Flag_C);
+      Free (Comp_List (1));
+   end Bind_Anaelab;
+
+   procedure Link (Add_Std : Boolean;
+                   Disp_Only : Boolean)
+   is
+      Last_File : Natural;
+   begin
+      --  read files list
+      if Filelist_Name /= null then
+         Add_File_List (Filelist_Name.all, True);
+      end if;
+      Last_File := Filelist.Last;
+      Add_File_List (Prefix_Path.all & "grt" & List_Suffix, False);
+
+      --  call the linker
+      declare
+         P : Natural;
+         Nbr_Args : 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, Get_Object_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'(Prefix_Path.all
+                      & Get_Version_Path & Directory_Separator
+                      & "std" & Directory_Separator
+                      & "std_standard" & Get_Object_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;
+   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
+         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 (humna 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;
+   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_Version);
+      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 : 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/translate/ghdldrv/ghdldrv.ads b/translate/ghdldrv/ghdldrv.ads
new file mode 100644
index 000000000..05b085626
--- /dev/null
+++ b/translate/ghdldrv/ghdldrv.ads
@@ -0,0 +1,20 @@
+--  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
+   procedure Register_Commands;
+end Ghdldrv;
diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb
new file mode 100644
index 000000000..3abd5559f
--- /dev/null
+++ b/translate/ghdldrv/ghdllocal.adb
@@ -0,0 +1,1052 @@
+--  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 Ghdlmain;
+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 Scan;
+with Sem;
+with Canon;
+with Errorout;
+with Configuration;
+with Files_Map;
+with Post_Sems;
+with Disp_Tree;
+
+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 : Boolean := True;
+
+   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 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;
+
+      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_Declaration 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
+      Std_Names.Std_Names_Initialize;
+      Libraries.Init_Pathes;
+      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);
+   begin
+      Res := Option_Bad;
+      if Option = "-v" and then Flag_Verbose = False then
+         Flag_Verbose := True;
+         Res := Option_Ok;
+      elsif Option'Length > 9 and then Option (1 .. 9) = "--PREFIX=" then
+         Prefix_Path := new String'(Option (10 .. Option'Last));
+         Res := Option_Ok;
+      elsif Option = "--ieee=synopsys" then
+         Flag_Ieee := Lib_Synopsys;
+         Res := Option_Ok;
+      elsif Option = "--ieee=mentor" then
+         Flag_Ieee := Lib_Mentor;
+         Res := Option_Ok;
+      elsif Option = "--ieee=none" then
+         Flag_Ieee := Lib_None;
+         Res := Option_Ok;
+      elsif Option = "--ieee=standard" then
+         Flag_Ieee := Lib_Standard;
+         Res := Option_Ok;
+      elsif Option'Length >= 2
+        and then (Option (2) = 'g' or Option (2) = 'O')
+      then
+         --  Silently accept -g and -O.
+         Res := Option_Ok;
+      else
+         if Flags.Parse_Option (Option) 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 ("Options:");
+      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 (bad)");
+      P ("    none: do not use a predefined ieee library");
+   end Disp_Long_Help;
+
+   function Get_Version_Path return String is
+   begin
+      case Flags.Vhdl_Std is
+         when Vhdl_87 =>
+            return "v87";
+         when Vhdl_93c
+           | Vhdl_93
+           | Vhdl_00
+           | Vhdl_02 =>
+            return "v93";
+      end case;
+   end Get_Version_Path;
+
+   procedure Add_Library_Path (Name : String)
+   is
+   begin
+      Libraries.Add_Library_Path
+        (Prefix_Path.all & Get_Version_Path & Directory_Separator
+         & Name & Directory_Separator);
+   end Add_Library_Path;
+
+   procedure Setup_Libraries (Load : Boolean)
+   is
+   begin
+      if Prefix_Path = null then
+         Prefix_Path := new String'(Default_Pathes.Prefix);
+      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_Declaration =>
+            Put ("architecture ");
+         when Iir_Kind_Configuration_Declaration =>
+            Put ("configuration ");
+         when Iir_Kind_Package_Declaration =>
+            Put ("package ");
+         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_Declaration =>
+            Put (" of ");
+            Image (Get_Identifier (Get_Entity (Unit)));
+            Put (Name_Buffer (1 .. Name_Length));
+         when Iir_Kind_Configuration_Declaration =>
+            if Id = Null_Identifier then
+               Put ("<default> of entity ");
+               Image (Get_Identifier (Get_Library_Unit (Get_Entity (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 : 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 : 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");
+   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_Files (Files : Argument_List; Save_Library : Boolean)
+   is
+      use Ada.Text_IO;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Next_Unit : Iir;
+   begin
+      Setup_Libraries (True);
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Id := Name_Table.Get_Identifier (Files (I).all);
+         if Flag_Verbose then
+            Put (Files (I).all);
+            Put_Line (":");
+         end if;
+         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
+                  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 if;
+      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.
+   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 GNAT.OS_Lib;
+      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 GNAT.OS_Lib;
+      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;
+      Ent_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_Declaration =>
+                  Ent_Unit := Get_Entity (Lib_Unit);
+                  Delete_Top_Unit (Image (Get_Identifier (Ent_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;
+
+   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 --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;
+         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;
+   begin
+      Name_Length := Name'Length;
+      Name_Buffer (1 .. Name_Length) := Name.all;
+      Scan.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 : 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_Disp_Standard);
+   end Register_Commands;
+end Ghdllocal;
diff --git a/translate/ghdldrv/ghdllocal.ads b/translate/ghdldrv/ghdllocal.ads
new file mode 100644
index 000000000..e1c2baa42
--- /dev/null
+++ b/translate/ghdldrv/ghdllocal.ads
@@ -0,0 +1,98 @@
+--  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);
+
+   --  Set with -v option.
+   Flag_Verbose : Boolean := False;
+
+   --  Suffix for asm files.
+   Asm_Suffix : constant String := ".s";
+
+   --  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~";
+
+   --  Path prefix for libraries.
+   Prefix_Path : String_Access := null;
+
+   Nul : constant Character := Character'Val (0);
+
+   --  Return FILENAME without the extension.
+   function Get_Base_Name (Filename : String; Remove_Dir : Boolean := True)
+                           return String;
+
+   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;
+
+   --  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/translate/ghdldrv/ghdlmain.adb b/translate/ghdldrv/ghdlmain.adb
new file mode 100644
index 000000000..bd2462ff8
--- /dev/null
+++ b/translate/ghdldrv/ghdlmain.adb
@@ -0,0 +1,355 @@
+--  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 Ada.Text_IO;
+with Ada.Command_Line;
+with Version;
+with Flags;
+with Bug;
+with Errorout;
+
+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, run your program");
+         Put_Line ("  with the --help option.");
+         Put_Line ("Please, refer to the GHDL manual for more information.");
+         Put_Line ("Report bugs to <ghdl@free.fr>.");
+      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 compiler 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;
+      Flags.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_Version);
+      if Version_String /= null then
+         Put_Line (Version_String.all);
+      end if;
+      Put_Line ("Written by Tristan Gingold.");
+      New_Line;
+      Put_Line ("Copyright (C) 2003, 2004, 2005 Tristan Gingold.");
+      Put_Line ("This is free software; see the source for copying conditions."
+                & " 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 : 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_Option_Help);
+      Register_Command (new Command_Version);
+   end Register_Commands;
+end Ghdlmain;
+
diff --git a/translate/ghdldrv/ghdlmain.ads b/translate/ghdldrv/ghdlmain.ads
new file mode 100644
index 000000000..c01f1d63e
--- /dev/null
+++ b/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/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb
new file mode 100644
index 000000000..d9de2df86
--- /dev/null
+++ b/translate/ghdldrv/ghdlprint.adb
@@ -0,0 +1,1561 @@
+--  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 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 Tokens;
+with Scan;
+with Version;
+with Xrefs;
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+
+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;
+
+   procedure PP_Html_File (File : Source_File_Entry)
+   is
+      use Scan;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Line : Natural;
+      Buf : File_Buffer_Acc;
+      Prev_Tok : Token_Type;
+
+      --  True if tokens are between 'end' and ';'
+      In_End : Boolean := False;
+
+      --  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);
+               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
+      Scan.Flag_Comment := True;
+      Scan.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.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;
+               In_End := True;
+            when Tok_Semi_Colon =>
+               In_End := False;
+               Disp_Spaces;
+               Disp_Text;
+            when Tok_Xnor .. Tok_Ror =>
+               if Flags.Vhdl_Std > Vhdl_87 then
+                  Disp_Reserved;
+               else
+                  Disp_Identifier;
+               end if;
+            when Tok_Protected =>
+               if Flags.Vhdl_Std >= Vhdl_00 then
+                  Disp_Reserved;
+               else
+                  Disp_Identifier;
+               end if;
+            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_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_Version);
+      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
+         Len : Natural;
+         Id : Name_Id;
+         Id1 : Name_Id;
+      begin
+         Id := Get_Identifier (Lib);
+         Len := Get_Name_Length (Id);
+         case Get_Kind (Lib) is
+            when Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Entity_Declaration
+              | Iir_Kind_Package_Declaration =>
+               null;
+            when Iir_Kind_Package_Body =>
+               Len := Len + 1 + 4; -- add -body
+            when Iir_Kind_Architecture_Declaration =>
+               Id1 := Get_Identifier (Get_Entity (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 : Name_Id;
+         P : Natural;
+
+         procedure Append (Str : String) is
+         begin
+            Res (P + 1 .. P + Str'Length) := Str;
+            P := P + Str'Length;
+         end Append;
+      begin
+         Id := Get_Identifier (Lib);
+         P := Res'First - 1;
+         case Get_Kind (Lib) is
+            when Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Entity_Declaration
+              | Iir_Kind_Package_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_Declaration =>
+               Image (Get_Identifier (Get_Entity (Lib)));
+               Append (Name_Buffer (1 .. Name_Length));
+               Append ("-");
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+            when others =>
+               null;
+         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 Scan;
+      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
+         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);
+         loop
+            Scan.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.
+            Put (String (Buf (Ptr .. Eptr - 1)));
+            New_Line;
+         end loop;
+      end loop;
+   end Perform_Action;
+
+   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
+      use Ada.Text_IO;
+   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 Scan;
+      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;
+   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;
+      else
+         Decode_Option (Command_Html (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Xref_Html)
+   is
+      use Ada.Text_IO;
+   begin
+      Disp_Long_Help (Command_Html (Cmd));
+      Put_Line ("-o DIR          Put generated files into DIR (def: html/)");
+      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;
+      Prev_Output : File_Access;
+   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;
+
+      Prev_Output := Current_Input;
+
+      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 : 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;
+   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;
+            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: ");
+                  Image (Get_Source_File_Directory (Cur_File));
+                  Put (Name_Buffer (1 .. Name_Length));
+                  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_Declaration =>
+                     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_Signal_Interface_Declaration =>
+                     C := 's';
+                  when Iir_Kind_Signal_Declaration =>
+                     C := 'S';
+                  when Iir_Kind_Constant_Interface_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');
+                     when others =>
+                        null;
+                  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_PP_Html);
+      Register_Command (new Command_Xref_Html);
+      Register_Command (new Command_Xref);
+   end Register_Commands;
+end Ghdlprint;
diff --git a/translate/ghdldrv/ghdlprint.ads b/translate/ghdldrv/ghdlprint.ads
new file mode 100644
index 000000000..e52bc008e
--- /dev/null
+++ b/translate/ghdldrv/ghdlprint.ads
@@ -0,0 +1,22 @@
+--  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/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb
new file mode 100644
index 000000000..df64ebc66
--- /dev/null
+++ b/translate/ghdldrv/ghdlrun.adb
@@ -0,0 +1,658 @@
+--  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 Binary_File; use Binary_File;
+with Binary_File.Memory;
+with Ortho_Mcode; use Ortho_Mcode;
+with Ortho_Code.Flags; use Ortho_Code.Flags;
+with Binary_File;
+with Interfaces;
+with System; use System;
+with Trans_Decls;
+with Ortho_Code.Binary;
+with Ortho_Code.Debug;
+with Ortho_Code.X86.Emits;
+with Types;
+with Iirs; use Iirs;
+with Flags;
+with Back_End;
+with Errorout; use Errorout;
+with Libraries;
+with Canon;
+with Trans_Be;
+with Translation;
+with Std_Names;
+with Ieee.Std_Logic_1164;
+
+with Binary_File.Elf;
+
+with Lists;
+with Str_Table;
+with Nodes;
+with Files_Map;
+with Name_Table;
+
+with Grt.Main;
+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 Ghdlcomp;
+
+package body Ghdlrun is
+   Snap_Filename : String_Access := null;
+
+   procedure Compile_Init (Analyze_Only : Boolean) is
+   begin
+      Back_End.Sem_Foreign := Trans_Be.Sem_Foreign'Access;
+
+      if Analyze_Only then
+         return;
+      end if;
+
+      -- Initialize.
+      Back_End.Finish_Compilation := Trans_Be.Finish_Compilation'Access;
+
+      Setup_Libraries (False);
+      Libraries.Load_Std_Library;
+
+      Ortho_Mcode.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;
+
+      Ortho_Mcode.Finish;
+   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;
+
+   --  Toplevel function, defined by grt.
+   Flag_String : String (1 .. 5);
+   pragma Export (C, Flag_String, "__ghdl_flag_string");
+
+   procedure Ghdl_Elaborate;
+   pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE");
+
+   type Elaborate_Acc is access procedure;
+   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;
+
+   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");
+
+   --  From GCC.
+   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");
+
+   function Find_Untruncated_Text_Read return O_Dnode
+   is
+      use Types;
+      use Std_Names;
+      File, Unit, Lib, Decl : Iir;
+   begin
+      if Libraries.Std_Library = Null_Iir then
+         return O_Dnode_Null;
+      end if;
+      File := Get_Design_File_Chain (Libraries.Std_Library);
+      L1 : loop
+         if File = Null_Iir then
+            return O_Dnode_Null;
+         end if;
+         Unit := Get_First_Design_Unit (File);
+         while Unit /= Null_Iir loop
+            Lib := Get_Library_Unit (Unit);
+            if Get_Kind (Lib) = Iir_Kind_Package_Body
+              and then Get_Identifier (Lib) = Name_Textio
+            then
+               exit L1;
+            end if;
+            Unit := Get_Chain (Unit);
+         end loop;
+         File := Get_Chain (File);
+      end loop L1;
+
+      Decl := Get_Declaration_Chain (Lib);
+      while Decl /= Null_Iir loop
+         if Get_Kind (Decl) = Iir_Kind_Procedure_Declaration
+           and then Get_Identifier (Decl) = Name_Untruncated_Text_Read
+         then
+            if not Get_Foreign_Flag (Decl) then
+               raise Program_Error;
+            end if;
+            return Translation.Get_Ortho_Decl (Decl);
+         end if;
+         Decl := Get_Chain (Decl);
+      end loop;
+      return O_Dnode_Null;
+   end Find_Untruncated_Text_Read;
+
+   procedure Def (Decl : O_Dnode; Addr : Address)
+   is
+      use Ortho_Code.Binary;
+   begin
+      Binary_File.Memory.Set_Symbol_Address (Get_Decl_Symbol (Decl), Addr);
+   end Def;
+
+   function Get_Address (Decl : O_Dnode) return Address
+   is
+      use Interfaces;
+      use Ortho_Code.Binary;
+
+      function Conv is new Ada.Unchecked_Conversion
+        (Source => Unsigned_32, Target => Address);
+   begin
+      return Conv (Get_Symbol_Vaddr (Get_Decl_Symbol (Decl)));
+   end Get_Address;
+
+   procedure Run
+   is
+      use Binary_File;
+      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;
+
+      if Ortho_Code.Debug.Flag_Debug_Hli then
+         --  Can't generate code in HLI.
+         raise Compile_Error;
+      end if;
+
+      Binary_File.Memory.Write_Memory_Init;
+
+      Def (Trans_Decls.Ghdl_Memcpy,
+           Grt.Lib.Ghdl_Memcpy'Address);
+      Def (Trans_Decls.Ghdl_Bound_Check_Failed_L0,
+           Grt.Lib.Ghdl_Bound_Check_Failed_L0'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_Assert_Default_Report,
+           Grt.Lib.Ghdl_Assert_Default_Report'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_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_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_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_B2,
+           Grt.Signals.Ghdl_Signal_Driving_Value_B2'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_E8,
+           Grt.Signals.Ghdl_Signal_Driving_Value_E8'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_Start_Assign_Null,
+           Grt.Signals.Ghdl_Signal_Start_Assign_Null'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_B2,
+           Grt.Signals.Ghdl_Create_Signal_B2'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_B2,
+           Grt.Signals.Ghdl_Signal_Init_B2'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_B2,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_B2'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_B2,
+           Grt.Signals.Ghdl_Signal_Start_Assign_B2'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_B2,
+           Grt.Signals.Ghdl_Signal_Next_Assign_B2'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_B2,
+           Grt.Signals.Ghdl_Signal_Associate_B2'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_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_Top_Instance,
+           Grt.Rtis.Ghdl_Rti_Top_Instance'Address);
+      Def (Trans_Decls.Ghdl_Rti_Top_Ptr,
+           Grt.Rtis.Ghdl_Rti_Top_Ptr'Address);
+      Std_Standard_Boolean_RTI_Ptr :=
+        Get_Address (Trans_Decls.Std_Standard_Boolean_Rti);
+      Std_Standard_Bit_RTI_Ptr :=
+        Get_Address (Trans_Decls.Std_Standard_Bit_Rti);
+      if Ieee.Std_Logic_1164.Resolved /= Null_Iir then
+         Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address
+           (Translation.Get_Resolv_Ortho_Decl (Ieee.Std_Logic_1164.Resolved));
+      end if;
+
+      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_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_Close,
+           Grt.Files.Ghdl_File_Close'Address);
+      Def (Trans_Decls.Ghdl_File_Elaborate,
+           Grt.Files.Ghdl_File_Elaborate'Address);
+      Def (Trans_Decls.Ghdl_File_Open,
+           Grt.Files.Ghdl_File_Open'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_B2,
+           Grt.Images.Ghdl_Image_B2'Address);
+      Def (Trans_Decls.Ghdl_Image_E8,
+           Grt.Images.Ghdl_Image_E8'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_I32,
+           Grt.Values.Ghdl_Value_I32'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);
+
+      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);
+
+      --  Find untruncated_text_read, if any.
+      Decl := Find_Untruncated_Text_Read;
+      if Decl /= O_Dnode_Null then
+         Def (Decl, Grt.Files.Ghdl_Untruncated_Text_Read'Address);
+      end if;
+
+      Binary_File.Memory.Write_Memory_Relocate (Err);
+      if Err then
+         raise Compile_Error;
+      end if;
+
+      Flag_String := Flags.Flag_String;
+
+      Elaborate_Proc := Conv (Get_Address (Trans_Decls.Ghdl_Elaborate));
+
+      if Snap_Filename /= null then
+         declare
+            Fd : File_Descriptor;
+         begin
+            Fd := Create_File (Snap_Filename.all, Binary);
+            if Fd = Invalid_FD then
+               Error_Msg_Option ("can't open '" & Snap_Filename.all & "'");
+            else
+               Binary_File.Elf.Write_Elf (Fd);
+               Close (Fd);
+            end if;
+         end;
+      end if;
+
+      --  Free all the memory.
+      Ortho_Mcode.Free_All;
+
+      Translation.Finalize;
+      Lists.Initialize;
+      Str_Table.Initialize;
+      Nodes.Initialize;
+      Files_Map.Initialize;
+      Name_Table.Initialize;
+      Binary_File.Finish;
+
+      if Flag_Verbose then
+         Ada.Text_IO.Put_Line ("Starting simulation");
+      end if;
+
+      Grt.Main.Run;
+      --V := Ghdl_Main (1, Gnat_Argv);
+   end Run;
+
+   function Decode_Option (Option : String) return Boolean
+   is
+   begin
+      if Option = "-g" then
+         Flag_Debug := Debug_Dwarf;
+         return True;
+      elsif Option'Length > 5 and then Option (1 .. 5) = "--be-" then
+         Ortho_Code.Debug.Set_Be_Flag (Option);
+         return True;
+      elsif Option'Length > 7 and then Option (1 .. 7) = "--snap=" then
+         Snap_Filename := new String'(Option (8 .. Option'Last));
+         return True;
+      else
+         return False;
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_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_Long_Help;
+
+
+   --  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.Main.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,
+                         Decode_Option'Access,
+                         Disp_Long_Help'Access);
+      Ghdlcomp.Register_Commands;
+      Register_Command (new Command_Run_Help);
+   end Register_Commands;
+end Ghdlrun;
diff --git a/translate/ghdldrv/ghdlrun.ads b/translate/ghdldrv/ghdlrun.ads
new file mode 100644
index 000000000..07095bd5d
--- /dev/null
+++ b/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/translate/ghdldrv/ghdlsimul.adb b/translate/ghdldrv/ghdlsimul.adb
new file mode 100644
index 000000000..506b2ed02
--- /dev/null
+++ b/translate/ghdldrv/ghdlsimul.adb
@@ -0,0 +1,142 @@
+--  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 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 Canon;
+with Configuration;
+with Annotations;
+with Elaboration;
+with Sim_Be;
+with Simulation;
+
+with Ghdlcomp;
+
+package body Ghdlsimul is
+
+   Flag_Expect_Failure : Boolean := False;
+
+   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;
+   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);
+
+      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
+      Arg : String_Access;
+   begin
+      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
+            Flag_Expect_Failure := True;
+         elsif Arg.all = "--trace-elab" then
+            Elaboration.Trace_Elaboration := True;
+         elsif Arg.all = "--trace-simu" then
+            Simulation.Trace_Simulation := True;
+         else
+            null;
+         end if;
+      end loop;
+   end Set_Run_Options;
+
+   procedure Run
+   is
+      use Name_Table;
+      use Types;
+
+      First_Id : Name_Id;
+      Sec_Id : Name_Id;
+      Top_Conf : Iir;
+   begin
+      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);
+
+      Simulation.Simulation_Entity (Top_Conf);
+   end Run;
+
+   function Decode_Option (Option : String) return Boolean
+   is
+      pragma Unreferenced (Option);
+   begin
+      return False;
+   end Decode_Option;
+
+   procedure Disp_Long_Help
+   is
+   begin
+      null;
+   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/translate/ghdldrv/ghdlsimul.ads b/translate/ghdldrv/ghdlsimul.ads
new file mode 100644
index 000000000..264cbf8c6
--- /dev/null
+++ b/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/translate/grt/Makefile b/translate/grt/Makefile
new file mode 100644
index 000000000..2b60de150
--- /dev/null
+++ b/translate/grt/Makefile
@@ -0,0 +1,51 @@
+#  -*- 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
+
+ADAC=gnatgcc
+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=i686-pc-linux-gnu
+
+all: grt-all
+install: grt-install
+clean: grt-clean
+	$(RM) *~
+
+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/translate/grt/Makefile.inc b/translate/grt/Makefile.inc
new file mode 100644
index 000000000..9300770a8
--- /dev/null
+++ b/translate/grt/Makefile.inc
@@ -0,0 +1,161 @@
+#  -*- 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: compilation flags.
+
+# Set target files.
+ifeq ($(filter-out i%86-pc-linux-gnu,$(target)),)
+  GRT_TARGET_OBJS=i386.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl
+endif
+ifeq ($(filter-out sparc-sun-solaris%,$(target)),)
+  GRT_TARGET_OBJS=sparc.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl
+endif
+ifeq ($(filter-out powerpc-linux%,$(target)),)
+  GRT_TARGET_OBJS=ppc.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl
+endif
+ifeq ($(filter-out i%86-pc-mingw32,$(target)),)
+  GRT_TARGET_OBJS=win32.o clock.o
+endif
+ifeq ($(filter-out i%86-pc-cygwin,$(target)),)
+  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
+endif
+
+GRT_ADD_OBJS=$(GRT_TARGET_OBJS) grt-cbinding.o grt-cvpi.o
+
+GRT_PRAGMA_FLAG=-gnatec$(GRTSRCDIR)/grt.adc
+
+GRT_OBJS_FILES=\
+grt.o \
+grt-disp.o \
+grt-main.o \
+grt-stacks.o \
+grt-errors.o \
+grt-options.o \
+grt-stdio.o \
+grt-files.o \
+grt-processes.o \
+grt-typedesc.o \
+grt-hierarchy.o \
+grt-shadow_ieee.o \
+grt-types.o \
+grt-images.o \
+grt-signals.o \
+grt-vcd.o \
+grt-vpi.o \
+grt-lib.o \
+grt-sdf.o \
+grt-stack2.o \
+grt-names.o
+
+GRT_ADACOMPILE=$(ADAC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-all: libgrt.a grt.lst
+
+libgrt.a: $(GRT_ADD_OBJS) run-bind.o main.o grt-files
+	$(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 \
+	  -cargs $(GRT_FLAGS)
+	gnatbind -Lgrt_ -o run-bind.adb -n ghdl_main.ali
+
+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 $@ $<
+
+sparc.o: $(GRTSRCDIR)/config/sparc.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+ppc.o: $(GRTSRCDIR)/config/ppc.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+linux.o: $(GRTSRCDIR)/config/linux.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+win32.o: $(GRTSRCDIR)/config/win32.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-files: run-bind.adb
+	sed -e "1,/-- *BEGIN/d" -e "/-- *END/,\$$d" \
+	  -e "s/   --   //" < $< > $@
+
+# 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.
+grt-files.in: grt-files
+	sed -e "\!^./!d" -e "/-shared/d" < $< > $@
+
+grt.lst: grt-files.in
+	echo "@/libgrt.a" > $@
+ifdef GRT_EXTRA_LIB
+	echo $(GRT_EXTRA_LIB) >> $@
+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/translate/grt/config/clock.c b/translate/grt/config/clock.c
new file mode 100644
index 000000000..038ce2210
--- /dev/null
+++ b/translate/grt/config/clock.c
@@ -0,0 +1,36 @@
+/*  GRT C bindings for time.
+    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 <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/translate/grt/config/i386.S b/translate/grt/config/i386.S
new file mode 100644
index 000000000..fbd8954cb
--- /dev/null
+++ b/translate/grt/config/i386.S
@@ -0,0 +1,108 @@
+/*  GRT stack implementation for x86.
+    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.
+*/
+	.file		"i386.S"
+	.version	"01.01"
+	
+	.text
+
+	/* Function called to loop on the process.  */	
+	.align 4
+	.type	grt_stack_loop,@function
+grt_stack_loop:	
+	call	*4(%esp)
+	jmp	grt_stack_loop
+	.size	grt_stack_loop, . - grt_stack_loop
+
+	/* function Stack_Create (Func : Address; Arg : Address)
+ 	                          return Stack_Type;
+	*/
+	.align	4
+	.globl grt_stack_create
+	.type	 grt_stack_create,@function
+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	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.  */
+	movl	$grt_stack_loop, -12(%eax)
+	/* 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
+	.size	 grt_stack_create,. - grt_stack_create
+
+
+
+	.align 4
+	.globl grt_stack_switch
+	/* Arguments:	TO, FROM
+	   Both are pointers to a stack_context.  */
+	.type	 grt_stack_switch,@function
+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
+	.size	 grt_stack_switch, . - grt_stack_switch
+
+	
+	.ident	"Written by T.Gingold"
diff --git a/translate/grt/config/linux.c b/translate/grt/config/linux.c
new file mode 100644
index 000000000..047cfd1b4
--- /dev/null
+++ b/translate/grt/config/linux.c
@@ -0,0 +1,268 @@
+/*  GRT stacks implementation for linux and other *nix.
+    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.
+*/
+#define _GNU_SOURCE
+#include <unistd.h>
+#include <sys/mman.h>
+#include <signal.h>
+#include <fcntl.h>
+#include <sys/ucontext.h>
+//#include <stdint.h>
+
+/* 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
+#endif
+
+/* Defined in Grt.Stacks.  */
+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;
+};
+
+/* Context for the main stack.  */
+static struct stack_context main_stack_context;
+
+extern struct stack_context *grt_stack_main_stack;
+
+/* 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
+/* Defined in Grt.Processes (body).
+   This is the current process being run.
+   FIXME: this won't work with pthread!  */
+extern void **grt_cur_proc;
+
+/* 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
+
+/* 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 __i386__
+  /* Linux generates a SIGSEGV (!) for an overflow exception.  */
+  if (uctxt->uc_mcontext.gregs[REG_TRAPNO] == 4)
+    {
+      grt_overflow_error ();
+    }
+#endif
+
+  if (info == NULL || grt_cur_proc == NULL || in_handler > 1)
+    {
+      /* We loose.  */
+      sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
+      return;
+    }
+
+  addr = info->si_addr;
+  
+  /* Check ADDR belong to the stack.  */
+  ctxt = *grt_cur_proc;
+  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 (SIGSEGV, &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_ONESHOT | SA_ONSTACK | SA_SIGINFO;
+
+  /* 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 (SIGSEGV, &sigsegv_act, &prev_sigsegv_act);
+}
+#endif
+
+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_stack_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
+
+  res->cur_sp = (void *)res;
+  res->cur_length = stack_size;
+  return res;
+}
diff --git a/translate/grt/config/ppc.S b/translate/grt/config/ppc.S
new file mode 100644
index 000000000..ccfdc2209
--- /dev/null
+++ b/translate/grt/config/ppc.S
@@ -0,0 +1,327 @@
+/*  GRT stack implementation for ppc.
+    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.
+*/
+	.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/translate/grt/config/pthread.c b/translate/grt/config/pthread.c
new file mode 100644
index 000000000..f611bb615
--- /dev/null
+++ b/translate/grt/config/pthread.c
@@ -0,0 +1,157 @@
+/*  GRT stack implementation based on pthreads.
+    Copyright (C) 2003, 2004, 2005 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>
+
+
+//#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
+	void                (*Func)(void*); // stack's FUNC
+	void*               Arg;            // ARG passed to FUNC
+} Stack_Type_t, *Stack_Type;
+
+Stack_Type_t      main_stack_context;
+extern Stack_Type grt_stack_main_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);
+	
+	pthread_mutex_init(&(main_stack_context.mutex), NULL);
+
+	// lock the mutex, as we are currently running
+	pthread_mutex_lock(&(main_stack_context.mutex));
+	
+	grt_stack_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;
+
+	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
+	pthread_mutex_init(&(newStack->mutex), NULL);
+	
+	// block the mutex, so that thread will blocked in grt_stack_loop
+	pthread_mutex_lock(&(newStack->mutex));
+	
+	INFO("  newStack=0x%08x\n", newStack);
+	
+	// create thread, which executes grt_stack_loop
+	pthread_create(&(newStack->thread), NULL, grt_stack_loop, newStack); 
+	
+	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);
+	
+	// unlock 'To' mutex. this will make the other thread either
+	// - starts for first time in grt_stack_loop
+	// - resumes at lock below
+	pthread_mutex_unlock(&(To->mutex));
+		
+	// 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
+	pthread_mutex_lock(&(From->mutex));
+}
+
+//------------------------------------------------------------------------------
+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 __gnat_raise_storage_error(void)
+{
+   abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+   abort ();
+}
+
+//------------------------------------------------------------------------------
+// end of file
+
diff --git a/translate/grt/config/sparc.S b/translate/grt/config/sparc.S
new file mode 100644
index 000000000..698d49eb4
--- /dev/null
+++ b/translate/grt/config/sparc.S
@@ -0,0 +1,134 @@
+/*  GRT stack implementation for x86.
+    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.
+*/
+	.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/translate/grt/config/times.c b/translate/grt/config/times.c
new file mode 100644
index 000000000..7a6dd5d82
--- /dev/null
+++ b/translate/grt/config/times.c
@@ -0,0 +1,48 @@
+/*  GRT C bindings for time.
+    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 <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/translate/grt/config/win32.c b/translate/grt/config/win32.c
new file mode 100644
index 000000000..6c55f7b8a
--- /dev/null
+++ b/translate/grt/config/win32.c
@@ -0,0 +1,164 @@
+/*  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;
+
+Stack_Type_t      main_stack_context;
+extern Stack_Type grt_stack_main_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_stack_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");
+}
+
+//------------------------------------------------------------------------------
+void __gnat_raise_storage_error(void)
+{
+   abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+   abort ();
+}
+
+//------------------------------------------------------------------------------
+// end of file
+
diff --git a/translate/grt/ghdl_main.adb b/translate/grt/ghdl_main.adb
new file mode 100644
index 000000000..3ca98fb6b
--- /dev/null
+++ b/translate/grt/ghdl_main.adb
@@ -0,0 +1,51 @@
+--  GHDL Run Time (GRT) entry point.
+--  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.Unchecked_Conversion;
+with Grt.Options; use Grt.Options;
+with Grt.Main;
+with Grt.Types; use Grt.Types;
+
+pragma Warnings (Off);
+with Grt.Rtis_Binding;
+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/translate/grt/ghdl_main.ads b/translate/grt/ghdl_main.ads
new file mode 100644
index 000000000..a3636cb56
--- /dev/null
+++ b/translate/grt/ghdl_main.ads
@@ -0,0 +1,26 @@
+--  GHDL Run Time (GRT) entry point.
+--  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 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/translate/grt/ghwdump.c b/translate/grt/ghwdump.c
new file mode 100644
index 000000000..4affc2b5c
--- /dev/null
+++ b/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/translate/grt/ghwlib.c b/translate/grt/ghwlib.c
new file mode 100644
index 000000000..827e69851
--- /dev/null
+++ b/translate/grt/ghwlib.c
@@ -0,0 +1,1717 @@
+/*  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 <stdint.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)
+{
+  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 |= __INT64_C (-1) << 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_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)
+{
+  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)
+{
+  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)
+{
+  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]);
+
+  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:
+	  /* 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\n", el->name, nbr_el);
+	    if (ghw_read_signal (h, sigs, el->u.sig.type) < 0)
+	      return -1;
+#if 0
+	    for (i = 0; i < nbr_el; i++)
+	      {
+		unsigned int sig_el;
+
+		if (ghw_read_uleb128 (h, &sig_el) < 0)
+		  return -1;
+		sigs[i] = 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 (el->u.sig.type);
+		  }
+	      }
+	    sigs[i] = 0;
+#endif
+	  }
+	  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_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:
+	  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)
+{
+  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)
+{
+  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)
+    {
+      int32_t d;
+      
+      /* Read delta to next signal.  */
+      if (ghw_read_sleb128 (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;
+}
+
+void
+ghw_disp_value (union ghw_val *val, union ghw_type *type)
+{
+  switch (ghw_get_base_type (type)->kind)
+    {
+    case ghdl_rtik_type_b2:
+      printf ("%s (%d)", type->en.lits[val->b2], val->b2);
+      break;
+    case ghdl_rtik_type_e8:
+      printf ("%s (%d)", type->en.lits[val->e8], 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_range *rng)
+{
+  switch (rng->kind)
+    {
+    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->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 (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/translate/grt/ghwlib.h b/translate/grt/ghwlib.h
new file mode 100644
index 000000000..500dd6e9f
--- /dev/null
+++ b/translate/grt/ghwlib.h
@@ -0,0 +1,386 @@
+/*  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 <stdint.h>
+#include <stdlib.h>
+
+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_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;
+  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;
+
+  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;
+
+  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_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);
+
+void ghw_disp_range (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/translate/grt/grt-astdio.adb b/translate/grt/grt-astdio.adb
new file mode 100644
index 000000000..3c19cc851
--- /dev/null
+++ b/translate/grt/grt-astdio.adb
@@ -0,0 +1,193 @@
+--  GHDL Run Time (GRT) stdio subprograms for GRT 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 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 Grt.Astdio is
+   procedure Put (Stream : FILEs; Str : String)
+   is
+      S : size_t;
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, Stream);
+   end Put;
+
+   procedure Put (Stream : FILEs; C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), Stream);
+   end Put;
+
+   procedure Put (Stream : FILEs; Str : Ghdl_C_String)
+   is
+      Len : Natural;
+      S : size_t;
+   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;
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, stdout);
+   end Put;
+
+   procedure Put (C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), stdout);
+   end Put;
+
+   procedure Put (Str : Ghdl_C_String)
+   is
+      Len : Natural;
+      S : size_t;
+   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
+      if N > 0 then
+         V := -N;
+      else
+         V := N;
+      end if;
+      loop
+         Str (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;
+         Str (P) := '-';
+      end if;
+      Put (Stream, Str (P .. Max_Len));
+   end Put_Ntype;
+
+   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_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_F64 (Stream : FILEs; F64 : Ghdl_F64)
+   is
+      procedure fprintf (Stream : FILEs;
+                         Template : System.Address;
+                         Arg : Ghdl_F64);
+      pragma Import (C, fprintf);
+
+      Str : constant String := "%g" & Character'Val (0);
+   begin
+      fprintf (Stream, Str'Address, 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/translate/grt/grt-astdio.ads b/translate/grt/grt-astdio.ads
new file mode 100644
index 000000000..0791a1075
--- /dev/null
+++ b/translate/grt/grt-astdio.ads
@@ -0,0 +1,51 @@
+--  GHDL Run Time (GRT) stdio subprograms for GRT 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 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 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_I64 (Stream : FILEs; I64 : Ghdl_I64);
+   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/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb
new file mode 100644
index 000000000..fc38f8792
--- /dev/null
+++ b/translate/grt/grt-avhpi.adb
@@ -0,0 +1,868 @@
+--  GHDL Run Time (GRT) - VHPI implementation for 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.
+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_Ptr)),
+              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 => Loc_To_Addr (Ref.Obj.Common.Depth,
+                                                 Ref.Obj.Loc,
+                                                 Ref.Ctxt),
+                          N_Type => Ref.Obj.Obj_Type,
+                          N_Idx => 0,
+                          N_Obj => Ref.Obj);
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+                  return;
+            end case;
+            case Res.N_Type.Kind is
+               when Ghdl_Rtik_Subtype_Array =>
+                  declare
+                     St : Ghdl_Rtin_Subtype_Array_Acc :=
+                       To_Ghdl_Rtin_Subtype_Array_Acc (Res.N_Type);
+                     Bt : 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;
+
+   procedure Vhpi_Scan_Indexed_Name (Iterator : in out VhpiHandleT;
+                                     Res : out VhpiHandleT;
+                                     Error : out AvhpiErrorT)
+   is
+      procedure Update (S : Ghdl_Index_Type) is
+      begin
+         Iterator.N_Addr := Iterator.N_Addr + (S / Storage_Unit);
+      end Update;
+
+      Is_Sig : Boolean;
+      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.
+      case Iterator.N_Obj.Common.Kind is
+         when Ghdl_Rtik_Generic =>
+            Is_Sig := False;
+         when others =>
+            Internal_Error ("vhpi_scan_indexed_name(1)");
+      end case;
+
+      case Get_Base_Type (El_Type).Kind is
+         when Ghdl_Rtik_Type_P64 =>
+            if Is_Sig then
+               Update (Address'Size);
+            else
+               Update (Ghdl_I64'Size);
+            end if;
+         when others =>
+            Internal_Error ("vhpi_scan_indexed_name");
+      end case;
+      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.Off).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.Off,
+                                Block => Ch));
+               Error := AvhpiErrorOk;
+               return;
+            when Ghdl_Rtik_Block =>
+               Res := (Kind => VhpiBlockStmtK,
+                       Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc.Off,
+                                Block => Ch));
+               Error := AvhpiErrorOk;
+               return;
+            when Ghdl_Rtik_If_Generate =>
+               Res := (Kind => VhpiIfGenerateK,
+                       Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
+                                                     + Nblk.Loc.Off).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.Off).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
+           | Ghdl_Rtik_Subtype_Array_Ptr =>
+            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_B2
+           | Ghdl_Rtik_Type_E8 =>
+            Res := (Kind => VhpiEnumTypeDeclK,
+                    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;
+      Obj : Ghdl_Rtin_Object_Acc;
+   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);
+            Obj := To_Ghdl_Rtin_Object_Acc (Ch);
+
+            Iterator.It_Cur := Iterator.It_Cur + 1;
+
+            case Ch.Kind is
+               when Ghdl_Rtik_Port
+                 | Ghdl_Rtik_Generic
+                 | Ghdl_Rtik_Signal
+                 | Ghdl_Rtik_Subtype_Array
+                 | Ghdl_Rtik_Subtype_Array_Ptr
+                 | Ghdl_Rtik_Type_E8
+                 | Ghdl_Rtik_Type_B2 =>
+                  Rti_To_Handle (Ch, Iterator.Ctxt, Res);
+                  if Res.Kind /= VhpiUndefined then
+                     Error := AvhpiErrorOk;
+                     return;
+                  else
+                     Internal_Error ("vhpi_handle");
+                  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 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 VhpiSubtypeDeclK =>
+                  Add (To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).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_B2 =>
+--                            Disp_Enum_Value
+--                              (Stream, Rti,
+--                               Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2)));
+                        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.Obj.Obj_Type);
+                     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.Off,
+                                      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 others =>
+            Res := Null_Handle;
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Handle;
+
+   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 VhpiModeP 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 =>
+            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/translate/grt/grt-avhpi.ads b/translate/grt/grt-avhpi.ads
new file mode 100644
index 000000000..8242d5b21
--- /dev/null
+++ b/translate/grt/grt-avhpi.ads
@@ -0,0 +1,455 @@
+--  GHDL Run Time (GRT) - VHPI implementation for 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.
+
+--  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
+     );
+
+   --  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
+     );
+
+   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_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);
+
+   --  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 VhpiModeP is
+     (
+      VhpiErrorMode,
+      VhpiInMode,
+      VhpiOutMode,
+      VhpiInoutMode,
+      VhpiBufferMode,
+      VhpiLinkageMode
+     );
+   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeP;
+
+   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 =>
+            Atype : Ghdl_Rti_Access;
+         when VhpiCompInstStmtK =>
+            Inst : Ghdl_Rtin_Instance_Acc;
+         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/translate/grt/grt-avls.adb b/translate/grt/grt-avls.adb
new file mode 100644
index 000000000..c44f329f8
--- /dev/null
+++ b/translate/grt/grt-avls.adb
@@ -0,0 +1,242 @@
+--  GHDL Run Time (GRT) - binary balanced tree.
+--  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 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/translate/grt/grt-avls.ads b/translate/grt/grt-avls.ads
new file mode 100644
index 000000000..e2688f64f
--- /dev/null
+++ b/translate/grt/grt-avls.ads
@@ -0,0 +1,77 @@
+--  GHDL Run Time (GRT) - binary balanced tree.
+--  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 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/translate/grt/grt-cbinding.c b/translate/grt/grt-cbinding.c
new file mode 100644
index 000000000..bb0bd17be
--- /dev/null
+++ b/translate/grt/grt-cbinding.c
@@ -0,0 +1,90 @@
+/*  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 <setjmp.h>
+
+FILE *
+__ghdl_get_stdout (void)
+{
+  return stdout;
+}
+
+FILE *
+__ghdl_get_stdin (void)
+{
+  return stdin;
+}
+
+FILE *
+__ghdl_get_stderr (void)
+{
+  return stderr;
+}
+
+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;
+}
+
+#if 1
+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/translate/grt/grt-cvpi.c b/translate/grt/grt-cvpi.c
new file mode 100644
index 000000000..51edd678f
--- /dev/null
+++ b/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/translate/grt/grt-disp.adb b/translate/grt/grt-disp.adb
new file mode 100644
index 000000000..9bd803534
--- /dev/null
+++ b/translate/grt/grt-disp.adb
@@ -0,0 +1,203 @@
+--  GHDL Run Time (GRT) - Common display subprograms.
+--  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 Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+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_Guard =>
+            Put ("Guard ");
+         when Imp_Stable =>
+            Put ("Stable ");
+         when Imp_Quiet =>
+            Put ("imp quiet ");
+         when Imp_Transaction =>
+            Put ("imp transaction ");
+         when Imp_Delayed =>
+            Put ("imp 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
+              | Eff_Actual =>
+               Put_Sig_Index (Signal_Ptr_To_Index (Propagation.Table (I).Sig));
+               New_Line;
+            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 Imp_Quiet
+              | Imp_Transaction
+              | Imp_Delayed
+              | 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_B2 =>
+            Put (" b2");
+         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_B2 =>
+            if Value.B2 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/translate/grt/grt-disp.ads b/translate/grt/grt-disp.ads
new file mode 100644
index 000000000..4d3781cba
--- /dev/null
+++ b/translate/grt/grt-disp.ads
@@ -0,0 +1,39 @@
+--  GHDL Run Time (GRT) - Common display subprograms.
+--  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 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/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
new file mode 100644
index 000000000..47e5ac6ce
--- /dev/null
+++ b/translate/grt/grt-disp_rti.adb
@@ -0,0 +1,1369 @@
+--  GHDL Run Time (GRT) - RTI dumper.
+--  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 System; use System;
+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.Typedesc; use Grt.Typedesc;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Options; use Grt.Options;
+
+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_B2 =>
+            Disp_Enum_Value (Stream, Rti,
+                             Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2)));
+            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,
+                 To_Ghdl_Rtin_Unit_Acc
+                 (To_Ghdl_Rtin_Type_Physical_Acc (Rti).Units (0)).Name);
+            if not Is_Sig then
+               Update (64);
+            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_Value (Stream : FILEs;
+                         Rti : Ghdl_Rti_Access;
+                         Ctxt : Rti_Context;
+                         Obj : in out Address;
+                         Is_Sig : Boolean);
+
+   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 : 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 : in out 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;
+         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_B2 =>
+            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 : Ghdl_Rtin_Subtype_Array_Acc :=
+                 To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Bt : 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_Subtype_Array_Ptr =>
+            declare
+               St : Ghdl_Rtin_Subtype_Array_Acc :=
+                 To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Bt : 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 := To_Addr_Acc (Obj).all;
+               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 others =>
+            Put (Stream, "??");
+      end case;
+   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_B2 =>
+            Put ("ghdl_rtik_type_b2");
+         when Ghdl_Rtik_Type_E8 =>
+            Put ("ghdl_rtik_type_e8");
+         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_Subtype_Array_Ptr =>
+            Put ("ghdl_rtik_subtype_array_ptr");
+         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_Subtype_Scalar =>
+            Put ("ghdl_rtik_subtype_scalar");
+
+         when Ghdl_Rtik_Element =>
+            Put ("ghdl_rtik_element");
+         when Ghdl_Rtik_Unit =>
+            Put ("ghdl_rtik_unit");
+
+         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_B2
+           | 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, 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_B2
+           | 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
+           | Ghdl_Rtik_Subtype_Array_Ptr =>
+            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 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.Off,
+                      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.Off).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.Off).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
+        and then Obj_Type.Mode = 1
+      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.Off;
+      --  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_Rtin_Unit_Acc;
+            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 := To_Ghdl_Rtin_Unit_Acc (Bdef.Units (I));
+                     New_Line;
+                     Disp_Indent (Indent + 1);
+                     Disp_Kind (Unit.Common.Kind);
+                     Put (": ");
+                     Disp_Name (Unit.Name);
+                     Put (" = ");
+                     case Bt.Kind is
+                        when Ghdl_Rtik_Type_P64 =>
+                           if Bt.Mode = 0 then
+                              Put_I64 (stdout, Unit.Value.Unit_64);
+                           else
+                              Put_I64 (stdout, Unit.Value.Unit_Addr.I64);
+                           end if;
+                        when Ghdl_Rtik_Type_P32 =>
+                           if Bt.Mode = 0 then
+                              Put_I32 (stdout, Unit.Value.Unit_32);
+                           else
+                              Put_I32 (stdout, Unit.Value.Unit_Addr.I32);
+                           end if;
+                        when others =>
+                           null;
+                     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
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is ");
+      Disp_Type_Array_Name
+        (Def.Basetype, Loc_To_Addr (Def.Common.Depth, Def.Bounds, Ctxt));
+      --  FIXME: If the subtype array contains a type array, then the
+      --  definition is not complete: display the element type.
+      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_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_B2
+           | 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
+           | Ghdl_Rtik_Subtype_Array_Ptr =>
+            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 others =>
+            Disp_Indent (Indent);
+            Disp_Kind (Rti.Kind);
+            Put_Line (" ? ");
+      end case;
+   end Disp_Rti;
+
+   procedure Disp_All
+   is
+      Ctxt : Rti_Context;
+   begin
+      Put ("DISP_RTI.Disp_All: ");
+      Disp_Kind (Ghdl_Rti_Top_Ptr.Common.Kind);
+      New_Line;
+      Ctxt := (Base => To_Address (Ghdl_Rti_Top_Instance),
+               Block => Ghdl_Rti_Top_Ptr.Parent);
+      Disp_Rti_Arr (Ghdl_Rti_Top_Ptr.Nbr_Child,
+                    Ghdl_Rti_Top_Ptr.Children,
+                    Ctxt, 0);
+      Disp_Rti (Ghdl_Rti_Top_Ptr.Parent, Ctxt, 0);
+
+      --Disp_Hierarchy;
+   end Disp_All;
+
+   --  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 >= Disp_Tree_Port then
+                  return;
+               end if;
+            when Ghdl_Rtik_Process =>
+               if Disp_Tree >= 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 : 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 : 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 : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+               begin
+                  Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
+                            Block => Child);
+                  Disp_Header (Nctxt, False);
+                  Disp_Sub_Block (Nblk, Nctxt);
+               end;
+            when Ghdl_Rtik_For_Generate =>
+               declare
+                  Nblk : 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.Off).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 : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+               begin
+                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).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 >= 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
+      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_Ptr.Nbr_Child loop
+         Child := Ghdl_Rti_Top_Ptr.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;
+end Grt.Disp_Rti;
diff --git a/translate/grt/grt-disp_rti.ads b/translate/grt/grt-disp_rti.ads
new file mode 100644
index 000000000..890c5e1ff
--- /dev/null
+++ b/translate/grt/grt-disp_rti.ads
@@ -0,0 +1,22 @@
+--  GHDL Run Time (GRT) - RTI dumper.
+--  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 Grt.Disp_Rti is
+   procedure Disp_All;
+
+   procedure Disp_Hierarchy;
+end Grt.Disp_Rti;
diff --git a/translate/grt/grt-disp_signals.adb b/translate/grt/grt-disp_signals.adb
new file mode 100644
index 000000000..ab73b2d24
--- /dev/null
+++ b/translate/grt/grt-disp_signals.adb
@@ -0,0 +1,456 @@
+--  GHDL Run Time (GRT) - Display subprograms for signals.
+--  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 System; use System;
+with Ada.Unchecked_Conversion;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+with Grt.Rtis; use Grt.Rtis;
+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.Stdio; use Grt.Stdio;
+with Grt.Signals; use Grt.Signals;
+with Grt.Options;
+with Grt.Disp; use Grt.Disp;
+
+package body Grt.Disp_Signals is
+   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;
+
+   --  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_Null =>
+               Put ("NULL");
+            when Trans_Error =>
+               Put ("ERROR");
+         end case;
+         Put ("@");
+         Put_Time (stdout, T.Time);
+         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
+   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.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.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_Scalar_Signal (Val_Addr : Address;
+                                 Val_Name : Vstring;
+                                 Val_Type : Ghdl_Rti_Access)
+   is
+   begin
+      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 Foreach_Scalar_Signal is new
+     Foreach_Scalar (Process => Disp_Scalar_Signal);
+
+   procedure Disp_Signal_Name (Stream : FILEs; Sig : Ghdl_Rtin_Object_Acc) is
+   begin
+      case Sig.Common.Kind is
+         when Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Port
+           | Ghdl_Rtik_Guard =>
+            Put (Stream, Sig.Name);
+         when Ghdl_Rtik_Attribute_Quiet =>
+            Put (Stream, " 'quiet");
+         when Ghdl_Rtik_Attribute_Stable =>
+            Put (Stream, " 'stable");
+         when Ghdl_Rtik_Attribute_Transaction =>
+            Put (Stream, " 'quiet");
+         when others =>
+            null;
+      end case;
+   end Disp_Signal_Name;
+
+   function Disp_Signal (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);
+            Put (stdout, Ctxt);
+            Put (".");
+            Disp_Signal_Name (stdout, Sig);
+            Foreach_Scalar_Signal
+              (Ctxt, Sig.Obj_Type,
+               Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True);
+         when others =>
+            null;
+      end case;
+      return Traverse_Ok;
+   end Disp_Signal;
+
+   function Disp_All_Signals is new Traverse_Blocks (Process => Disp_Signal);
+
+   procedure Disp_All_Signals
+   is
+      Res : Traverse_Result;
+   begin
+      if Boolean'(False) then
+         for I in Sig_Table.First .. Sig_Table.Last loop
+            Disp_Simple_Signal
+              (Sig_Table.Table (I), null, Options.Disp_Sources);
+         end loop;
+      else
+         Res := Disp_All_Signals (Get_Top_Context);
+      end if;
+   end Disp_All_Signals;
+
+
+
+   --  Option disp-signals-map
+
+   Cur_Signals_Map_Ctxt : Rti_Context;
+   Cur_Signals_Map_Obj : Ghdl_Rtin_Object_Acc;
+
+   procedure Disp_Signals_Map_Scalar (Val_Addr : Address;
+                                      Val_Name : Vstring;
+                                      Val_Type : Ghdl_Rti_Access)
+   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
+      Put (stdout, Cur_Signals_Map_Ctxt);
+      Put (".");
+      Disp_Signal_Name (stdout, Cur_Signals_Map_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.Flags.Has_Active then
+         Put (" +A");
+      end if;
+      New_Line;
+   end Disp_Signals_Map_Scalar;
+
+   procedure Foreach_Disp_Signals_Map_Scalar is new
+     Foreach_Scalar (Process => Disp_Signals_Map_Scalar);
+
+   function Disp_Signals_Map_Signal (Ctxt : Rti_Context;
+                                     Obj : Ghdl_Rti_Access)
+                                    return Traverse_Result
+   is
+      Sig : Ghdl_Rtin_Object_Acc renames Cur_Signals_Map_Obj;
+   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_Signals_Map_Ctxt := Ctxt;
+            Cur_Signals_Map_Obj := To_Ghdl_Rtin_Object_Acc (Obj);
+            Foreach_Disp_Signals_Map_Scalar
+              (Ctxt, Sig.Obj_Type,
+               Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True);
+         when others =>
+            null;
+      end case;
+      return Traverse_Ok;
+   end Disp_Signals_Map_Signal;
+
+   function Disp_Signals_Map_Blocks is new Traverse_Blocks
+     (Process => Disp_Signals_Map_Signal);
+
+   procedure Disp_Signals_Map
+   is
+      Res : Traverse_Result;
+   begin
+      Res := Disp_Signals_Map_Blocks (Get_Top_Context);
+      Grt.Stdio.fflush (stdout);
+   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
+      use Grt.Disp;
+      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.Flags.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)
+      is
+         pragma Unreferenced (Val_Type);
+         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
+            Put (Stream, Cur_Ctxt);
+            Put (Stream, ".");
+            Disp_Signal_Name (Stream, Cur_Sig);
+            Put (Stream, Val_Name);
+            Found := True;
+         end if;
+      end Process_Scalar;
+
+      procedure Foreach_Scalar is new Grt.Rtis_Utils.Foreach_Scalar
+        (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);
+               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;
+   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/translate/grt/grt-disp_signals.ads b/translate/grt/grt-disp_signals.ads
new file mode 100644
index 000000000..fd84fe036
--- /dev/null
+++ b/translate/grt/grt-disp_signals.ads
@@ -0,0 +1,39 @@
+--  GHDL Run Time (GRT) - Display subprograms for signals.
+--  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 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_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/translate/grt/grt-errors.adb b/translate/grt/grt-errors.adb
new file mode 100644
index 000000000..4a6aca83c
--- /dev/null
+++ b/translate/grt/grt-errors.adb
@@ -0,0 +1,225 @@
+--  GHDL Run Time (GRT) - Error 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 GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Types; use Grt.Types;
+with Grt.Options; use Grt.Options;
+
+package body Grt.Errors is
+   procedure Fatal_Error;
+   pragma No_Return (Fatal_Error);
+   pragma Export (C, Fatal_Error, "__ghdl_fatal");
+
+   --  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
+      if Ghdl_Exit_Cb1 /= null then
+         Ghdl_Exit_Cb1.all (Code);
+      end if;
+
+      if Ghdl_Exit_Cb /= null then
+         Ghdl_Exit_Cb.all (Code);
+      end if;
+      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 Fatal_Error is
+   begin
+      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 : 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 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 : 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 (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/translate/grt/grt-errors.ads b/translate/grt/grt-errors.ads
new file mode 100644
index 000000000..b531aef11
--- /dev/null
+++ b/translate/grt/grt-errors.ads
@@ -0,0 +1,70 @@
+--  GHDL Run Time (GRT) - Error 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 GCC; 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;
+
+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 (Inst : Ghdl_Instance_Name_Acc);
+   procedure Error_E (Str : String);
+   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);
+
+   --  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;
+
+   type Exit_Cb_Type is access procedure (Code : Integer);
+   pragma Convention (C, Exit_Cb_Type);
+
+   Ghdl_Exit_Cb : Exit_Cb_Type := null;
+   Ghdl_Exit_Cb1 : Exit_Cb_Type := null;
+
+   --  If true, an error is expected and the exit status is inverted.
+   Expect_Failure : Boolean := False;
+
+private
+   pragma Export (C, Ghdl_Exit_Cb, "__ghdl_exit_cb");
+
+   pragma Export (C, Grt_Overflow_Error, "grt_overflow_error");
+
+   pragma No_Return (Error);
+end Grt.Errors;
+
diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb
new file mode 100644
index 000000000..d0063226a
--- /dev/null
+++ b/translate/grt/grt-files.adb
@@ -0,0 +1,429 @@
+--  GHDL Run Time (GRT) -  VHDL files subprograms.
+--  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 Grt.Errors; use Grt.Errors;
+with Grt.Stdio; use Grt.Stdio;
+with GNAT.Table;
+with System; use System;
+
+package body Grt.Files is
+   subtype C_Files is Grt.Stdio.FILEs;
+
+   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 GNAT.Table
+     (Table_Component_Type => File_Entry_Type,
+      Table_Index_Type => Ghdl_File_Index,
+      Table_Low_Bound => 1,
+      Table_Initial => 2,
+      Table_Increment => 100);
+
+   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
+      Res : Ghdl_File_Index;
+   begin
+      Files_Table.Increment_Last;
+      Res := Files_Table.Last;
+      Files_Table.Table (Res) := (Stream => NULL_Stream,
+                                  Signature => Sig,
+                                  Is_Text => Is_Text,
+                                  Is_Alive => True);
+      return Res;
+   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 0 .. Str.Bounds.Dim_1.Length - 1 loop
+         Name (1 + Natural (I)) := Str.Base (I);
+      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_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)));
+      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_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)));
+      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;
+   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);
+      R1 := fflush (Res);
+   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;
+      R1 : int;
+   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;
+      R1 := fflush (Res);
+   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;
+end Grt.Files;
+
diff --git a/translate/grt/grt-files.ads b/translate/grt/grt-files.ads
new file mode 100644
index 000000000..1fcce3cd4
--- /dev/null
+++ b/translate/grt/grt-files.ads
@@ -0,0 +1,112 @@
+--  GHDL Run Time (GRT) -  VHDL files subprograms.
+--  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 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);
+private
+   pragma Export (C, 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");
+end Grt.Files;
diff --git a/translate/grt/grt-hooks.adb b/translate/grt/grt-hooks.adb
new file mode 100644
index 000000000..3f79b5747
--- /dev/null
+++ b/translate/grt/grt-hooks.adb
@@ -0,0 +1,154 @@
+--  GHDL Run Time (GRT) -  Hooks.
+--  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 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/translate/grt/grt-hooks.ads b/translate/grt/grt-hooks.ads
new file mode 100644
index 000000000..fbab743dc
--- /dev/null
+++ b/translate/grt/grt-hooks.ads
@@ -0,0 +1,63 @@
+--  GHDL Run Time (GRT) -  Hooks.
+--  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 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/translate/grt/grt-images.adb b/translate/grt/grt-images.adb
new file mode 100644
index 000000000..8b85d59ec
--- /dev/null
+++ b/translate/grt/grt-images.adb
@@ -0,0 +1,233 @@
+--  GHDL Run Time (GRT) -  'image subprograms.
+--  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 System; use System;
+with Ada.Unchecked_Conversion;
+with Grt.Processes; use Grt.Processes;
+with Grt.Vstrings; use Grt.Vstrings;
+
+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 Return_String (Res : Std_String_Ptr; Str : String)
+   is
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Str'Length));
+      Res.Bounds := To_Std_String_Boundp
+        (Ghdl_Stack2_Allocate (Std_String_Bound'Size / System.Storage_Unit));
+      for I in 0 .. Str'Length - 1 loop
+         Res.Base (Ghdl_Index_Type (I)) := Str (Str'First + I);
+      end loop;
+      Res.Bounds.Dim_1 := (Left => 1,
+                           Right => Str'Length,
+                           Dir => Dir_To,
+                           Length => 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_B2
+     (Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access)
+   is
+   begin
+      Return_Enum (Res, Rti, Ghdl_B2'Pos (Val));
+   end Ghdl_Image_B2;
+
+   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_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;
+      Unit : Ghdl_C_String;
+      Phys : Ghdl_Rtin_Type_Physical_Acc;
+      Unit_Len : Natural;
+   begin
+      To_String (Str, First, Val);
+      Phys := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name;
+      Unit_Len := strlen (Unit);
+      declare
+         L : 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 (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;
+      Unit : Ghdl_C_String;
+      Phys : Ghdl_Rtin_Type_Physical_Acc;
+      Unit_Len : Natural;
+   begin
+      To_String (Str, First, Val);
+      Phys := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name;
+      Unit_Len := strlen (Unit);
+      declare
+         L : 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 (1 .. Unit_Len);
+         Return_String (Res, Str2);
+      end;
+   end Ghdl_Image_P32;
+
+--    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);
+--       P : Natural;
+--       V : Ghdl_F64;
+--       Vd : Ghdl_F64;
+--       Exp : Integer;
+--       D : Integer;
+--       B : Boolean;
+--    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 := Ghdl_F64'Floor (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;
+
+--       Return_String (Res, Str (1 .. P));
+--    end Ghdl_Image_F64;
+
+   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 (Str : System.Address;
+                          Size : Integer;
+                          Template : System.Address;
+                          Arg : Ghdl_F64);
+      pragma Import (C, snprintf);
+
+      function strlen (Str : System.Address) return Integer;
+      pragma Import (C, strlen);
+
+      Format : constant String := "%g" & Character'Val (0);
+   begin
+      snprintf (Str'Address, Str'Length, Format'Address, Val);
+      Return_String (Res, Str (1 .. strlen (Str'Address)));
+   end Ghdl_Image_F64;
+
+end Grt.Images;
diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads
new file mode 100644
index 000000000..fb33b6376
--- /dev/null
+++ b/translate/grt/grt-images.ads
@@ -0,0 +1,39 @@
+--  GHDL Run Time (GRT) -  'image subprograms.
+--  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 Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Images is
+   procedure Ghdl_Image_B2
+     (Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Image_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; 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);
+private
+   pragma Export (C, Ghdl_Image_B2, "__ghdl_image_b2");
+   pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8");
+   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");
+end Grt.Images;
diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb
new file mode 100644
index 000000000..65abdac5c
--- /dev/null
+++ b/translate/grt/grt-lib.adb
@@ -0,0 +1,210 @@
+--  GHDL Run Time (GRT) -  misc subprograms.
+--  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 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;
+                        Severity : Integer;
+                        Loc : Ghdl_Location_Ptr)
+   is
+      Level : 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 ("): ");
+      Report_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)));
+      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, Severity, Loc);
+   end Ghdl_Assert_Failed;
+
+   procedure Ghdl_Report
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
+   is
+   begin
+      Do_Report ("report", Str, Severity, Loc);
+   end Ghdl_Report;
+
+   procedure Ghdl_Program_Error is
+   begin
+      Error ("program error");
+   end Ghdl_Program_Error;
+
+   procedure Ghdl_Bound_Check_Failed_L0 (Number : Ghdl_Index_Type) is
+   begin
+      Error_C ("bound check failed (#");
+      Error_C (Integer (Number));
+      Error_E (")");
+   end Ghdl_Bound_Check_Failed_L0;
+
+   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;
+
+end Grt.Lib;
+
+
+
diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads
new file mode 100644
index 000000000..bb1723a0a
--- /dev/null
+++ b/translate/grt/grt-lib.ads
@@ -0,0 +1,93 @@
+--  GHDL Run Time (GRT) -  misc subprograms.
+--  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 Grt.Types; use Grt.Types;
+
+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_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_L0 (Number : Ghdl_Index_Type);
+   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;
+
+   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;
+
+   --  Create a vhdl string.
+   Ghdl_Assert_Default_Report_Arr : constant String := "Assertion violation";
+   Ghdl_Assert_Default_Report_Bounds : constant Std_String_Bound :=
+     (Dim_1 => (Left => 1,
+                Right => Ghdl_Assert_Default_Report_Arr'Length,
+                Dir => Dir_To,
+                Length => Ghdl_Assert_Default_Report_Arr'Length));
+   Ghdl_Assert_Default_Report : constant Ghdl_Uc_Array :=
+     (Base => Ghdl_Assert_Default_Report_Arr'Address,
+      Bounds => Ghdl_Assert_Default_Report_Bounds'Address);
+
+   --  Unfortunatly, with gnat 3.15p, we cannot use a deferred constant with
+   --  the export pragma.
+   pragma Export (C, Ghdl_Assert_Default_Report,
+                  "__ghdl_assert_default_report");
+private
+   pragma Export (C, Ghdl_Memcpy, "__ghdl_memcpy");
+
+   pragma Export (C, Ghdl_Assert_Failed, "__ghdl_assert_failed");
+   pragma Export (C, Ghdl_Report, "__ghdl_report");
+
+   pragma Export (C, Ghdl_Bound_Check_Failed_L0,
+                  "__ghdl_bound_check_failed_l0");
+   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");
+end Grt.Lib;
+
+
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
new file mode 100644
index 000000000..db57dc81c
--- /dev/null
+++ b/translate/grt/grt-main.adb
@@ -0,0 +1,178 @@
+--  GHDL Run Time (GRT) -  entry point.
+--  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 Grt.Types; use Grt.Types;
+with Grt.Errors;
+with Grt.Vcd;
+with Grt.Vpi;
+with Grt.Waves;
+with Grt.Stacks;
+with Grt.Processes;
+with Grt.Signals;
+with Grt.Options; use Grt.Options;
+with Grt.Disp_Rti;
+with Grt.Stats;
+with Grt.Hooks;
+with Grt.Disp_Signals;
+with Grt.Disp;
+
+--  The following packages are not referenced in this package.
+--  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;
+with Grt.Vital_Annotate;
+pragma Warnings (On);
+
+package body Grt.Main is
+   procedure Ghdl_Elaborate;
+   pragma Import (C, Ghdl_Elaborate, "__ghdl_ELABORATE");
+
+   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
+      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;
+      if Err then
+         Grt.Errors.Error
+           ("GRT is not consistent with the flags used for your design");
+      end if;
+   end Check_Flag_String;
+
+   procedure Register_Modules is
+   begin
+      --  List of modules to be registered.
+      Grt.Vcd.Register;
+      Grt.Waves.Register;
+      Grt.Vpi.Register;
+      Grt.Vital_Annotate.Register;
+   end Register_Modules;
+
+   procedure Run
+   is
+      use Grt.Errors;
+      Stop : Boolean;
+      Status : Integer;
+   begin
+      Register_Modules;
+
+      if Flag_String (5) = '?' then
+         Set_Time_Resolution ('n');
+      end if;
+
+      Grt.Options.Decode (Stop);
+
+      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
+         Grt.Errors.Ghdl_Exit_Cb1 := Disp_Stats_Hook'Access;
+         Stats.Start_Elaboration;
+      end if;
+
+      --  Elaboration.
+      Ghdl_Elaborate;
+
+      if Flag_Stats then
+         Stats.Start_Order;
+      end if;
+
+      if Disp_Tree /= Disp_Tree_None then
+         Grt.Disp_Rti.Disp_Hierarchy;
+      end if;
+
+      if not Flag_No_Run then
+         if Grt.Options.Flag_Dump_Rti then
+            Grt.Disp_Rti.Disp_All;
+         end if;
+
+         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 Flag_Stats then
+            Stats.Start_Cycles;
+         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/translate/grt/grt-main.ads b/translate/grt/grt-main.ads
new file mode 100644
index 000000000..c62fe0067
--- /dev/null
+++ b/translate/grt/grt-main.ads
@@ -0,0 +1,27 @@
+--  GHDL Run Time (GRT) -  entry point.
+--  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 Grt.Main is
+   --  Register modules.
+   --  This is automatically called by RUN.
+   --  Do not call this procedure.
+   procedure Register_Modules;
+
+   --  Elaborate and simulate the design.
+   procedure Run;
+end Grt.Main;
diff --git a/translate/grt/grt-names.adb b/translate/grt/grt-names.adb
new file mode 100644
index 000000000..be4fc8665
--- /dev/null
+++ b/translate/grt/grt-names.adb
@@ -0,0 +1,96 @@
+--  GHDL Run Time (GRT) -  'name* subprograms.
+--  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 Grt.Errors; use Grt.Errors;
+with Ada.Unchecked_Conversion;
+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/translate/grt/grt-names.ads b/translate/grt/grt-names.ads
new file mode 100644
index 000000000..dd9e7efbf
--- /dev/null
+++ b/translate/grt/grt-names.ads
@@ -0,0 +1,35 @@
+--  GHDL Run Time (GRT) -  'name* subprograms.
+--  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 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/translate/grt/grt-options.adb b/translate/grt/grt-options.adb
new file mode 100644
index 000000000..9aa6f64e7
--- /dev/null
+++ b/translate/grt/grt-options.adb
@@ -0,0 +1,468 @@
+--  GHDL Run Time (GRT) -  command line options.
+--  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 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 (" --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 (" --disp-tree[=KIND] disp the design hierarchy after elaboration");
+      P ("       KIND is inst, proc, port (default)");
+      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");
+      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 (" --dump-rti        dump Run Time Information");
+      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.
+         return Natural (Val);
+      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 (Stop : out Boolean)
+   is
+      Arg : Ghdl_C_String;
+      Len : Natural;
+   begin
+      Stop := False;
+      Last_Opt := Argc - 1;
+      for I in 1 .. Argc - 1 loop
+         Arg := Argv (I);
+         Len := strlen (Arg);
+         declare
+            Argument : String := Arg (1 .. Len);
+         begin
+            if Argument = "--" then
+               Last_Opt := I;
+               exit;
+            elsif Argument = "--help" or else Argument = "-h" then
+               Help;
+               Stop := True;
+            elsif Len >= 11 and then Argument (1 .. 11) = "--disp-tree" then
+               if Len = 11 then
+                  Disp_Tree := Disp_Tree_Port;
+               elsif Argument (12 .. Len) = "=port" then
+                  Disp_Tree := Disp_Tree_Port;
+               elsif Argument (12 .. Len) = "=proc" then
+                  Disp_Tree := Disp_Tree_Proc;
+               elsif Argument (12 .. Len) = "=inst" then
+                  Disp_Tree := Disp_Tree_Inst;
+               elsif Argument (12 .. Len) = "=none" then
+                  Disp_Tree := Disp_Tree_None;
+               else
+                  Error ("bad argument for --disp-tree option, try --help");
+               end if;
+            elsif Argument = "--disp-time" then
+               Disp_Time := True;
+            elsif Argument = "--trace-signals" then
+               Trace_Signals := True;
+               Disp_Time := True;
+            elsif Argument = "--trace-processes" then
+               Trace_Processes := True;
+               Disp_Time := True;
+            elsif Argument = "--disp-order" then
+               Disp_Signals_Order := True;
+            elsif Argument = "--checks" then
+               Checks := True;
+            elsif Argument = "--disp-sources" then
+               Disp_Sources := True;
+            elsif Argument = "--disp-sig-types" then
+               Disp_Sig_Types := True;
+            elsif Argument = "--disp-signals-map" then
+               Disp_Signals_Map := True;
+            elsif Argument = "--disp-signals-table" then
+               Disp_Signals_Table := True;
+            elsif Argument = "--dump-rti" then
+               Flag_Dump_Rti := True;
+            elsif Argument = "--stats" then
+               Flag_Stats := True;
+            elsif Argument = "--no-run" then
+               Flag_No_Run := True;
+            elsif Len > 18 and then Argument (1 .. 18) = "--time-resolution="
+            then
+               declare
+                  Res : Character;
+                  Unit : String (1 .. 3);
+               begin
+                  Res := '?';
+                  if Len >= 20 then
+                     Unit (1) := To_Lower (Argument (19));
+                     Unit (2) := To_Lower (Argument (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 (Argument (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 (Argument);
+                     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 Argument (1 .. 12) = "--stop-time=" then
+               declare
+                  Ok : Boolean;
+                  Pos : Natural;
+                  Time : Integer_64;
+                  Unit : String (1 .. 3);
+               begin
+                  Extract_Integer (Argument (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 (Argument);
+                     Error_E ("'");
+                     return;
+                  end if;
+                  Unit (1) := To_Lower (Argument (Pos));
+                  Unit (2) := To_Lower (Argument (Pos + 1));
+                  if Len = Pos + 2 then
+                     Unit (3) := To_Lower (Argument (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 (Argument);
+                     Error_E ("'");
+                  end if;
+                  Stop_Time := Std_Time (Time);
+               end;
+            elsif Len > 13 and then Argument (1 .. 13) = "--stop-delta=" then
+               declare
+                  Ok : Boolean;
+                  Pos : Natural;
+                  Time : Integer_64;
+               begin
+                  Extract_Integer (Argument (14 .. Len), Ok, Time, Pos);
+                  if not Ok or else Pos <= Len then
+                     Error_C ("bad value in '");
+                     Error_C (Argument);
+                     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 Argument (1 .. 15) = "--assert-level=" then
+               if Argument (16 .. Len) = "note" then
+                  Severity_Level := Note_Severity;
+               elsif Argument (16 .. Len) = "warning" then
+                  Severity_Level := Warning_Severity;
+               elsif Argument (16 .. Len) = "error" then
+                  Severity_Level := Error_Severity;
+               elsif Argument (16 .. Len) = "failure" then
+                  Severity_Level := Failure_Severity;
+               elsif Argument (16 .. Len) = "none" then
+                  Severity_Level := 4;
+               else
+                  Error ("bad argument for --assert-level option, try --help");
+               end if;
+            elsif Argument = "--expect-failure" then
+               Expect_Failure := True;
+            elsif Len >= 13 and then Argument (1 .. 13) = "--stack-size=" then
+               Stack_Size := Extract_Size
+                 (Argument (14 .. Len), "--stack-size");
+               if Stack_Size > Stack_Max_Size then
+                  Stack_Max_Size := Stack_Size;
+               end if;
+            elsif Len >= 17 and then Argument (1 .. 17) = "--stack-max-size="
+            then
+               Stack_Max_Size := Extract_Size
+                 (Argument (18 .. Len), "--stack-size");
+               if Stack_Size > Stack_Max_Size then
+                  Stack_Size := Stack_Max_Size;
+               end if;
+            elsif Len >= 11 and then Argument (1 .. 11) = "--activity="
+            then
+               if Argument (12 .. Len) = "none" then
+                  Flag_Activity := Activity_None;
+               elsif Argument (12 .. Len) = "min" then
+                  Flag_Activity := Activity_Minimal;
+               elsif Argument (12 .. Len) = "all" then
+                  Flag_Activity := Activity_All;
+               else
+                  Error ("bad argument for --activity, try --help");
+               end if;
+            elsif not Grt.Hooks.Call_Option_Hooks (Argument) then
+               Error_C ("unknown option '");
+               Error_C (Argument);
+               Error_E ("', try --help");
+            end if;
+         end;
+      end loop;
+   end Decode;
+end Grt.Options;
diff --git a/translate/grt/grt-options.ads b/translate/grt/grt-options.ads
new file mode 100644
index 000000000..3257e9f22
--- /dev/null
+++ b/translate/grt/grt-options.ads
@@ -0,0 +1,127 @@
+--  GHDL Run Time (GRT) -  command line options.
+--  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 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 or 93).
+   --    '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;
+
+   --  Decode command line options.
+   --  If STOP is true, there nothing must happen (set by --help).
+   procedure Decode (Stop : out Boolean);
+
+   --  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 : Disp_Tree_Kind := Disp_Tree_None;
+
+   --  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;
+
+   --  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;
+
+   --  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;
+
+   --  If set, dump rtis.
+   Flag_Dump_Rti : Boolean := False;
+
+   --  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 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);
+end Grt.Options;
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
new file mode 100644
index 000000000..a4e269bf9
--- /dev/null
+++ b/translate/grt/grt-processes.adb
@@ -0,0 +1,795 @@
+--  GHDL Run Time (GRT) -  processes.
+--  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.Table;
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Grt.Stack2; use Grt.Stack2;
+with Grt.Disp;
+with Grt.Astdio;
+with Grt.Signals; use Grt.Signals;
+with Grt.Errors; use Grt.Errors;
+with Grt.Stacks; use Grt.Stacks;
+with Grt.Options;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils;
+with Grt.Hooks;
+with Grt.Disp_Signals;
+with Grt.Stdio;
+with Grt.Stats;
+
+package body Grt.Processes is
+   --  Access to a process subprogram.
+   type Proc_Acc is access procedure (Self : System.Address);
+
+   --  Simply linked list for sensitivity.
+   type Sensitivity_El;
+   type Sensitivity_Acc is access Sensitivity_El;
+   type Sensitivity_El is record
+      Sig : Ghdl_Signal_Ptr;
+      Next : Sensitivity_Acc;
+   end record;
+
+   Last_Time : Std_Time := Std_Time'Last;
+
+   --  State of a process.
+   type Process_State is
+     (
+      --  Sensitized process.  Its state cannot change.
+      State_Sensitized,
+
+      --  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.
+      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 : Stack_Type;
+
+      --  Subprogram containing process code.
+      Subprg : Proc_Acc;
+
+      --  Instance (THIS parameter) for the subprogram.
+      This : System.Address;
+
+      --  Name of the process.
+      Rti : 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.
+      Sensitivity : Sensitivity_Acc;
+   end record;
+   type Process_Acc is access all Process_Type;
+
+   --  Per 'thread' data.
+   --  The process being executed.
+   Cur_Proc_Id : Process_Id;
+
+   Cur_Proc : Process_Acc;
+   pragma Export (C, Cur_Proc, "grt_cur_proc");
+
+   --  The secondary stack for the thread.
+   Stack2 : Stack2_Ptr;
+
+   package Process_Table is new GNAT.Table
+     (Table_Component_Type => Process_Type,
+      Table_Index_Type => Process_Id,
+      Table_Low_Bound => 1,
+      Table_Initial => 1,
+      Table_Increment => 100);
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => Sensitivity_Acc, Object => Sensitivity_El);
+
+   procedure Init is
+   begin
+      Process_Table.Init;
+   end Init;
+
+   function Get_Current_Process_Id return Process_Id
+   is
+   begin
+      return Cur_Proc_Id;
+   end Get_Current_Process_Id;
+
+   function Get_Nbr_Processes return Natural is
+   begin
+      return Natural (Process_Table.Last);
+   end Get_Nbr_Processes;
+
+   procedure Process_Register (This : System.Address;
+                               Proc : System.Address;
+                               Ctxt : Rti_Context;
+                               State : Process_State;
+                               Postponed : Boolean)
+   is
+      function To_Proc_Acc is new Ada.Unchecked_Conversion
+        (Source => System.Address, Target => Proc_Acc);
+      Stack : Stack_Type;
+   begin
+      if State /= State_Sensitized then
+         Stack := Stack_Create (Proc, This);
+      else
+         Stack := Null_Stack;
+      end if;
+      Process_Table.Increment_Last;
+      Process_Table.Table (Process_Table.Last) :=
+        (Subprg => To_Proc_Acc (Proc),
+         This => This,
+         Rti => Ctxt,
+         Sensitivity => null,
+         Resumed => True,
+         Postponed => Postponed,
+         State => State,
+         Timeout => Bad_Time,
+         Stack => Stack);
+      --  Used to create drivers.
+      Cur_Proc_Id := Process_Table.Last;
+   end Process_Register;
+
+   procedure Ghdl_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Timeout, False);
+   end Ghdl_Process_Register;
+
+   procedure Ghdl_Sensitized_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      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 : System.Address;
+      Proc : System.Address;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Timeout, True);
+   end Ghdl_Postponed_Process_Register;
+
+   procedure Ghdl_Postponed_Sensitized_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      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 : System.Address;
+                                       Proc : System.Address;
+                                       Ctxt : Rti_Context)
+   is
+      function To_Proc_Acc is new Ada.Unchecked_Conversion
+        (Source => System.Address, Target => Proc_Acc);
+   begin
+      Process_Table.Increment_Last;
+      Process_Table.Table (Process_Table.Last) :=
+        (Rti => Ctxt,
+         Sensitivity => null,
+         Resumed => True,
+         Postponed => False,
+         State => State_Sensitized,
+         Timeout => Bad_Time,
+         Subprg => To_Proc_Acc (Proc),
+         This => This,
+         Stack => Null_Stack);
+      --  Used to create drivers.
+      Cur_Proc_Id := Process_Table.Last;
+   end Verilog_Process_Register;
+
+   procedure Ghdl_Initial_Register (Instance : System.Address;
+                                    Proc : System.Address)
+   is
+   begin
+      Verilog_Process_Register (Instance, Proc, Null_Context);
+   end Ghdl_Initial_Register;
+
+   procedure Ghdl_Always_Register (Instance : System.Address;
+                                   Proc : System.Address)
+   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.Last);
+   end Ghdl_Process_Add_Sensitivity;
+
+   procedure Resume_Process (Proc : Process_Id) is
+   begin
+      Process_Table.Table (Proc).Resumed := True;
+   end Resume_Process;
+
+   function Ghdl_Stack2_Allocate (Size : Ghdl_Index_Type)
+     return System.Address
+   is
+   begin
+      return Grt.Stack2.Allocate (Stack2, Size);
+   end Ghdl_Stack2_Allocate;
+
+   function Ghdl_Stack2_Mark return Mark_Id is
+   begin
+      if Stack2 = Null_Stack2_Ptr then
+         Stack2 := Grt.Stack2.Create;
+      end if;
+      return Grt.Stack2.Mark (Stack2);
+   end Ghdl_Stack2_Mark;
+
+   procedure Ghdl_Stack2_Release (Mark : Mark_Id) is
+   begin
+      Grt.Stack2.Release (Stack2, Mark);
+   end Ghdl_Stack2_Release;
+
+   function To_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Process_Acc);
+
+   procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
+   is
+      El : Sensitivity_Acc;
+   begin
+      El := new Sensitivity_El'(Sig => Sig,
+                                Next => Cur_Proc.Sensitivity);
+      Cur_Proc.Sensitivity := El;
+   end Ghdl_Process_Wait_Add_Sensitivity;
+
+   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time)
+   is
+   begin
+      if Time < 0 then
+         --  LRM93 8.1
+         Error ("negative timeout clause");
+      end if;
+      Cur_Proc.Timeout := Current_Time + Time;
+   end Ghdl_Process_Wait_Set_Timeout;
+
+   function Ghdl_Process_Wait_Suspend return Boolean
+   is
+   begin
+      if Cur_Proc.State = State_Sensitized then
+         Error ("wait statement in a sensitized process");
+      end if;
+      --  Suspend this process.
+      Cur_Proc.State := State_Wait;
+--       if Cur_Proc.Timeout = Bad_Time then
+--          Cur_Proc.Timeout := Std_Time'Last;
+--       end if;
+      Stack_Switch (Main_Stack, Cur_Proc.Stack);
+      return Cur_Proc.State = State_Timeout;
+   end Ghdl_Process_Wait_Suspend;
+
+   procedure Ghdl_Process_Wait_Close
+   is
+      El : Sensitivity_Acc;
+      N_El : Sensitivity_Acc;
+   begin
+      El := Cur_Proc.Sensitivity;
+      Cur_Proc.Sensitivity := null;
+      while El /= null loop
+         N_El := El.Next;
+         Free (El);
+         El := N_El;
+      end loop;
+   end Ghdl_Process_Wait_Close;
+
+   procedure Ghdl_Process_Wait_Exit
+   is
+   begin
+      if Cur_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.
+      Cur_Proc.State := State_Dead;
+      --  Suspend this process.
+      Stack_Switch (Main_Stack, Cur_Proc.Stack);
+   end Ghdl_Process_Wait_Exit;
+
+   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
+   is
+   begin
+      if Cur_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;
+      Cur_Proc.Timeout := Current_Time + Time;
+      Cur_Proc.State := State_Wait;
+      --  Suspend this process.
+      Stack_Switch (Main_Stack, Cur_Proc.Stack);
+   end Ghdl_Process_Wait_Timeout;
+
+   --  Verilog.
+   procedure Ghdl_Process_Delay (Del : Ghdl_U32)
+   is
+   begin
+      Cur_Proc.Timeout := Current_Time + Std_Time (Del);
+      Cur_Proc.State := State_Delayed;
+   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_Id;
+      --  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 : Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
+   begin
+      if Lock.Process = Nul_Process_Id then
+         if Lock.Count /= 0 then
+            Internal_Error ("protected_enter");
+         end if;
+         Lock.Process := Get_Current_Process_Id;
+         Lock.Count := 1;
+      else
+         if Lock.Process /= Get_Current_Process_Id 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 : Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
+   begin
+      if Lock.Process /= Get_Current_Process_Id 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 := Nul_Process_Id;
+      end if;
+   end Ghdl_Protected_Leave;
+
+   procedure Ghdl_Protected_Init (Obj : System.Address)
+   is
+      Lock : Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
+   begin
+      Lock.all := new Object_Lock'(Process => Nul_Process_Id,
+                                   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 : Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
+   begin
+      if Lock.all.Count /= 0 or Lock.all.Process /= Nul_Process_Id 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.
+      for I in Process_Table.First .. Process_Table.Last loop
+         declare
+            Proc : Process_Type renames Process_Table.Table (I);
+         begin
+            if Proc.State = State_Wait
+              and then Proc.Timeout < Res
+              and then Proc.Timeout >= 0
+            then
+               --  No signals to be updated.
+               Grt.Signals.Flush_Active_List;
+
+               if Proc.Timeout = Current_Time then
+                  --  Can't be better.
+                  return Current_Time;
+               else
+                  Res := Proc.Timeout;
+               end if;
+            end if;
+         end;
+      end loop;
+
+      return Res;
+   end Compute_Next_Time;
+
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Id)
+   is
+   begin
+      Grt.Rtis_Utils.Put (Stream, Process_Table.Table (Proc).Rti);
+   end Disp_Process_Name;
+
+   type Run_Handler is access function return Integer;
+   --  pragma Convention (C, Run_Handler);
+
+   function Run_Through_Longjump (Hand : Run_Handler) return Integer;
+   pragma Import (C, Run_Through_Longjump, "__ghdl_run_through_longjump");
+
+   --  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;
+
+   function Run_Processes (Postponed : Boolean) return Integer
+   is
+      Status : Integer;
+   begin
+      Status := Run_None;
+
+      if Options.Flag_Stats then
+         Stats.Start_Processes;
+      end if;
+
+      for I in Process_Table.First .. Process_Table.Last loop
+         if Process_Table.Table (I).Postponed = Postponed
+           and Process_Table.Table (I).Resumed
+         then
+            if Grt.Options.Trace_Processes then
+               Grt.Astdio.Put ("run process ");
+               Disp_Process_Name (Stdio.stdout, I);
+               Grt.Astdio.Put (" [");
+               Grt.Astdio.Put (Stdio.stdout, Process_Table.Table (I).This);
+               Grt.Astdio.Put ("]");
+               Grt.Astdio.New_Line;
+            end if;
+            Process_Table.Table (I).Resumed := False;
+            Status := Run_Resumed;
+            Cur_Proc_Id := I;
+            Cur_Proc := To_Acc (Process_Table.Table (I)'Address);
+            if Cur_Proc.State = State_Sensitized then
+               Cur_Proc.Subprg.all (Cur_Proc.This);
+            else
+               Stack_Switch (Cur_Proc.Stack, Main_Stack);
+            end if;
+            if Grt.Options.Checks then
+               Ghdl_Signal_Internal_Checks;
+               Grt.Stack2.Check_Empty (Stack2);
+            end if;
+         end if;
+      end loop;
+
+      if Options.Flag_Stats then
+         Stats.End_Processes;
+      end if;
+      return Status;
+   end Run_Processes;
+
+   function Initialization_Phase return Integer
+   is
+      Status : Integer;
+   begin
+      --  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;
+
+      --  - 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;
+
+      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.End_Update;
+      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.
+      for I in Process_Table.First .. Process_Table.Last loop
+         declare
+            Proc : Process_Type renames Process_Table.Table (I);
+            El : Sensitivity_Acc;
+         begin
+            case Proc.State is
+               when State_Sensitized =>
+                  null;
+               when State_Delayed =>
+                  if Proc.Timeout = Current_Time then
+                     Proc.Timeout := Bad_Time;
+                     Proc.Resumed := True;
+                     Proc.State := State_Sensitized;
+                  end if;
+               when State_Wait =>
+                  if Proc.Timeout = Current_Time then
+                     Proc.Timeout := Bad_Time;
+                     Proc.Resumed := True;
+                     Proc.State := State_Timeout;
+                  else
+                     El := Proc.Sensitivity;
+                     while El /= null loop
+                        if El.Sig.Event then
+                           Proc.Resumed := True;
+                           exit;
+                        else
+                           El := El.Next;
+                        end if;
+                     end loop;
+                  end if;
+               when State_Timeout =>
+                  Internal_Error ("process in timeout");
+               when State_Dead =>
+                  null;
+            end case;
+         end;
+      end loop;
+
+      --  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;
+      if Options.Flag_Stats then
+         Stats.End_Next_Time;
+      end if;
+
+      --  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;
+         Status := Run_Processes (Postponed => True);
+         if Status = Run_Resumed then
+            Flush_Active_List;
+            if Options.Flag_Stats then
+               Stats.Start_Next_Time;
+            end if;
+            Tn := Compute_Next_Time;
+            if Options.Flag_Stats then
+               Stats.End_Next_Time;
+            end if;
+            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
+      --Put_Line ("grt.processes:" & Process_Id'Image (Process_Table.Last)
+      --          & " process(es)");
+
+--       if Disp_Sig_Types then
+--          Grt.Disp.Disp_Signals_Type;
+--       end if;
+
+      Grt.Hooks.Call_Start_Hooks;
+
+      Status := Run_Through_Longjump (Initialization_Phase'Access);
+      if Status /= Run_Resumed then
+         return -1;
+      end if;
+
+      Current_Delta := 0;
+      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.
+         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 = Run_Failure;
+         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
+            Info ("simulation stopped by --stop-time");
+            exit;
+         end if;
+      end loop;
+
+      Grt.Hooks.Call_Finish_Hooks;
+
+      if Status = Run_Failure then
+         return -1;
+      else
+         return 0;
+      end if;
+   end Simulation;
+
+end Grt.Processes;
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
new file mode 100644
index 000000000..e9faa3732
--- /dev/null
+++ b/translate/grt/grt-processes.ads
@@ -0,0 +1,156 @@
+--  GHDL Run Time (GRT) -  processes.
+--  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 System;
+with Grt.Stack2; use Grt.Stack2;
+with Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+with Grt.Rtis; use Grt.Rtis;
+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;
+
+   --  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.
+   function Get_Current_Process_Id return Process_Id;
+   pragma Inline (Get_Current_Process_Id);
+
+   --  Return the number of processes.
+   --  Used for statistics.
+   function Get_Nbr_Processes return Natural;
+
+   --  Disp the name of process PROC.
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Id);
+
+   --  Register a process during elaboration.
+   --  This procedure is called by vhdl elaboration code.
+   procedure Ghdl_Process_Register (Instance : System.Address;
+                                    Proc : System.Address;
+                                    Ctxt : Ghdl_Rti_Access;
+                                    Addr : System.Address);
+   procedure Ghdl_Sensitized_Process_Register (Instance : System.Address;
+                                               Proc : System.Address;
+                                               Ctxt : Ghdl_Rti_Access;
+                                               Addr : System.Address);
+   procedure Ghdl_Postponed_Process_Register (Instance : System.Address;
+                                              Proc : System.Address;
+                                              Ctxt : Ghdl_Rti_Access;
+                                              Addr : System.Address);
+   procedure Ghdl_Postponed_Sensitized_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address);
+
+   procedure Ghdl_Initial_Register (Instance : System.Address;
+                                    Proc : System.Address);
+   procedure Ghdl_Always_Register (Instance : System.Address;
+                                   Proc : System.Address);
+
+   --  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_Id);
+
+   --  Wait without timeout or sensitivity.
+   procedure Ghdl_Process_Wait_Exit;
+   --  Wait for a timeout.
+   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time);
+   --  Add a sensitivity for a wait.
+   procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
+   --  Add a timeout for a wait.
+   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time);
+   --  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;
+
+   --  Verilog.
+   procedure Ghdl_Process_Delay (Del : Ghdl_U32);
+
+   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);
+
+private
+   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_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 (C, 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/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
new file mode 100644
index 000000000..f6d5b580f
--- /dev/null
+++ b/translate/grt/grt-rtis.ads
@@ -0,0 +1,347 @@
+--  GHDL Run Time (GRT) -  Run Time Informations.
+--  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 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,
+      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_B2,        --  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_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);
+   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;
+
+   type Ghdl_Rti_Common is record
+      Kind : Ghdl_Rtik;
+      Depth : Ghdl_Rti_Depth;
+      Mode : Ghdl_Rti_U8;
+      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;
+
+   type Ghdl_Rti_Loc (Rel : Boolean := False) is record
+      case Rel is
+         when True =>
+            Off : Ghdl_Index_Type;
+         when False =>
+            Addr : Address;
+      end case;
+   end record;
+   pragma Unchecked_Union (Ghdl_Rti_Loc);
+
+   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 := 48;
+   Ghdl_Rti_Signal_Kind_No       : constant Ghdl_Rti_U8 := 0;
+   Ghdl_Rti_Signal_Kind_Register : constant Ghdl_Rti_U8 := 16;
+   Ghdl_Rti_Signal_Kind_Bus      : constant Ghdl_Rti_U8 := 32;
+
+   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;
+      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.
+   Ghdl_Rti_Type_Complex_Mask : constant Ghdl_Rti_U8 := 1;
+   Ghdl_Rti_Type_Complex      : constant Ghdl_Rti_U8 := 1;
+
+   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);
+
+   --  MODE is never used.  Refer to mode field of physical type.
+   type Ghdl_Rti_Unit_Mode is (Unit_Mode_32, Unit_Mode_64, Unit_Mode_Addr);
+   type Ghdl_Rti_Unit_Val (Mode : Ghdl_Rti_Unit_Mode := Unit_Mode_64) is record
+      case Mode is
+         when Unit_Mode_32 =>
+            Unit_32 : Ghdl_I32;
+         when Unit_Mode_64 =>
+            Unit_64 : Ghdl_I64;
+         when Unit_Mode_Addr =>
+            Unit_Addr : Ghdl_Value_Ptr;
+      end case;
+   end record;
+   pragma Unchecked_Union (Ghdl_Rti_Unit_Val);
+
+   type Ghdl_Rtin_Unit is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Value : Ghdl_Rti_Unit_Val;
+   end record;
+   type Ghdl_Rtin_Unit_Acc is access Ghdl_Rtin_Unit;
+   function To_Ghdl_Rtin_Unit_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Unit_Acc);
+
+   --  Mode field is set to 1 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_Ptr : Ghdl_Rtin_Block_Acc;
+
+   --  Address of the top instance.
+   Ghdl_Rti_Top_Instance : Ghdl_Rti_Access;
+
+   --  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);
+
+private
+   pragma Export (C, Ghdl_Rti_Top_Ptr, "__ghdl_rti_top_ptr");
+   pragma Export (C, Ghdl_Rti_Top_Instance, "__ghdl_rti_top_instance");
+end Grt.Rtis;
diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb
new file mode 100644
index 000000000..4f24fe776
--- /dev/null
+++ b/translate/grt/grt-rtis_addr.adb
@@ -0,0 +1,268 @@
+--  GHDL Run Time (GRT) -  RTI address 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 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 Grt.Errors; use Grt.Errors;
+
+package body Grt.Rtis_Addr is
+   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_Index_Type) return Address
+   is
+   begin
+      return To_Address (To_Integer (L) - Integer_Address (R));
+   end "-";
+
+   function Align (L : Address; R : Ghdl_Index_Type) return Address
+   is
+      Nad : Integer_Address;
+   begin
+      Nad := To_Integer (L + (R - 1));
+      return To_Address (Nad - (Nad mod Integer_Address (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.Off,
+                    Block => Blk.Parent);
+         when Ghdl_Rtik_Architecture =>
+            if Blk.Loc.Off /= 0 then
+               Internal_Error ("get_parent_context(3)");
+            end if;
+            return (Base => Ctxt.Base + Blk.Loc.Off,
+                    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.Off;
+                        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.Off,
+                  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 Loc.Addr;
+      elsif Ctxt.Block.Depth = Depth then
+         --Addr := Base + Storage_Offset (Obj.Loc.Off);
+         return Ctxt.Base + Loc.Off;
+      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.Off;
+            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_B2 =>
+            return Rng.B2.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.Off;
+      --  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, 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 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_B2 =>
+            return Atype;
+         when others =>
+            Internal_Error ("rtis_addr.get_base_type");
+      end case;
+   end Get_Base_Type;
+
+   function Get_Top_Context return Rti_Context
+   is
+      Ctxt : Rti_Context;
+   begin
+      Ctxt := (Base => To_Address (Ghdl_Rti_Top_Instance),
+               Block => Ghdl_Rti_Top_Ptr.Parent);
+      return Ctxt;
+   end Get_Top_Context;
+
+end Grt.Rtis_Addr;
diff --git a/translate/grt/grt-rtis_addr.ads b/translate/grt/grt-rtis_addr.ads
new file mode 100644
index 000000000..3f6b73e39
--- /dev/null
+++ b/translate/grt/grt-rtis_addr.ads
@@ -0,0 +1,88 @@
+--  GHDL Run Time (GRT) -  RTI address 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 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 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_Index_Type) return Address;
+
+   function "-" (L : Address; R : Ghdl_Index_Type) return Address;
+
+   function Align (L : Address; R : Ghdl_Index_Type) 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);
+
+   --  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;
+
+   --  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/translate/grt/grt-rtis_binding.ads b/translate/grt/grt-rtis_binding.ads
new file mode 100644
index 000000000..cf8c7e0d7
--- /dev/null
+++ b/translate/grt/grt-rtis_binding.ads
@@ -0,0 +1,60 @@
+--  GHDL Run Time (GRT) -  Well known RTIs.
+--  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 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/translate/grt/grt-rtis_types.adb b/translate/grt/grt-rtis_types.adb
new file mode 100644
index 000000000..05ffa644a
--- /dev/null
+++ b/translate/grt/grt-rtis_types.adb
@@ -0,0 +1,111 @@
+--  GHDL Run Time (GRT) -  Well known RTI 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 GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+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/translate/grt/grt-rtis_types.ads b/translate/grt/grt-rtis_types.ads
new file mode 100644
index 000000000..153e1f160
--- /dev/null
+++ b/translate/grt/grt-rtis_types.ads
@@ -0,0 +1,48 @@
+--  GHDL Run Time (GRT) -  Well known RTI 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 GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+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/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
new file mode 100644
index 000000000..62cd407e8
--- /dev/null
+++ b/translate/grt/grt-rtis_utils.adb
@@ -0,0 +1,623 @@
+--  GHDL Run Time (GRT) - RTI utilities.
+--  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 System; use System;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Types; use Grt.Types;
+--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.Off,
+                               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.Off).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.Off).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);
+                        Res := Traverse_Instance (Nctxt);
+                     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;
+
+   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;
+
+   --  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)
+   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);
+
+         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_B2 =>
+                  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_B2 =>
+               case Pos is
+                  when 0 =>
+                     Val.B2 := Rng.B2.Left;
+                  when 1 =>
+                     Val.B2 := Rng.B2.Right;
+                  when others =>
+                     Val.B2 := 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_B2 =>
+               Get_Enum_Value (Vstr, Rti, Ghdl_B2'Pos (V.B2));
+            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 : 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;
+         P : Natural;
+      begin
+         P := Length (Name);
+         Obj_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;
+            Append (Name, '.');
+            Append (Name, El.Name);
+            Handle_Any (El.Eltype);
+            Truncate (Name, P);
+         end loop;
+         -- FIXME
+         --Addr := Obj_Addr + Rti.Xx;
+      end Handle_Record;
+
+      procedure Handle_Any (Rti : Ghdl_Rti_Access)
+      is
+         Save_Addr : Address;
+      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_B2 =>
+               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 : Ghdl_Rtin_Subtype_Array_Acc :=
+                    To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                  Bt : 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);
+                  if Rti_Complex_Type (Rti) then
+                     Save_Addr := Addr;
+                     Addr := To_Addr_Acc (Addr).all;
+                  end if;
+                  Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
+                  if Rti_Complex_Type (Rti) then
+                     Addr := Save_Addr + (Address'Size / Storage_Unit);
+                  end if;
+               end;
+            when Ghdl_Rtik_Subtype_Array_Ptr =>
+               declare
+                  St : Ghdl_Rtin_Subtype_Array_Acc :=
+                    To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                  Bt : 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);
+                  Save_Addr := Addr;
+                  Addr := To_Addr_Acc (Addr).all;
+                  Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
+                  Addr := Save_Addr + (Address'Size / Storage_Unit);
+               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 =>
+               if Rti_Complex_Type (Rti) then
+                  Save_Addr := Addr;
+                  Addr := To_Addr_Acc (Addr).all;
+               end if;
+               Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti));
+               if Rti_Complex_Type (Rti) then
+                  Addr := Save_Addr + (Address'Size / Storage_Unit);
+               end if;
+            when others =>
+               Internal_Error ("grt.rtis_utils.foreach_scalar.handle_any");
+         end case;
+      end Handle_Any;
+   begin
+      Addr := Obj_Addr;
+      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_B2 =>
+            Get_Enum_Value
+              (Str, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
+         when Ghdl_Rtik_Type_F64 =>
+            declare
+               S : String (1 .. 32);
+               L : Integer;
+               --  Warning: this assumes a C99 snprintf (ie, it returns the
+               --  number of characters).
+               function snprintf (Cstr : Address;
+                                  Size : Natural;
+                                  Template : Address;
+                                  Arg : Ghdl_F64)
+                 return Integer;
+               pragma Import (C, snprintf);
+
+               Format : constant String := "%g" & Character'Val (0);
+            begin
+               L := snprintf (S'Address, S'Length, Format'Address, 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,
+                       To_Ghdl_Rtin_Unit_Acc (To_Ghdl_Rtin_Type_Physical_Acc
+                                              (Type_Rti).Units (0)).Name);
+            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,
+                       To_Ghdl_Rtin_Unit_Acc (To_Ghdl_Rtin_Type_Physical_Acc
+                                              (Type_Rti).Units (0)).Name);
+            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);
+   end Disp_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 : 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_B2 =>
+            Get_Enum_Value
+              (Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
+         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);
+               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/translate/grt/grt-rtis_utils.ads b/translate/grt/grt-rtis_utils.ads
new file mode 100644
index 000000000..9b8fd33a0
--- /dev/null
+++ b/translate/grt/grt-rtis_utils.ads
@@ -0,0 +1,67 @@
+--  GHDL Run Time (GRT) - RTI utilities.
+--  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 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);
+
+   --  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
+      with procedure Process (Val_Addr : Address;
+                              Val_Name : Vstring;
+                              Val_Type : Ghdl_Rti_Access);
+   procedure Foreach_Scalar (Ctxt : Rti_Context;
+                             Obj_Type : Ghdl_Rti_Access;
+                             Obj_Addr : Address;
+                             Is_Sig : Boolean);
+
+   procedure Get_Value (Str : in out Vstring;
+                        Value : Value_Union;
+                        Type_Rti : Ghdl_Rti_Access);
+
+   --  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/translate/grt/grt-sdf.adb b/translate/grt/grt-sdf.adb
new file mode 100644
index 000000000..9d329781c
--- /dev/null
+++ b/translate/grt/grt-sdf.adb
@@ -0,0 +1,1330 @@
+--  GHDL Run Time (GRT) - SDF 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 GCC; 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 Grt.Stdio; use Grt.Stdio;
+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 (Msg : String) is
+   begin
+      Error_C (Sdf_Filename.all);
+      Error_C (":");
+      Error_C (Sdf_Line);
+      Error_C (":");
+      Error_C (Pos - Line_Start);
+      Error_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;
+
+   function Get_Token return Sdf_Token_Type
+   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 4 characters.
+         if Pos + 4 >= Buf_Len then
+            Refill_Buf;
+         end if;
+
+         case Buf (Pos) is
+            when EOT =>
+               if Pos /= Buf_Len then
+                  Error_Bad_Character;
+                  return Tok_Error;
+               end if;
+               Pos := 1;
+               Read_Sdf;
+               if Buf_Len = 1 then
+                  return Tok_Eof;
+               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 '"' => -- "
+               Scan_Qstring;
+               return Tok_Qstring;
+            when ' '
+              | HT =>
+               Pos := Pos + 1;
+            when '/' =>
+               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 loop;
+   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
+      loop
+         --  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 Pos /= Buf_Len then
+                  exit;
+               end if;
+               Pos := 1;
+               Read_Sdf;
+               if Buf_Len = 1 then
+                  exit;
+               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 '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;
+               exit;
+            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;
+               exit;
+            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;
+               exit;
+            when 'p' =>
+               Scan_Identifier;
+               if Is_Ident ("posedge") then
+                  return Edge_Posedge;
+               else
+                  exit;
+               end if;
+            when 'n' =>
+               Scan_Identifier;
+               if Is_Ident ("negedge") then
+                  return Edge_Negedge;
+               else
+                  exit;
+               end if;
+            when others =>
+               exit;
+         end case;
+      end loop;
+      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).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)
+   --  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;
+      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.
+            if Get_Token = Tok_Cparen then
+               return Status_Altern;
+            else
+               Error_Sdf (Tok_Cparen);
+               return Status_Error;
+            end if;
+         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 =>
+            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 ("could not annotate generic");
+         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
+               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;
+            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/translate/grt/grt-sdf.ads b/translate/grt/grt-sdf.ads
new file mode 100644
index 000000000..9e2477656
--- /dev/null
+++ b/translate/grt/grt-sdf.ads
@@ -0,0 +1,113 @@
+--  GHDL Run Time (GRT) - SDF 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 GCC; 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;
+
+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;
+
+   type Port_Spec_Type is record
+      Name : String (1 .. 1024);
+      Name_Len : Natural;
+   -- 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/translate/grt/grt-shadow_ieee.adb b/translate/grt/grt-shadow_ieee.adb
new file mode 100644
index 000000000..cefd2d2a2
--- /dev/null
+++ b/translate/grt/grt-shadow_ieee.adb
@@ -0,0 +1,25 @@
+--  GHDL Run Time (GRT) - ghost declarations for ieee.
+--  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 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/translate/grt/grt-shadow_ieee.ads b/translate/grt/grt-shadow_ieee.ads
new file mode 100644
index 000000000..7433ca16a
--- /dev/null
+++ b/translate/grt/grt-shadow_ieee.ads
@@ -0,0 +1,34 @@
+--  GHDL Run Time (GRT) - ghost declarations for ieee.
+--  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.
+
+--  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/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
new file mode 100644
index 000000000..9ed8a3227
--- /dev/null
+++ b/translate/grt/grt-signals.adb
@@ -0,0 +1,2949 @@
+--  GHDL Run Time (GRT) - signals management.
+--  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 System; use System;
+with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
+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;
+
+package body Grt.Signals is
+   function Is_Signal_Guarded (Sig : Ghdl_Signal_Ptr) return Boolean
+   is
+   begin
+      return (Sig.Rti.Common.Mode and Ghdl_Rti_Signal_Kind_Mask)
+        /= Ghdl_Rti_Signal_Kind_No;
+   end Is_Signal_Guarded;
+
+   Sig_Rti : Ghdl_Rtin_Object_Acc;
+   Last_Implicit_Signal : Ghdl_Signal_Ptr;
+   Current_Resolv : Resolved_Signal_Acc := null;
+
+   function Get_Current_Mode_Signal return Mode_Signal_Type
+   is
+   begin
+      return Mode_Signal_Type'Val
+        (Sig_Rti.Common.Mode and Ghdl_Rti_Signal_Mode_Mask);
+   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);
+   end Ghdl_Signal_Name_Rti;
+
+   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 : System.Address;
+      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_Address 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_Address 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,
+
+                              Mode => Mode,
+                              Flags => (Propag => Propag_None,
+                                        Has_Active => False,
+                                        Is_Dumped => False,
+                                        Cyc_Event => 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.Flags.Has_Active := True;
+         when Activity_Minimal =>
+            if (Sig_Rti.Common.Mode and Ghdl_Rti_Signal_Has_Active) /= 0 then
+               Res.Flags.Has_Active := True;
+            end if;
+         when Activity_None =>
+            Res.Flags.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.Flags.Has_Active := True;
+         end if;
+      end if;
+   end Ghdl_Signal_Merge_Rti;
+
+   procedure Ghdl_Signal_Create_Resolution (Proc : System.Address;
+                                            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.
+            Put ("for signal: ");
+            Disp_Signals.Put_Signal_Name (stderr, Sig);
+            New_Line (stderr);
+            Error ("several sources for unresolved signal");
+            --  FIXME: display signal name.
+         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;
+
+   procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr)
+   is
+      type Size_T is new Integer;
+
+      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_Type'Size / System.Storage_Unit);
+      end Size;
+
+      Trans : Transaction_Acc;
+      Id : Process_Id;
+   begin
+      Id := Get_Current_Process_Id;
+      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 = Id then
+               return;
+            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;
+      Trans := new Transaction'(Kind => Trans_Value,
+                                Time => 0,
+                                Next => null,
+                                Val => Sign.Value);
+      Sign.S.Drivers (Sign.S.Nbr_Drivers - 1) :=
+        (First_Trans => Trans,
+         Last_Trans => Trans,
+         Proc => Id);
+   end Ghdl_Process_Add_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 Free is new Ada.Unchecked_Deallocation
+     (Object => Transaction, Name => Transaction_Acc);
+
+   function Value_Equal (Left, Right : Value_Union; Mode : Mode_Type)
+     return Boolean
+   is
+   begin
+      case Mode is
+         when Mode_B2 =>
+            return Left.B2 = Right.B2;
+         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;
+
+   function Find_Driver (Sig : Ghdl_Signal_Ptr) return Ghdl_Index_Type
+   is
+      Id : Process_Id;
+   begin
+      if Sig.S.Drivers = null then
+         Error ("assignment to a signal without any driver");
+      end if;
+      Id := Get_Current_Process_Id;
+      for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
+         if Sig.S.Drivers (I).Proc = Id 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
+      Id : Process_Id;
+   begin
+      if Sig.S.Drivers = null then
+         return null;
+      end if;
+      Id := Get_Current_Process_Id;
+      for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
+         if Sig.S.Drivers (I).Proc = Id then
+            return Sig.S.Drivers (I)'Access;
+         end if;
+      end loop;
+      return null;
+   end Get_Driver;
+
+   --  Unused but well-known signal which always terminate ACTIVE_LIST.
+   --  As a consequence, every element of ACTIVE_LIST 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 active signals.
+   Active_List : Ghdl_Signal_Ptr;
+
+   --  List of signals which have projected waveforms in the future (beyond
+   --  the next delta cycle).
+   Future_List : 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 := Active_List;
+            Active_List := Sign;
+         end if;
+      else
+         --  AFTER > 0.
+         --  Put SIGN on the future list.
+         if Sign.Flink = null then
+            Sign.Flink := Future_List;
+            Future_List := Sign;
+         end if;
+      end if;
+
+      Assign_Time := Current_Time + After;
+      if Assign_Time < 0 then
+         --  Beyond the future
+         declare
+            Ntrans : Transaction_Acc;
+         begin
+            Ntrans := Trans;
+            Free (Ntrans);
+            return;
+         end;
+      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;
+         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,
+                                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_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'(Kind => Trans_Error,
+                                Time => 0,
+                                Next => null);
+      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)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'(Kind => Trans_Error,
+                                Time => 0,
+                                Next => null);
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_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,
+                                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,
+                                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_B2
+     (Init_Val : Ghdl_B2;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_B2;
+
+   procedure Ghdl_Signal_Init_B2 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B2) is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_B2, B2 => Init_Val));
+   end Ghdl_Signal_Init_B2;
+
+   procedure Ghdl_Signal_Associate_B2 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B2) is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_B2, B2 => Val));
+   end Ghdl_Signal_Associate_B2;
+
+   procedure Ghdl_Signal_Simple_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_B2)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Flags.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.B2
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_B2, B2 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_B2;
+
+   procedure Ghdl_Signal_Start_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_B2;
+                                          After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_B2, B2 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_B2;
+
+   procedure Ghdl_Signal_Next_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_B2;
+                                         After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_B2, B2 => Val), After);
+   end Ghdl_Signal_Next_Assign_B2;
+
+   function Ghdl_Create_Signal_E8
+     (Init_Val : Ghdl_E8;
+      Resolv_Func : System.Address;
+      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.Flags.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,
+         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,
+         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_I32
+     (Init_Val : Ghdl_I32;
+      Resolv_Func : System.Address;
+      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.Flags.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,
+         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,
+         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 : System.Address;
+      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.Flags.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,
+         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,
+         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 : System.Address;
+      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.Flags.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,
+         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,
+         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.
+         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;
+      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 => (Rel => True, Off => 0),
+      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 => (Rel => True, Off => 0),
+      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;
+--       Sig_Instance_Name := new Ghdl_Instance_Name_Type'
+--         (Kind => Ghdl_Name_Signal,
+--          Name => null,
+--          Parent => null,
+--          Brother => null,
+--          Sig_Mode => Mode,
+--          Sig_Kind => Kind_Signal_No,
+--        Sig_Indexes => (First => Sig_Table.Last + 1, Last => Sig_Table.Last),
+--          Sig_Type_Desc => Sig_Type);
+      --  Note: bit and boolean are both mode_b2.
+      Res := Create_Signal
+        (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => True),
+         Mode, Null_Address, Null_Address);
+
+      Last_Implicit_Signal := Res;
+
+      if Mode /= Mode_Transaction then
+         Res.S.Time := Time;
+         Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
+                                              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 => (Rel => True, Off => 0),
+      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_B2, Value_Union'(Mode => Mode_B2, B2 => Proc.all (This)),
+         Mode_Guard, Null_Address, Null_Address);
+      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);
+   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_Address, 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,
+                                           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_Null =>
+            return null;
+         when Trans_Error =>
+            Error ("range check error on signal");
+      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_B2
+   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_B2 (Sig : Ghdl_Signal_Ptr) return Ghdl_B2
+   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.B2;
+      end if;
+   end Ghdl_Signal_Driving_Value_B2;
+
+   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_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;
+
+   procedure Flush_Active_List
+   is
+      Sig : Ghdl_Signal_Ptr;
+      Next_Sig : Ghdl_Signal_Ptr;
+   begin
+      --  Free active_list.
+      Sig := Active_List;
+      loop
+         Next_Sig := Sig.Link;
+         exit when Next_Sig = null;
+         Sig.Link := null;
+         Sig := Next_Sig;
+      end loop;
+      Active_List := Sig;
+   end Flush_Active_List;
+
+   --  Add SIG in active_list.
+   procedure Add_Active_List (Sig : Ghdl_Signal_Ptr);
+   pragma Inline (Add_Active_List);
+
+   procedure Add_Active_List (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Sig.Link = null then
+         Sig.Link := Active_List;
+         Active_List := Sig;
+      end if;
+   end Add_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 then
+            if Trans.Time = Res and Sig.Link = null then
+               Sig.Link := Active_List;
+               Active_List := Sig;
+            elsif Trans.Time < Res then
+               Flush_Active_List;
+
+               --  Put sig on the list.
+               Sig.Link := Active_List;
+               Active_List := 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 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 Active_List.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;
+
+   Clear_List : Ghdl_Signal_Ptr := null;
+
+   procedure Mark_Active (Sig : Ghdl_Signal_Ptr);
+   pragma Inline (Mark_Active);
+
+   procedure Mark_Active (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Sig.Active then
+         Internal_Error ("mark_active");
+      end if;
+      Sig.Active := True;
+      Sig.Last_Active := Current_Time;
+      Sig.Alink := Clear_List;
+      Clear_List := Sig;
+   end Mark_Active;
+
+   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);
+
+   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 : 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");
+         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.Rti.Common.Mode and Ghdl_Rti_Signal_Kind_Mask)
+                  = Ghdl_Rti_Signal_Kind_Register)
+      then
+         return;
+      end if;
+
+      --  Call the procedure.
+      To_Resolver_Acc (Resolv.Resolv_Proc).all
+        (Resolv.Resolv_Inst,
+         Resolv.Resolv_Ptr,
+         Vec'Address,
+         Length,
+         Sig.S.Nbr_Drivers,
+         Sig.Nbr_Ports);
+   end Compute_Resolved_Signal;
+
+   type Conversion_Func_Acc is access procedure (Instance : System.Address);
+   function To_Conversion_Func_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Conversion_Func_Acc);
+
+   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_Id)
+   is
+      El : Action_List_Acc;
+   begin
+      El := new Action_List'(Kind => Action_Process,
+                             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;
+
+   --  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;
+               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 : 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_Implicit =>
+            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 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 ("create_nets(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_Quiet
+              | Imp_Transaction
+              | Imp_Stable
+              | Imp_Delayed
+              | Eff_Actual
+              | Drv_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Net = No_Signal_Net then
+                  Merge_Net (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;
+         type Off_Array_Acc is access Off_Array;
+         Offs : Off_Array_Acc;
+         procedure Free is new Ada.Unchecked_Deallocation
+           (Name => Off_Array_Acc, Object => Off_Array);
+
+         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;
+         type Propag_Array_Acc is access Propag_Array;
+         Propag : Propag_Array_Acc;
+         procedure Free is new Ada.Unchecked_Deallocation
+           (Name => Propag_Array_Acc, Object => Propag_Array);
+
+         Net : Signal_Net_Type;
+      begin
+         --  1) Count number of propagation cell per net.
+         Offs := new Off_Array (0 .. Last_Signal_Net);
+         Offs.all := (others => 0);
+         for I in Propagation.First .. Propagation.Last loop
+            Net := Get_Propagation_Net (I);
+            Offs (Net) := Offs (Net) + 1;
+         end loop;
+         --  2) Convert this table into 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;
+         Num := Offs (0);
+         Offs (0) := Last_Off + 1;
+         --Last_Off := Last_Off + 1 + Num - 1;
+
+         --  3) Re-order the table (by a copy).
+         Propag := new Propag_Array (1 .. Last_Off);
+         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
+            Propagation.Table (I) := Propag (I);
+         end loop;
+         Free (Propag);
+         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
+                  Sig.Net := Net_One_Driver;
+               end if;
+            else
+               Sig.Net := Signal_Net_Type (Offs (Sig.Net));
+            end if;
+            Sig.Link := null;
+         end loop;
+         Free (Offs);
+      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
+                        = 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;
+
+   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 and then 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 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,
+                                   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
+               Internal_Error ("delayed");
+            end if;
+            Free (Last);
+         else
+            Prev := Last;
+         end if;
+         --  Append the transaction.
+         Prev.Next := Trans;
+         if Sig.S.Time = 0 then
+            Add_Active_List (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
+            case El.Kind is
+               when Action_Process =>
+                  Resume_Process (El.Proc);
+               when Action_Signal =>
+                  Internal_Error ("set_effective_value");
+            end case;
+            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;
+   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;
+               Trans := Sig.S.Drivers (0).First_Trans.Next;
+               if Trans /= null and then Trans.Time = Current_Time then
+                  Mark_Active (Sig);
+                  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_Null =>
+                        Error ("null transaction");
+                     when Trans_Error =>
+                        Error ("range check error on signal");
+                  end case;
+               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 =>
+               null;
+            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_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.B2 :=
+                    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_B2, B2 => False);
+                  --  Set driver.
+                  Trans := new Transaction'
+                    (Kind => Trans_Value,
+                     Time => Current_Time + Sig.S.Time,
+                     Next => null,
+                     Val => Value_Union'(Mode => Mode_B2, B2 => 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_List (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_B2,
+                                          B2 => not Sig.Value.B2));
+                     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;
+
+      Sig := Active_List;
+      Active_List := 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_Null =>
+                     Error ("null transaction");
+                  when Trans_Error =>
+                     Error ("range check error on signal");
+               end case;
+               Set_Effective_Value (Sig, Sig.Driving_Value);
+
+            when Net_One_Resolved =>
+               --  This signal is active.
+               Mark_Active (Sig);
+
+               for J in 1 .. Sig.S.Nbr_Drivers loop
+                  Trans := Sig.S.Drivers (J - 1).First_Trans.Next;
+                  if Trans /= null and then Trans.Time = Current_Time then
+                     Free (Sig.S.Drivers (J - 1).First_Trans);
+                     Sig.S.Drivers (J - 1).First_Trans := Trans;
+                  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 =>
+               if not Propagation.Table (Sig.Net).Updated then
+                  Propagation.Table (Sig.Net).Updated := True;
+                  Run_Propagation (Sig.Net + 1);
+
+                  --  Put it on the list.
+                  Add_Active_List (Sig);
+               end if;
+         end case;
+
+         Sig := Next_Sig;
+      end loop;
+
+      --  Un-mark updated.
+      Sig := Active_List;
+      Active_List := 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 := Active_List;
+                     Active_List := 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 =>
+               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.B2 :=
+                 Sig.S.Guard_Func.all (Sig.S.Guard_Instance);
+               Sig.Value := Sig.Driving_Value;
+            when Imp_Stable
+              | Imp_Quiet
+              | Imp_Transaction =>
+               --  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 =>
+               --  Nothing to do: drivers were already created.
+               null;
+
+            when Net_One_Resolved =>
+               if 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_B2,
+                                               B2 => False),
+                                     Driving_Value => (Mode => Mode_B2,
+                                                       B2 => False),
+                                     Last_Value => (Mode => Mode_B2,
+                                                    B2 => False),
+                                     Last_Event => 0,
+                                     Last_Active => 0,
+                                     Event => False,
+                                     Active => False,
+                                     Mode => Mode_B2,
+
+                                     Flags => (Propag => Propag_None,
+                                               Has_Active => False,
+                                               Is_Dumped => False,
+                                               Cyc_Event => 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));
+
+      Active_List := 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/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
new file mode 100644
index 000000000..c78bf52f2
--- /dev/null
+++ b/translate/grt/grt-signals.ads
@@ -0,0 +1,720 @@
+--  GHDL Run Time (GRT) - signals management.
+--  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 System;
+with Ada.Unchecked_Conversion;
+with GNAT.Table;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Signals is
+   pragma Suppress (All_Checks);
+
+   --  Kind of transaction.
+   type Transaction_Kind is
+     (
+      --  Normal transaction, with a value.
+      Trans_Value,
+      --  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
+      Time : Std_Time;
+      Next : Transaction_Acc;
+      case Kind is
+         when Trans_Value =>
+            Val : Value_Union;
+         when Trans_Null =>
+            null;
+         when Trans_Error =>
+            --  FIXME: should have a location field, to be able to display
+            --  a message.
+            null;
+      end case;
+   end record;
+
+   --  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_Id;
+   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_B2;
+
+   --  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);
+
+   type Action_List;
+   type Action_List_Acc is access Action_List;
+   type Action_Kind is (Action_Signal, Action_Process);
+   type Action_List (Kind : Action_Kind) is record
+      Next : Action_List_Acc;
+      case Kind is
+         when Action_Signal =>
+            Sig : Ghdl_Signal_Ptr;
+         when Action_Process =>
+            Proc : Process_Id;
+      end case;
+   end record;
+
+   --  How to compute resolved signal.
+   type Resolved_Signal_Type is record
+      Resolv_Proc : System.Address;
+      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;
+
+   --  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;
+
+   --  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_Resolved : constant Signal_Net_Type := -2;
+
+   --  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 activity of the signal is required by the user.
+      Has_Active : Boolean;
+
+      --  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;
+   end record;
+   pragma Pack (Ghdl_Signal_Flags);
+
+   type Ghdl_Signal is record
+      --  Fields known by ghdl.
+      Value : Value_Union;
+      Driving_Value : Value_Union;
+      Last_Value : Value_Union;
+      Last_Event : Std_Time;
+      Last_Active : Std_Time;
+      Event : Boolean;
+      Active : Boolean;
+
+      --  Internal fields.
+      --  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.
+      --  Used to build nets.
+      --  This is also the simply linked list of future active signals.
+      Link : Ghdl_Signal_Ptr;
+
+      --  Chain of signals whose active flag was set.  Used to clear it.
+      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 GNAT.Table
+     (Table_Component_Type => Ghdl_Signal_Ptr,
+      Table_Index_Type => Sig_Table_Index,
+      Table_Low_Bound => 0,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   --  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,
+
+      --  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_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 Prop_End =>
+            Updated : Boolean;
+      end case;
+   end record;
+
+   package Propagation is new GNAT.Table
+     (Table_Component_Type => Propagation_Type,
+      Table_Index_Type => Signal_Net_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   --  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;
+
+   --  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_Id);
+
+   procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
+                                   Ctxt : Ghdl_Rti_Access;
+                                   Addr : System.Address);
+
+   procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr;
+                                    Rti : Ghdl_Rti_Access);
+
+   --  Performs some internal checks on signals (transaction order).
+   --  Internal_error is called in case of error.
+   procedure Ghdl_Signal_Internal_Checks;
+
+   --  Subprograms to be called by generated code.
+   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr);
+   procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                             Rej : Std_Time;
+                                             After : Std_Time);
+
+   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_B2;
+
+   function Ghdl_Create_Signal_B2
+     (Init_Val : Ghdl_B2;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_B2 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B2);
+   procedure Ghdl_Signal_Associate_B2 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B2);
+   procedure Ghdl_Signal_Simple_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_B2);
+   procedure Ghdl_Signal_Start_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_B2;
+                                          After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_B2;
+                                         After : Std_Time);
+   function Ghdl_Signal_Driving_Value_B2 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_B2;
+
+   function Ghdl_Create_Signal_E8
+     (Init_Val : Ghdl_E8;
+      Resolv_Func : System.Address;
+      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_I32
+     (Init_Val : Ghdl_I32;
+      Resolv_Func : System.Address;
+      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 : System.Address;
+      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 : System.Address;
+      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);
+
+   --  Used for connexions:
+   --  SRC is a source for TARG.
+   procedure Ghdl_Signal_Add_Source (Targ : Ghdl_Signal_Ptr;
+                                     Src : Ghdl_Signal_Ptr);
+
+   --  Add an in conversion (from SRC to DEST using function FUNC).
+   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);
+   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 signals as resolved.
+   procedure Ghdl_Signal_Create_Resolution (Proc : System.Address;
+                                            Instance : System.Address;
+                                            Sig : System.Address;
+                                            Nbr_Sig : Ghdl_Index_Type);
+
+   --  The effective value of TARG is the effective value of SRC.
+   procedure Ghdl_Signal_Effective_Value (Targ : Ghdl_Signal_Ptr;
+                                          Src : Ghdl_Signal_Ptr);
+
+   --  Create a new 'stable (VAL) signal.
+   function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr;
+   --  Create a new 'quiet (VAL) signal.
+   function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr;
+
+   --  Create a new 'transaction signal.
+   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;
+
+   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;
+
+   --  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_Start_Assign_Null,
+                  "__ghdl_signal_start_assign_null");
+
+   pragma Export (C, Ghdl_Signal_Set_Disconnect,
+                  "__ghdl_signal_set_disconnect");
+   pragma Export (C, Ghdl_Signal_Disconnect,
+                  "__ghdl_signal_disconnect");
+
+   pragma Export (C, Ghdl_Signal_Driving,
+                  "__ghdl_signal_driving");
+
+   pragma Export (C, Ghdl_Create_Signal_B2,
+                  "__ghdl_create_signal_b2");
+   pragma Export (C, Ghdl_Signal_Init_B2,
+                  "__ghdl_signal_init_b2");
+   pragma Export (C, Ghdl_Signal_Associate_B2,
+                  "__ghdl_signal_associate_b2");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_B2,
+                  "__ghdl_signal_simple_assign_b2");
+   pragma Export (C, Ghdl_Signal_Start_Assign_B2,
+                  "__ghdl_signal_start_assign_b2");
+   pragma Export (C, Ghdl_Signal_Next_Assign_B2,
+                  "__ghdl_signal_next_assign_b2");
+   pragma Export (C, Ghdl_Signal_Driving_Value_B2,
+                  "__ghdl_signal_driving_value_b2");
+
+   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_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_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 (C, 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");
+end Grt.Signals;
diff --git a/translate/grt/grt-stack2.adb b/translate/grt/grt-stack2.adb
new file mode 100644
index 000000000..17bb2c990
--- /dev/null
+++ b/translate/grt/grt-stack2.adb
@@ -0,0 +1,198 @@
+--  GHDL Run Time (GRT) - secondary stack.
+--  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.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/translate/grt/grt-stack2.ads b/translate/grt/grt-stack2.ads
new file mode 100644
index 000000000..3be035b31
--- /dev/null
+++ b/translate/grt/grt-stack2.ads
@@ -0,0 +1,36 @@
+--  GHDL Run Time (GRT) - secondary stack.
+--  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 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/translate/grt/grt-stacks.adb b/translate/grt/grt-stacks.adb
new file mode 100644
index 000000000..a6e53f8f3
--- /dev/null
+++ b/translate/grt/grt-stacks.adb
@@ -0,0 +1,36 @@
+--  GHDL Run Time (GRT) - process stacks.
+--  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 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/translate/grt/grt-stacks.ads b/translate/grt/grt-stacks.ads
new file mode 100644
index 000000000..2624f5c2b
--- /dev/null
+++ b/translate/grt/grt-stacks.ads
@@ -0,0 +1,67 @@
+--  GHDL Run Time (GRT) - process stacks.
+--  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 System; use System;
+
+package Grt.Stacks is
+   type Stack_Type is new Address;
+   Null_Stack : constant Stack_Type := Stack_Type (Null_Address);
+
+   --  The main stack.  This is initialized by STACK_INIT.
+   --  The return point.
+   Main_Stack : Stack_Type;
+
+   --  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 : Address; Arg : Address) 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
+   pragma Export (C, Main_Stack, "grt_stack_main_stack");
+
+   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/translate/grt/grt-stats.adb b/translate/grt/grt-stats.adb
new file mode 100644
index 000000000..9e3259cd0
--- /dev/null
+++ b/translate/grt/grt-stats.adb
@@ -0,0 +1,326 @@
+--  GHDL Run Time (GRT) - statistics.
+--  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 System; use System;
+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
+      Fmt : constant String := "%3d.%03d" & Character'Val (0);
+
+      procedure fprintf (Stream : FILEs; Fmt : Address; A, B : Clock_T);
+      pragma Import (C, fprintf);
+
+      Sec : Clock_T;
+      Ms : Clock_T;
+   begin
+      Sec := Val / One_Second;
+
+      --  Avoid overflow.
+      Ms := ((Val mod One_Second) * 1000) / One_Second;
+
+      fprintf (Stream, Fmt'Address, 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;
+
+   --  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;
+
+   Simu_Time : Time_Stats;
+
+   procedure Start_Elaboration is
+   begin
+      One_Second := Get_Clk_Tck;
+      Proc_Times := (0, 0, 0);
+
+      Get_Stats (Start_Time);
+   end Start_Elaboration;
+
+   procedure Start_Order is
+   begin
+      Get_Stats (End_Elab_Time);
+   end Start_Order;
+
+   procedure Start_Cycles is
+   begin
+      Get_Stats (End_Order_Time);
+   end Start_Cycles;
+
+   procedure Start_Processes is
+   begin
+      Get_Stats (Start_Proc_Time);
+   end Start_Processes;
+
+   procedure End_Processes
+   is
+      Now : Time_Stats;
+   begin
+      Get_Stats (Now);
+      Proc_Times := Proc_Times + (Now - Start_Proc_Time);
+   end End_Processes;
+
+   procedure Start_Update is
+   begin
+      Get_Stats (Start_Update_Time);
+   end Start_Update;
+
+   procedure End_Update
+   is
+      Now : Time_Stats;
+   begin
+      Get_Stats (Now);
+      Update_Times := Update_Times + (Now - Start_Update_Time);
+   end End_Update;
+
+   procedure Start_Next_Time is
+   begin
+      Get_Stats (Start_Next_Time_Time);
+   end Start_Next_Time;
+
+   procedure End_Next_Time
+   is
+      Now : Time_Stats;
+   begin
+      Get_Stats (Now);
+      Next_Time_Times := Next_Time_Times + (Now - Start_Next_Time_Time);
+   end End_Next_Time;
+
+   procedure End_Simulation
+   is
+      Now : Time_Stats;
+   begin
+      Get_Stats (Now);
+      Simu_Time := Now - Start_Time;
+   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;
+
+      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_B2 => "B2: ",
+                                               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;
+      Mode_Counts := (others => 0);
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         declare
+            Sig : Ghdl_Signal_Ptr;
+         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;
+            end if;
+            Mode_Counts (Sig.Mode) := Mode_Counts (Sig.Mode) + 1;
+            if Sig.Flags.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 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
+   begin
+      Put (stdout, "total:          ");
+      Put (stdout, Simu_Time);
+      New_Line (stdout);
+      Put (stdout, " elab:          ");
+      Put (stdout, End_Elab_Time - Start_Time);
+      New_Line (stdout);
+      Put (stdout, " internal elab: ");
+      Put (stdout, End_Order_Time - End_Elab_Time);
+      New_Line (stdout);
+      Put (stdout, " cycle (sum):   ");
+      Put (stdout, Proc_Times + Update_Times + Next_Time_Times);
+      New_Line (stdout);
+      Put (stdout, "  processes:    ");
+      Put (stdout, Proc_Times);
+      New_Line (stdout);
+      Put (stdout, "  update:       ");
+      Put (stdout, Update_Times);
+      New_Line (stdout);
+      Put (stdout, "  next compute: ");
+      Put (stdout, Next_Time_Times);
+      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;
+
+   end Disp_Stats;
+end Grt.Stats;
diff --git a/translate/grt/grt-stats.ads b/translate/grt/grt-stats.ads
new file mode 100644
index 000000000..c03f11b02
--- /dev/null
+++ b/translate/grt/grt-stats.ads
@@ -0,0 +1,44 @@
+--  GHDL Run Time (GRT) - statistics.
+--  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 Grt.Stats is
+   --  Entry points to gather statistics.
+   procedure Start_Elaboration;
+   procedure Start_Order;
+   procedure Start_Cycles;
+
+   --  Time in user processes.
+   procedure Start_Processes;
+   procedure End_Processes;
+
+   --  Time in next time computation.
+   procedure Start_Next_Time;
+   procedure End_Next_Time;
+
+   --  Time in signals update.
+   procedure Start_Update;
+   procedure End_Update;
+
+   procedure End_Simulation;
+
+   --  Disp all statistics.
+   procedure Disp_Stats;
+end Grt.Stats;
+
+
+
diff --git a/translate/grt/grt-stdio.ads b/translate/grt/grt-stdio.ads
new file mode 100644
index 000000000..fad33226b
--- /dev/null
+++ b/translate/grt/grt-stdio.ads
@@ -0,0 +1,110 @@
+--  GHDL Run Time (GRT) - stdio binding.
+--  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 System;
+
+--  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;
+
+   --  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;
+
+   --  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/translate/grt/grt-types.ads b/translate/grt/grt-types.ads
new file mode 100644
index 000000000..5c8191070
--- /dev/null
+++ b/translate/grt/grt-types.ads
@@ -0,0 +1,294 @@
+--  GHDL Run Time (GRT) - 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 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 Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Interfaces; use Interfaces;
+
+package Grt.Types is
+   pragma Preelaborate (Grt.Types);
+
+   type Ghdl_B2 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 ** Word_Size;
+   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_Base is array (Ghdl_Index_Type) of Std_Character;
+   type Std_String_Basep is access Std_String_Base;
+
+   type Std_String_Bound is record
+      Dim_1 : Std_Integer_Trt;
+   end record;
+   type Std_String_Boundp is access Std_String_Bound;
+
+   type Std_String is record
+      Base : Std_String_Basep;
+      Bounds : Std_String_Boundp;
+   end record;
+
+   --  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);
+
+   type Std_String_Ptr is access Std_String;
+
+   --  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;
+
+   --  Identifier for a process.
+   type Process_Id is new Integer;
+   Nul_Process_Id : constant Process_Id := 0;
+
+   --  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_B2, Mode_E8, Mode_E32, Mode_I32, Mode_I64, Mode_F64);
+
+   type Ghdl_B2_Array is array (Ghdl_Index_Type range <>) of Ghdl_B2;
+   type Ghdl_E8_Array is array (Ghdl_Index_Type range <>) of Ghdl_E8;
+   type Ghdl_I32_Array is array (Ghdl_Index_Type range <>) of Ghdl_I32;
+
+   type Value_Union (Mode : Mode_Type := Mode_B2) is record
+      case Mode is
+         when Mode_B2 =>
+            B2 : Ghdl_B2;
+         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_B2 is record
+      Left : Ghdl_B2;
+      Right : Ghdl_B2;
+      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_B2)
+   is record
+      case K is
+         when Mode_B2 =>
+            B2 : Ghdl_Range_B2;
+         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_Transaction, Mode_Delayed, 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;
+
+   --  Kind of a signal.
+   type Kind_Signal_Type is
+     (Kind_Signal_No, Kind_Signal_Register, Kind_Signal_Bus);
+   pragma Convention (C, Kind_Signal_Type);
+
+   --  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/translate/grt/grt-values.adb b/translate/grt/grt-values.adb
new file mode 100644
index 000000000..404a2a42e
--- /dev/null
+++ b/translate/grt/grt-values.adb
@@ -0,0 +1,215 @@
+--  GHDL Run Time (GRT) - 'value subprograms.
+--  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 Grt.Errors; use Grt.Errors;
+
+package body Grt.Values is
+
+   NBSP : constant Character := Character'Val (160);
+   HT : constant Character := Character'Val (9);
+
+   function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32
+   is
+      S : constant Std_String_Basep := Str.Base;
+      Len : constant Ghdl_Index_Type := Str.Bounds.Dim_1.Length;
+      Pos : Ghdl_Index_Type := 0;
+      C : Character;
+      Sep : Character;
+      Val, D, Base : Ghdl_I32;
+      Exp : Integer;
+   begin
+      --  LRM 14.1
+      --  Leading [and trailing] whitespace is allowed and ignored.
+      --
+      --  GHDL: allow several leading whitespace.
+      while Pos < Len loop
+         case S (Pos) is
+            when ' '
+              | NBSP
+              | HT =>
+               Pos := Pos + 1;
+            when others =>
+               exit;
+         end case;
+      end loop;
+
+      if Pos = Len then
+         Error_E ("'value: empty string");
+      end if;
+      C := S (Pos);
+
+      --  Be user friendly.
+      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 greather than 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;
+
+      --  LRM 14.1
+      --  [Leading] and trailing whitespace is allowed and ignored.
+      --
+      --  GHDL: allow several leading whitespace.
+      while Pos < Len loop
+         case S (Pos) is
+            when ' '
+              | NBSP
+              | HT =>
+               Pos := Pos + 1;
+            when others =>
+               Error_E ("'value: trailing characters after blank");
+         end case;
+      end loop;
+
+      return Val;
+   end Ghdl_Value_I32;
+
+end Grt.Values;
diff --git a/translate/grt/grt-values.ads b/translate/grt/grt-values.ads
new file mode 100644
index 000000000..25bde5abf
--- /dev/null
+++ b/translate/grt/grt-values.ads
@@ -0,0 +1,25 @@
+--  GHDL Run Time (GRT) - 'value subprograms.
+--  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 Grt.Types; use Grt.Types;
+--  with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Values is
+   function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32;
+private
+   pragma Export (C, Ghdl_Value_I32, "__ghdl_value_i32");
+end Grt.Values;
diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb
new file mode 100644
index 000000000..66f248c5d
--- /dev/null
+++ b/translate/grt/grt-vcd.adb
@@ -0,0 +1,716 @@
+--  GHDL Run Time (GRT) - VCD generator.
+--  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;
+with Grt.Stdio; use Grt.Stdio;
+with System; use System;
+with Grt.Errors; use Grt.Errors;
+with Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+with GNAT.Table;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Types; use Grt.Rtis_Types;
+
+package body Grt.Vcd is
+   --  VCD filename.
+   Vcd_Filename : String_Access := null;
+   --  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 : Natural := Opt'First;
+   begin
+      if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vcd" then
+         return False;
+      end if;
+      if Opt'Length > 6 and then Opt (F + 5) = '=' then
+         --  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;
+         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");
+   end Vcd_Help;
+
+   procedure Vcd_Put (Str : String)
+   is
+      R : size_t;
+   begin
+      R := fwrite (Str'Address, Str'Length, 1, Vcd_Stream);
+   end Vcd_Put;
+
+   procedure Vcd_Putc (C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), Vcd_Stream);
+   end Vcd_Putc;
+
+   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
+   begin
+      Put_I32 (Vcd_Stream, V);
+   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
+      Mode : constant String := "wt" & NUL;
+   begin
+      if Vcd_Filename = null then
+         Vcd_Stream := NULL_Stream;
+         return;
+      end if;
+      if Vcd_Filename.all = "-" & NUL then
+         Vcd_Stream := stdout;
+      else
+         Vcd_Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
+         if Vcd_Stream = NULL_Stream then
+            Error_C ("cannot open ");
+            Error_E (Vcd_Filename (Vcd_Filename'First
+                                   .. Vcd_Filename'Last - 1));
+            return;
+         end if;
+      end if;
+      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 chars;
+         pragma Import (C, ctime);
+
+         R : int;
+      begin
+         Cur_Time := time (Null_Address);
+         R := fputs (ctime (Cur_Time'Address), Vcd_Stream);
+         -- Note: ctime already append a LF.
+      end;
+      Vcd_Put_End;
+      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 GNAT.Table
+     (Table_Component_Type => Verilog_Wire_Info,
+      Table_Index_Type => Vcd_Index_Type,
+      Table_Low_Bound => 0,
+      Table_Initial => 32,
+      Table_Increment => 100);
+
+   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;
+      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;
+      Sig_Rti : Ghdl_Rtin_Object_Acc;
+      Rti : Ghdl_Rti_Access;
+      Error : AvhpiErrorT;
+      Sig_Addr : Address;
+   begin
+      Sig_Rti := To_Ghdl_Rtin_Object_Acc (Avhpi_Get_Rti (Sig));
+
+      --  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_B2
+           | 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_Subtype_Array_Ptr =>
+            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 := To_Addr_Acc (Sig_Addr).all;
+               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_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_B2)
+   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;
+
+   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.B2);
+               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);
+               when Vcd_Bitvector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(J).Value.B2);
+                  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.B2);
+               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);
+               when Vcd_Bitvector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Bit
+                       (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.B2);
+                  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 =>
+                  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 =>
+                  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
+   begin
+      Vcd_Putc ('#');
+      Put_I64 (Vcd_Stream, Ghdl_I64 (Cycle_Time));
+      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_Stream = NULL_Stream 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
+      --  Do nothing if there is no VCD file to generate.
+      if Vcd_Stream = NULL_Stream then
+         return;
+      end if;
+
+      --  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
+      null;
+   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/translate/grt/grt-vcd.ads b/translate/grt/grt-vcd.ads
new file mode 100644
index 000000000..40b9d8c5e
--- /dev/null
+++ b/translate/grt/grt-vcd.ads
@@ -0,0 +1,48 @@
+--  GHDL Run Time (GRT) - VCD generator.
+--  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 System; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Avhpi; use Grt.Avhpi;
+
+package Grt.Vcd is
+   type Vcd_Var_Kind is (Vcd_Bad,
+                         Vcd_Bool,
+                         Vcd_Integer32,
+                         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/translate/grt/grt-vital_annotate.adb b/translate/grt/grt-vital_annotate.adb
new file mode 100644
index 000000000..9a31bf454
--- /dev/null
+++ b/translate/grt/grt-vital_annotate.adb
@@ -0,0 +1,467 @@
+--  GHDL Run Time (GRT) - VITAL annotator.
+--  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 Grt.Sdf;
+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 : 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
+     (Name : String; Res : out VhpiHandleT; Ok : out Boolean)
+   is
+      Error : AvhpiErrorT;
+      It : VhpiHandleT;
+   begin
+      Ok := False;
+      Vhpi_Iterator (VhpiDecls, Sdf_Inst, It, Error);
+      if Error /= AvhpiErrorOk then
+         return;
+      end if;
+      loop
+         Vhpi_Scan (It, Res, Error);
+         exit when Error /= AvhpiErrorOk;
+         exit when Vhpi_Get_Kind (Res) /= VhpiGenericDeclK;
+         if Name_Compare (Res, Name) then
+            Ok := True;
+            return;
+         end if;
+      end loop;
+      return;
+   end Find_Generic;
+
+   procedure Sdf_Header (Context : in out 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 : in out 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 : in out 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;
+
+   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;
+
+   procedure Sdf_Generic (Context : in out Sdf_Context_Type;
+                          Name : String;
+                          Ok : out Boolean)
+   is
+      Gen : VhpiHandleT;
+      Gen_Type : 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;
+
+      Find_Generic (Name, Gen, Ok);
+      if not Ok then
+         return;
+      end if;
+
+      Ok := False;
+
+      --  Extract subtype.
+      Vhpi_Handle (VhpiSubtype, Gen, Gen_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiSubtype");
+         return;
+      end if;
+      Vhpi_Handle (VhpiTypeMark, Gen_Type, Gen_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiTypeMark");
+         return;
+      end if;
+      if Vhpi_Compare_Handles (Gen_Type, VitalDelayType01) then
+         case Context.Timing_Nbr is
+            when 1 =>
+               Ok := Write_Td_Delay_Generic (Context, Gen, 2, Map_1);
+            when 2 =>
+               Ok := Write_Td_Delay_Generic (Context, Gen, 2, Map_2);
+            when others =>
+               Errors.Error
+                 ("timing generic type mismatch SDF timing specification");
+         end case;
+      else
+         Errors.Error ("bad generic type");
+      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
+            exit L1 when E > Arg'Last;
+            E := E + 1;
+         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;
+      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 Name_Compare (Decl, "vitaldelaytype01") then
+            VitalDelayType01 := Decl;
+         end if;
+      end loop;
+      if Vhpi_Get_Kind (VitalDelayType01) = VhpiUndefined then
+         Error ("cannot found VitalDelayType01 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 (Opt : String) return Boolean
+   is
+   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/translate/grt/grt-vital_annotate.ads b/translate/grt/grt-vital_annotate.ads
new file mode 100644
index 000000000..f1a8b0255
--- /dev/null
+++ b/translate/grt/grt-vital_annotate.ads
@@ -0,0 +1,35 @@
+--  GHDL Run Time (GRT) - VITAL annotator.
+--  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 Grt.Sdf; use Grt.Sdf;
+
+package Grt.Vital_Annotate is
+   pragma Elaborate_Body (Grt.Vital_Annotate);
+
+   procedure Sdf_Header (Context : in out Sdf_Context_Type);
+   procedure Sdf_Celltype (Context : in out Sdf_Context_Type);
+   procedure Sdf_Instance (Context : in out Sdf_Context_Type;
+                           Instance : String;
+                           Status : out Boolean);
+   procedure Sdf_Instance_End (Context : in out 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/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb
new file mode 100644
index 000000000..0609d466c
--- /dev/null
+++ b/translate/grt/grt-vpi.adb
@@ -0,0 +1,800 @@
+--  GHDL Run Time (GRT) - VPI interface.
+--  Copyright (C) 2002, 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
+--              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 Grt.Stdio; use Grt.Stdio;
+with Grt.Signals; use Grt.Signals;
+with GNAT.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;
+
+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 Natural;
+
+-------------------------------------------------------------------------------
+-- * * *   h e l p e r s   * * * * * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   ------------------------------------------------------------------------
+   -- debugging helpers
+   procedure dbgPut (Str : String)
+   is
+      S : size_t;
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, stderr);
+   end dbgPut;
+
+   procedure dbgPut (C : Character)
+   is
+      R : int;
+   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_B2 (Val : Ghdl_B2)
+   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_B2;
+
+   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 =>
+                  return null;
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Bitvector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_B2
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Value.B2);
+                  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 =>
+                  return null;
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Bitvector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_B2
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.B2);
+                  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  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 GNAT.Table
+     (Table_Component_Type => Vpi_Var_Type,
+      Table_Index_Type     => Vpi_Index_Type,
+      Table_Low_Bound      => 0,
+      Table_Initial        => 32,
+      Table_Increment      => 100);
+
+   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;
+
+   -- 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 (aObj);
+      pragma Unreferenced (aValue);
+      pragma Unreferenced (aWhen);
+      pragma Unreferenced (aFlags);
+   begin
+      return null;
+   end vpi_put_value;
+
+   -- 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 : 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;
+   begin
+      if g_cbEndOfCompile /= null then
+         Res := g_cbEndOfCompile.Cb_Rtn.all (g_cbEndOfCompile);
+      end if;
+      if Vpi_Filename /= null then
+         Register_Cycle_Hook (Vpi_Cycle'Access);
+      end if;
+   end Vpi_Start;
+
+   ------------------------------------------------------------------------
+   --  Called before each non delta cycle.
+   procedure Vpi_Cycle
+   is
+      Res : Integer;
+   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;
+   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/translate/grt/grt-vpi.ads b/translate/grt/grt-vpi.ads
new file mode 100644
index 000000000..9f4ffa93c
--- /dev/null
+++ b/translate/grt/grt-vpi.ads
@@ -0,0 +1,251 @@
+--  GHDL Run Time (GRT) - VPI interface.
+--  Copyright (C) 2002, 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
+--              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;
+
+   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/translate/grt/grt-vstrings.adb b/translate/grt/grt-vstrings.adb
new file mode 100644
index 000000000..17c64e3da
--- /dev/null
+++ b/translate/grt/grt-vstrings.adb
@@ -0,0 +1,243 @@
+--  GHDL Run Time (GRT) - variable strings.
+--  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 Grt.Errors; use Grt.Errors;
+
+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 : 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 : 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 : Natural := Vstr.Len;
+      L : 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 : Natural := Length (Rstr);
+      Nlen : 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 : 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;
+   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;
+end Grt.Vstrings;
diff --git a/translate/grt/grt-vstrings.ads b/translate/grt/grt-vstrings.ads
new file mode 100644
index 000000000..f4287588d
--- /dev/null
+++ b/translate/grt/grt-vstrings.ads
@@ -0,0 +1,100 @@
+--  GHDL Run Time (GRT) - variable strings.
+--  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 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);
+
+   --  FIRST is the index of the first character.
+   --  Requires at least 11 characters.
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I32);
+
+   --  Requires at least 21 characters.
+   procedure To_String (Str : out String; First : out Natural; N : 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/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb
new file mode 100644
index 000000000..93f217e82
--- /dev/null
+++ b/translate/grt/grt-waves.adb
@@ -0,0 +1,1486 @@
+--  GHDL Run Time (GRT) - wave dumper (GHW) module.
+--  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.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Interfaces; use Interfaces;
+with Grt.Types; use Grt.Types;
+with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Stdio; use Grt.Stdio;
+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.Avhpi; use Grt.Avhpi;
+with GNAT.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);
+
+package body Grt.Waves is
+   --  Waves filename.
+   Wave_Filename : String_Access := null;
+   --  Stream corresponding to the VCD 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_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
+
+   --  Return TRUE if OPT is an option for VCD.
+   function Wave_Option (Opt : String) return Boolean
+   is
+      F : 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;
+   begin
+      R := fwrite (Str'Address, Str'Length, 1, Wave_Stream);
+   end Wave_Put;
+
+   procedure Wave_Putc (C : Character)
+   is
+      R : int;
+   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;
+   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;
+   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;
+   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;
+   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_B2 =>
+            Wave_Put_Byte (Ghdl_B2'Pos (Value.B2));
+         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 GNAT.Table
+     (Table_Component_Type => Header_Type,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   --  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.
+      if Integer'Size = 32 then
+         Wave_Put_Byte (4);
+      elsif Integer'Size = 64 then
+         Wave_Put_Byte (8);
+      else
+         Wave_Put_Byte (0);
+      end if;
+      --  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 := "wt" & 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 ("Wave.Avhpi_Error!");
+      null;
+   end Avhpi_Error;
+
+   package Str_Table is new GNAT.Table
+     (Table_Component_Type => Ghdl_C_String,
+      Table_Index_Type => AVL_Value,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   package Str_AVL is new GNAT.Table
+     (Table_Component_Type => AVL_Node,
+      Table_Index_Type => AVL_Nid,
+      Table_Low_Bound => AVL_Root,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   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, Ghdl_I32 (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;
+
+   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;
+
+   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 GNAT.Table
+     (Table_Component_Type => Type_Node,
+      Table_Index_Type => AVL_Value,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   package Types_AVL is new GNAT.Table
+     (Table_Component_Type => AVL_Node,
+      Table_Index_Type => AVL_Nid,
+      Table_Low_Bound => AVL_Root,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   function Type_Compare (L, R : AVL_Value) return Integer
+   is
+      use System;
+      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 typr (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_B2
+           | Ghdl_Rtik_Type_E8 =>
+            N_Ctxt := Null_Context;
+         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 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_B2
+           | 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
+           | Ghdl_Rtik_Subtype_Array_Ptr =>
+            declare
+               Arr : Ghdl_Rtin_Subtype_Array_Acc;
+            begin
+               Arr := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Create_String_Id (Arr.Name);
+               if Rti.Mode = 1 then
+                  N_Ctxt := Ctxt;
+               end if;
+               Create_Type (To_Ghdl_Rti_Access (Arr.Basetype), N_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 : Ghdl_Rtin_Unit_Acc;
+            begin
+               Base := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+               Create_String_Id (Base.Name);
+               for I in 1 .. Base.Nbr loop
+                  Unit := To_Ghdl_Rtin_Unit_Acc (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.
+      Types_Table.Append (Type_Node'(Type_Rti => Rti, Context => N_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 Create_Type;
+
+   procedure Create_Object_Type (Obj : VhpiHandleT)
+   is
+      Obj_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      --  Extract type of the signal.
+      Vhpi_Handle (VhpiSubtype, Obj, Obj_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Create_Type (Avhpi_Get_Rti (Obj_Type), Avhpi_Get_Context (Obj_Type));
+   end Create_Object_Type;
+
+   procedure Write_Object_Type (Obj : VhpiHandleT)
+   is
+      Obj_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      --  Extract type of the signal.
+      Vhpi_Handle (VhpiSubtype, Obj, Obj_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Write_Type_Id (Avhpi_Get_Rti (Obj_Type), Avhpi_Get_Context (Obj_Type));
+   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_B2 =>
+            Mode := Mode_B2;
+         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;
+
+   procedure Write_Signal_Number (Val_Addr : Address;
+                                  Val_Name : Vstring;
+                                  Val_Type : Ghdl_Rti_Access)
+   is
+      pragma Unreferenced (Val_Name);
+      pragma Unreferenced (Val_Type);
+
+      function To_Integer_Address is new Ada.Unchecked_Conversion
+        (Ghdl_Signal_Ptr, Integer_Address);
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      Sig := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+      if not Sig.Flags.Is_Dumped then
+         Sig.Flags.Is_Dumped := True;
+         Nbr_Dumped_Signals := Nbr_Dumped_Signals + 1;
+      end if;
+      Wave_Put_ULEB128 (Ghdl_E32 (To_Integer_Address (Sig.Flink)));
+   end Write_Signal_Number;
+
+   procedure Foreach_Scalar_Signal_Number is new
+     Grt.Rtis_Utils.Foreach_Scalar (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);
+   end Write_Signal_Numbers;
+
+   procedure Write_Hierarchy_El (Decl : VhpiHandleT)
+   is
+      Mode2hie : constant array (VhpiModeP) 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 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;
+
+   procedure Wave_Put_Hierarchy (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;
+
+      --  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 =>
+               case Step is
+                  when Step_Name =>
+                     Create_String_Id (Avhpi_Get_Base_Name (Decl));
+                     if Vhpi_Get_Kind (Decl) = VhpiForGenerateK then
+                        Create_Generate_Type (Decl);
+                     end if;
+                  when Step_Hierarchy =>
+                     Write_Hierarchy_El (Decl);
+               end case;
+               Wave_Put_Hierarchy (Decl, Step);
+               if Step = Step_Hierarchy then
+                  Wave_Put_Byte (Ghw_Hie_Eos);
+               end if;
+            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");
+--                 Wave_Put ("unknown ");
+--                 Wave_Put (VhpiClassKindT'Image (Vhpi_Get_Kind (Decl)));
+--                 Wave_Newline;
+         end case;
+      end loop;
+   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;
+
+   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_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;
+         --  Kind.
+         Wave_Put_Byte (Ghdl_Rtik'Pos (Rti.Kind));
+         case Rti.Kind is
+            when Ghdl_Rtik_Type_B2
+              | 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
+              | Ghdl_Rtik_Subtype_Array_Ptr =>
+               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_Rtin_Unit_Acc;
+               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 := To_Ghdl_Rtin_Unit_Acc (Base.Units (I - 1));
+                     Write_String_Id (Unit.Name);
+                     case Base.Common.Mode is
+                        when 0 =>
+                           --  Value is locally static.
+                           case Base.Common.Kind is
+                              when Ghdl_Rtik_Type_P32 =>
+                                 Wave_Put_SLEB128 (Unit.Value.Unit_32);
+                              when Ghdl_Rtik_Type_P64 =>
+                                 Wave_Put_LSLEB128 (Unit.Value.Unit_64);
+                              when others =>
+                                 Internal_Error
+                                   ("wave.write_types(P32/P64-0)");
+                           end case;
+                        when 1 =>
+                           case Rti.Kind is
+                              when Ghdl_Rtik_Type_P32 =>
+                                 Wave_Put_SLEB128 (Unit.Value.Unit_Addr.I32);
+                              when Ghdl_Rtik_Type_P64 =>
+                                 Wave_Put_LSLEB128 (Unit.Value.Unit_Addr.I64);
+                              when others =>
+                                 Internal_Error
+                                   ("wave.write_types(P32/P64-1)");
+                           end case;
+                        when others =>
+                           Internal_Error ("wave.write_types(P32/P64)");
+                     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 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 GNAT.Table
+     (Table_Component_Type => Ghdl_Signal_Ptr,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 32,
+      Table_Increment => 100);
+
+   procedure Write_Hierarchy (Root : VhpiHandleT)
+   is
+      function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
+        (Source => Integer_Address, Target => Ghdl_Signal_Ptr);
+      N : Natural;
+   begin
+      --  Number signals.
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         if Sig_Table.Table (I).Flink /= null then
+            Internal_Error ("wave.write_hierarchy");
+         end if;
+         Sig_Table.Table (I).Flink :=
+           To_Ghdl_Signal_Ptr (Integer_Address (I - Sig_Table.First + 1));
+      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);
+
+      --  Save and clear.
+      N := 0;
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         if Sig_Table.Table (I).Flags.Is_Dumped then
+            N := N + 1;
+            Dump_Table.Table (N) := Sig_Table.Table (I);
+         end if;
+         Sig_Table.Table (I).Flink := null;
+      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/translate/grt/grt-waves.ads b/translate/grt/grt-waves.ads
new file mode 100644
index 000000000..cb5fdf962
--- /dev/null
+++ b/translate/grt/grt-waves.ads
@@ -0,0 +1,20 @@
+--  GHDL Run Time (GRT) - wave dumper (GHW) module.
+--  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 Grt.Waves is
+   procedure Register;
+end Grt.Waves;
diff --git a/translate/grt/grt.adc b/translate/grt/grt.adc
new file mode 100644
index 000000000..889fcbd9b
--- /dev/null
+++ b/translate/grt/grt.adc
@@ -0,0 +1,36 @@
+--  GHDL Run Time (GRT) - Configuration pragmas.
+--  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.
+
+--  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_Tasking);
+pragma No_Run_Time;
diff --git a/translate/grt/grt.ads b/translate/grt/grt.ads
new file mode 100644
index 000000000..fbad5174c
--- /dev/null
+++ b/translate/grt/grt.ads
@@ -0,0 +1,20 @@
+--  GHDL Run Time (GRT) - Top of hierarchy.
+--  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 Grt is
+   pragma Pure (Grt);
+end Grt;
diff --git a/translate/grt/main.adb b/translate/grt/main.adb
new file mode 100644
index 000000000..1b6499af4
--- /dev/null
+++ b/translate/grt/main.adb
@@ -0,0 +1,25 @@
+--  GHDL Run Time (GRT) - C-like entry point.
+--  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 Ghdl_Main;
+
+function Main (Argc : Integer; Argv : System.Address)
+   return Integer
+is
+begin
+   return Ghdl_Main (Argc, Argv);
+end Main;
diff --git a/translate/grt/main.ads b/translate/grt/main.ads
new file mode 100644
index 000000000..d53dbee5a
--- /dev/null
+++ b/translate/grt/main.ads
@@ -0,0 +1,27 @@
+--  GHDL Run Time (GRT) - C-like entry point.
+--  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.
+
+--  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/translate/ortho_front.adb b/translate/ortho_front.adb
new file mode 100644
index 000000000..933c2ceae
--- /dev/null
+++ b/translate/ortho_front.adb
@@ -0,0 +1,443 @@
+--  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 Std_Names;
+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;
+
+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.
+      Back_End.Finish_Compilation := Trans_Be.Finish_Compilation'Access;
+      Back_End.Sem_Foreign := Trans_Be.Sem_Foreign'Access;
+      Std_Names.Std_Names_Initialize;
+      Libraries.Init_Pathes;
+      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.all = "-c" then
+         if Action /= Action_Anaelab then
+            Error_Msg_Option
+              ("-c option allowed only after --anaelab options");
+            return 0;
+         end if;
+         if Arg = null then
+            Error_Msg_Option ("filename required after -c");
+            return 0;
+         end if;
+         declare
+            L : Id_Link_Acc;
+         begin
+            L := new Id_Link'(Id => Name_Table.Get_Identifier (Arg.all),
+                              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
+         Flags.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 Flags.Parse_Option (Opt (7 .. Opt'Last)) then
+            return 1;
+         else
+            return 0;
+         end if;
+      elsif Flags.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
+        | Elaboration_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/translate/trans_be.adb b/translate/trans_be.adb
new file mode 100644
index 000000000..60d886c1a
--- /dev/null
+++ b/translate/trans_be.adb
@@ -0,0 +1,149 @@
+--  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 Disp_Tree;
+with Disp_Vhdl;
+with Sem;
+with Canon;
+with Translation;
+with Errorout; use Errorout;
+with Post_Sems;
+with Flags;
+with Ada.Text_IO;
+
+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_Declaration 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.
+         if Flags.Verbose then
+            Put_Line ("translate " & Disp_Node (Lib));
+         end if;
+
+         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;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Design_Unit =>
+            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, False);
+   end Sem_Foreign;
+end Trans_Be;
diff --git a/translate/trans_be.ads b/translate/trans_be.ads
new file mode 100644
index 000000000..233ee0bf0
--- /dev/null
+++ b/translate/trans_be.ads
@@ -0,0 +1,26 @@
+--  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;
+
+package Trans_Be is
+   procedure Finish_Compilation
+     (Unit : Iir_Design_Unit; Main : Boolean := False);
+
+   procedure Sem_Foreign (Decl : Iir);
+end Trans_Be;
+
diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads
new file mode 100644
index 000000000..20498e4df
--- /dev/null
+++ b/translate/trans_decls.ads
@@ -0,0 +1,211 @@
+--  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
+   --  Procedure called in case of assert failed.
+   Ghdl_Assert_Failed : O_Dnode;
+   --  Procedure for report statement.
+   Ghdl_Report : O_Dnode;
+   --  Ortho node for default report message.
+   Ghdl_Assert_Default_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;
+
+   --  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;
+
+   --  NOW variables.
+   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_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_B2 : O_Dnode;
+   Ghdl_Signal_Init_B2 : O_Dnode;
+   Ghdl_Signal_Simple_Assign_B2 : O_Dnode;
+   Ghdl_Signal_Start_Assign_B2 : O_Dnode;
+   Ghdl_Signal_Next_Assign_B2 : O_Dnode;
+   Ghdl_Signal_Associate_B2 : O_Dnode;
+   Ghdl_Signal_Driving_Value_B2 : 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_L0 : 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;
+
+   --  RTI root.
+   Ghdl_Rti_Top : O_Dnode;
+   Ghdl_Rti_Top_Ptr : O_Dnode;
+   Ghdl_Rti_Top_Instance : 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_Endfile : O_Dnode;
+
+   --  'Image attributes.
+   Ghdl_Image_B2 : O_Dnode;
+   Ghdl_Image_E8 : 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_B2 : O_Dnode;
+   Ghdl_Value_E8 : 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;
+
+   Ghdl_Elaborate : O_Dnode;
+end Trans_Decls;
diff --git a/translate/translation.adb b/translate/translation.adb
new file mode 100644
index 000000000..786a9b299
--- /dev/null
+++ b/translate/translation.adb
@@ -0,0 +1,27760 @@
+--  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 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;
+with Ada.Text_IO;
+with Types; use Types;
+with Errorout; use Errorout;
+with Name_Table; -- use Name_Table;
+with Iirs_Utils; use Iirs_Utils;
+with Std_Package; use Std_Package;
+with Libraries;
+with Files_Map;
+with Std_Names;
+with Configuration;
+with Interfaces.C_Streams;
+with Sem_Names;
+with Sem;
+with Iir_Chains; use Iir_Chains;
+with Nodes;
+with GNAT.Table;
+with Canon;
+with Trans_Decls; use Trans_Decls;
+
+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;
+   --  Ortho type node for string template pointer.
+   Std_String_Ptr_Node : O_Tnode;
+   Std_String_Node : O_Tnode;
+
+   --  Ortho type for std.integer.
+   Std_Integer_Type_Node : O_Tnode;
+
+   --  Ortho type for std.real.
+   Std_Real_Type_Node : O_Tnode;
+
+   --  Ortho type node for std.time.
+   Std_Time_Type : O_Tnode;
+
+   --  Ortho type for std.file_open_status.
+   Std_File_Open_Status_Type : O_Tnode;
+
+   --  Node for the variable containing the current filename.
+   Current_Filename_Node : O_Dnode := O_Dnode_Null;
+
+   --  Global declarations.
+   Ghdl_Ptr_Type : O_Tnode;
+   Const_Ptr_Type_Node : 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;
+
+   --  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_Node : O_Fnode;
+   Ghdl_Signal_Driving_Value_Node : O_Fnode;
+   Ghdl_Signal_Last_Value_Node : O_Fnode;
+   Ghdl_Signal_Last_Event_Node : O_Fnode;
+   Ghdl_Signal_Last_Active_Node : O_Fnode;
+   Ghdl_Signal_Event_Node : O_Fnode;
+   Ghdl_Signal_Active_Node : 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.
+   type Wk_Ident_Type is
+     (
+      Wkie_This, Wkie_Size, Wkie_Res, Wkie_Dir_To, Wkie_Dir_Downto,
+      Wkie_Left, Wkie_Right, Wkie_Dir, Wkie_Length, Wkie_Kind, Wkie_Dim,
+      Wkie_I, Wkie_Instance, Wkie_Arch_Instance, Wkie_Name, Wkie_Sig,
+      Wkie_Obj, Wkie_Rti, Wkie_Parent
+      );
+   type Wk_Ident_Tree_Array is array (Wk_Ident_Type) of O_Ident;
+   Wk_Idents : Wk_Ident_Tree_Array;
+   Wki_This : O_Ident renames Wk_Idents (Wkie_This);
+   Wki_Size : O_Ident renames Wk_Idents (Wkie_Size);
+   Wki_Res : O_Ident renames Wk_Idents (Wkie_Res);
+   Wki_Dir_To : O_Ident renames Wk_Idents (Wkie_Dir_To);
+   Wki_Dir_Downto : O_Ident renames Wk_Idents (Wkie_Dir_Downto);
+   Wki_Left : O_Ident renames Wk_Idents (Wkie_Left);
+   Wki_Right : O_Ident renames Wk_Idents (Wkie_Right);
+   Wki_Dir : O_Ident renames Wk_Idents (Wkie_Dir);
+   Wki_Length : O_Ident renames Wk_Idents (Wkie_Length);
+   Wki_Kind : O_Ident renames Wk_Idents (Wkie_Kind);
+   Wki_Dim : O_Ident renames Wk_Idents (Wkie_Dim);
+   Wki_I : O_Ident renames Wk_Idents (Wkie_I);
+   Wki_Instance : O_Ident renames Wk_Idents (Wkie_Instance);
+   Wki_Arch_Instance : O_Ident renames Wk_Idents (Wkie_Arch_Instance);
+   Wki_Name : O_Ident renames Wk_Idents (Wkie_Name);
+   Wki_Sig : O_Ident renames Wk_Idents (Wkie_Sig);
+   Wki_Obj : O_Ident renames Wk_Idents (Wkie_Obj);
+   Wki_Rti : O_Ident renames Wk_Idents (Wkie_Rti);
+   Wki_Parent : O_Ident renames Wk_Idents (Wkie_Parent);
+
+   --  ALLOCATION_KIND defines the type of memory storage.
+   --  ALLOC_STACK means the object is allocated on the local stack and
+   --    deallocated at the end of the function.
+   --  ALLOC_SYSTEM for object created during design elaboration and whose
+   --    life is infinite.
+   --  ALLOC_RETURN for unconstrained object returns by function.
+   --  ALLOC_HEAP for object created by new.
+   type Allocation_Kind is
+     (Alloc_Stack, Alloc_Return, Alloc_Heap, Alloc_System);
+
+   package Chap10 is
+      --  There are three data storage kind: global, local or instance.
+      --  For example, a constant can have:
+      --  * a global storage when declared inside a package.  This storage
+      --    can be accessed from any point.
+      --  * a local storage when declared in a subprogram.  This storage
+      --    can be accessed from the subprogram, is created when the subprogram
+      --    is called and destroy when the subprogram exit.
+      --  * an instance storage when declared inside a process.  This storage
+      --    can be accessed from the process via an instance pointer, is
+      --    created during elaboration.
+      --procedure Push_Global_Factory (Storage : O_Storage);
+      --procedure Pop_Global_Factory;
+      procedure Set_Global_Storage (Storage : O_Storage);
+
+      --  Set the global scope handling.
+      Global_Storage : O_Storage;
+
+      --  Start to build an instance.
+      --  If INSTANCE_TYPE is not O_TNODE_NULL, it must be an uncompleted
+      --  record type, that will be completed.
+      procedure Push_Instance_Factory (Instance_Type : O_Tnode);
+      --  Manually add a field to the current instance being built.
+      function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
+        return O_Fnode;
+      --  Finish the building of the current instance and return the type
+      --  built.
+      procedure Pop_Instance_Factory (Instance_Type : out O_Tnode);
+
+      --  Create a new scope, in which variable are created locally
+      --  (ie, on the stack).  Always created unlocked.
+      procedure Push_Local_Factory;
+
+      --  Destroy a local scope.
+      procedure Pop_Local_Factory;
+
+      --  Push_scope defines how to access to a variable stored in an instance.
+      --  Variables defined in SCOPE_TYPE can be accessed via field SCOPE_FIELD
+      --  in scope SCOPE_PARENT.
+      procedure Push_Scope (Scope_Type : O_Tnode;
+                            Scope_Field : O_Fnode; Scope_Parent : O_Tnode);
+      --  Variables defined in SCOPE_TYPE can be accessed by dereferencing
+      --  fiel SCOPE_FIELD defined in SCOPE_PARENT.
+      procedure Push_Scope_Via_Field_Ptr
+        (Scope_Type : O_Tnode;
+         Scope_Field : O_Fnode; Scope_Parent : O_Tnode);
+      --  Variables/scopes defined in SCOPE_TYPE can be accessed via
+      --  dereference of parameter SCOPE_PARAM.
+      procedure Push_Scope (Scope_Type : O_Tnode; Scope_Param : O_Dnode);
+      --  No more accesses to SCOPE_TYPE are allowed.
+      --  Scopes must be poped in the reverse order they are pushed.
+      procedure Pop_Scope (Scope_Type : O_Tnode);
+
+      --  Same as Push_Scope/Pop_Scope, but act only if SCOPE_TYPE is not
+      --  null.
+      procedure Push_Scope_Soft (Scope_Type : O_Tnode; Scope_Param : O_Dnode);
+      procedure Pop_Scope_Soft (Scope_Type : O_Tnode);
+      pragma Inline (Push_Scope_Soft);
+      pragma Inline (Pop_Scope_Soft);
+
+      --  Reset the identifier.
+      type Id_Mark_Type is limited private;
+      type Local_Identifier_Type is limited private;
+
+      procedure Reset_Identifier_Prefix;
+      procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type;
+                                        Name : String;
+                                        Val : Iir_Int32 := 0);
+      procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type;
+                                        Name : Name_Id;
+                                        Val : Iir_Int32 := 0);
+      procedure Push_Identifier_Prefix_Uniq (Mark : out Id_Mark_Type);
+      procedure Pop_Identifier_Prefix (Mark : in Id_Mark_Type);
+
+      --  Save/restore the local identifier number; this is used by package
+      --  body, which has the same prefix as the package declaration, so it
+      --  must continue local identifiers numbers.
+      --  This is used by subprogram bodies too.
+      procedure Save_Local_Identifier (Id : out Local_Identifier_Type);
+      procedure Restore_Local_Identifier (Id : Local_Identifier_Type);
+
+      --  Create an identifier from IIR node ID without the prefix.
+      function Create_Identifier_Without_Prefix (Id : Iir)
+        return O_Ident;
+      function Create_Identifier_Without_Prefix (Id : Name_Id; Str : String)
+        return O_Ident;
+
+      --  Create an identifier from the current prefix.
+      function Create_Identifier return O_Ident;
+
+      --  Create an identifier from IIR node ID with prefix.
+      function Create_Identifier (Id : Iir; Str : String := "")
+        return O_Ident;
+      function Create_Identifier
+        (Id : Iir; Val : Iir_Int32; Str : String := "")
+        return O_Ident;
+      function Create_Identifier (Id : Name_Id; Str : String := "")
+        return O_Ident;
+      --  Create a prefixed identifier from a string.
+      function Create_Identifier (Str : String) return O_Ident;
+
+      --  Create an identifier for a variable.
+      --  IE, if the variable is global, prepend the prefix,
+      --   if the variable belong to an instance, no prefix is added.
+      type Var_Ident_Type is private;
+      --function Create_Var_Identifier (Id : Name_Id; Str : String)
+      --  return Var_Ident_Type;
+      function Create_Var_Identifier (Id : Iir)
+        return Var_Ident_Type;
+      function Create_Var_Identifier (Id : String)
+        return Var_Ident_Type;
+      function Create_Uniq_Identifier return Var_Ident_Type;
+
+      type Var_Type (<>) is limited private;
+      type Var_Acc is access Var_Type;
+
+      --  Create a variable in the current scope.
+      --  If the current scope is the global scope, then a variable is
+      --   created at the top level (using decl_global_storage).
+      --  If the current scope is not the global scope, then a field is added
+      --   to the current scope.
+      function Create_Var
+        (Name : Var_Ident_Type;
+         Vtype : O_Tnode;
+         Storage : O_Storage := Global_Storage)
+        return Var_Acc;
+
+      --  Create a global variable.
+      function Create_Global_Var
+        (Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage)
+        return Var_Acc;
+
+      --  Create a global constant and initialize it to INITIAL_VALUE.
+      function Create_Global_Const
+        (Name : O_Ident;
+         Vtype : O_Tnode;
+         Storage : O_Storage;
+         Initial_Value : O_Cnode)
+      return Var_Acc;
+      procedure Define_Global_Const (Const : Var_Acc; Val : O_Cnode);
+
+      --  Return the (real) reference to a variable created by Create_Var.
+      function Get_Var (Var : Var_Acc) return O_Lnode;
+      --function Get_Var (Var : Var_Acc) return O_Dnode;
+
+      procedure Free_Var (Var : in out Var_Acc);
+
+
+      --  Return a reference to the instance of type ITYPE.
+      function Get_Instance_Ref (Itype : O_Tnode) return O_Lnode;
+
+      --  Return the address of the instance for block BLOCK.
+      function Get_Instance_Access (Block : Iir) return O_Enode;
+
+      --  Return the storage for the variable VAR.
+      function Get_Alloc_Kind_For_Var (Var : Var_Acc) return Allocation_Kind;
+
+      --  Return TRUE iff VAR is stable, ie get_var (VAR) can be referenced
+      --  several times.
+      function Is_Var_Stable (Var : Var_Acc) return Boolean;
+
+      --  Used only to generate RTI.
+      function Is_Var_Field (Var : Var_Acc) return Boolean;
+      function Get_Var_Field (Var : Var_Acc) return O_Fnode;
+      function Get_Var_Label (Var : Var_Acc) return O_Dnode;
+   private
+      type Local_Identifier_Type is new Natural;
+      type Id_Mark_Type is record
+         Len : Natural;
+         Local_Id : Local_Identifier_Type;
+      end record;
+
+      type Var_Ident_Type is record
+         Id : O_Ident;
+      end record;
+
+      --  Kind of variable:
+      --  VAR_GLOBAL: the variable is a global variable (static or not).
+      --  VAR_LOCAL: the variable is on the stack.
+      --  VAR_SCOPE: the variable is in the instance record.
+      type Var_Kind is (Var_Global, Var_Scope, Var_Local);
+
+      --  An instance contains all the data (variable, signals, constant...)
+      --  which are declared by an entity and an architecture.
+      --  (An architecture inherits the data of its entity).
+      --
+      --  The processes and implicit guard signals of an entity/architecture
+      --  are translated into functions.  The first argument of these functions
+      --  is a pointer to the instance.
+
+      type Inst_Build_Kind_Type is (Local, Global, Instance);
+      type Inst_Build_Type (Kind : Inst_Build_Kind_Type);
+      type Inst_Build_Acc is access Inst_Build_Type;
+      type Inst_Build_Type (Kind : Inst_Build_Kind_Type) is record
+         Prev : Inst_Build_Acc;
+         Prev_Id_Start : Natural;
+         case Kind is
+            when Local =>
+               --  Previous global storage.
+               Prev_Global_Storage : O_Storage;
+            when Global =>
+               null;
+            when Instance =>
+               Elements : O_Element_List;
+               Vars : Var_Acc;
+         end case;
+      end record;
+
+      type Var_Type (Kind : Var_Kind) is record
+         case Kind is
+            when Var_Global
+              | Var_Local =>
+               E : O_Dnode;
+            when Var_Scope =>
+               I_Field : O_Fnode;
+               I_Type : O_Tnode;
+               I_Link : Var_Acc;
+         end case;
+      end record;
+   end Chap10;
+   use Chap10;
+
+   package Chap1 is
+      --  Declare types for block BLK
+      procedure Start_Block_Decl (Blk : Iir);
+
+      procedure Translate_Entity_Declaration (Entity : Iir_Entity_Declaration);
+
+      --  Generate code to initialize generics of instance INSTANCE of ENTITY
+      --  using the default values.
+      --  This is used when ENTITY is at the top of a design hierarchy.
+      procedure Translate_Entity_Init (Entity : Iir);
+
+      procedure Translate_Architecture_Declaration (Arch : Iir);
+
+      --  CONFIG may be one of:
+      --  * configuration_declaration
+      --  * component_configuration
+      procedure Translate_Configuration_Declaration (Config : Iir);
+   end Chap1;
+
+   package Chap2 is
+      --  Subprogram specification being currently translated.  This is used
+      --  for the return statement.
+      Current_Subprogram : Iir := Null_Iir;
+
+      procedure Translate_Subprogram_Interfaces (Spec : Iir);
+      procedure Elab_Subprogram_Interfaces (Spec : Iir);
+
+      procedure Translate_Subprogram_Declaration (Spec : Iir);
+      procedure Translate_Subprogram_Body (Subprg : Iir);
+
+      --  Set the identifier prefix with the subprogram identifier and
+      --  overload number if any.
+      procedure Push_Subprg_Identifier (Spec : Iir; Mark : out Id_Mark_Type);
+
+--       procedure Translate_Protected_Subprogram_Declaration
+--         (Def : Iir_Protected_Type_Declaration; Spec : Iir; Block : Iir);
+
+      procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration);
+      procedure Translate_Package_Body (Decl : Iir_Package_Body);
+
+      procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir);
+
+      procedure Elab_Dependence (Design_Unit: Iir_Design_Unit);
+
+      --  Subprograms instances.
+      --
+      --  Subprograms declared inside entities, architecture, blocks
+      --   or processes (but not inside packages) may access to data declared
+      --   outside the subprogram (and this with a life longer than the
+      --   subprogram life).  These data correspond to constants, variables,
+      --   files, signals or types.  However these data are not shared between
+      --   instances of the same entity, architecture...  Subprograms instances
+      --   is the way subprograms access to these data.
+      --  One subprogram instance corresponds to a record.  Generally, a
+      --   subprogram has 0 or 1 instance.  Subprograms of protected objects
+      --   have an additionnal instance for the variable (object).
+      --
+      --  Declare an instance to be added for subprograms.
+      --  DECL_TYPE is the type of the instance; this should be a record.  This
+      --   is used by PUSH_SCOPE.
+      --  PTR_TYPE is a pointer to DECL_TYPE.
+      --  IDENT is an identifier for the interface.
+      --  DATA is a stabilized O_LNODE whose value will be passed to call to
+      --   subprograms.
+      --  Add_Subprg_Instance_Interfaces will add an interface of name IDENT
+      --   and type PTR_TYPE for every instance declared by
+      --   PUSH_SUBPRG_INSTANCE.
+      procedure Push_Subprg_Instance (Decl_Type : O_Tnode;
+                                      Ptr_Type : O_Tnode;
+                                      Ident : O_Ident);
+
+      --  Revert of the previous subprogram.
+      --  Instances must be removed in opposite order they are added.
+      procedure Pop_Subprg_Instance (Ident : O_Ident);
+
+      --  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.
+      type Subprg_Instance_Stack is limited private;
+      procedure Save_Subprg_Instance (Stack : out Subprg_Instance_Stack);
+      procedure Restore_Subprg_Instance (Stack : Subprg_Instance_Stack);
+
+      --  Provides/removes an access to an instance.
+      --  PTR is a pointer to the instance.  PTR must be stable if this
+      --  access is used several times.
+      --  SET_SUBPRG_INSTANCE must not be called twice on the same instance
+      --  unless the access to the instance has been cleared with
+      --  CLEAR_SUBPRG_INSTANCE.
+      --  At the association, instances without explicit accesses are
+      --  associated with the access found in the scope.
+      --procedure Set_Subprg_Instance (Decl_Type : O_Tnode; Ptr : O_Lnode);
+      --procedure Clear_Subprg_Instance (Decl_Type : O_Tnode);
+
+      --  Add interfaces during the creation of a subprogram.
+      type Subprg_Instance_El is record
+         Inter : O_Dnode;
+         Inter_Type : O_Tnode;
+         Inst_Type : O_Tnode;
+      end record;
+      Null_Subprg_Instance_El : constant Subprg_Instance_El :=
+        (O_Dnode_Null, O_Tnode_Null, O_Tnode_Null);
+
+      type Subprg_Instance_Array is array (Natural range <>)
+        of Subprg_Instance_El;
+
+      procedure Add_Subprg_Instance_Interfaces
+        (Interfaces : in out O_Inter_List; Vars : out Subprg_Instance_Array);
+      --  Associate values to the instance interfaces during invocation of a
+      --  subprogram.
+      procedure Add_Subprg_Instance_Assoc
+        (Assocs : in out O_Assoc_List; Vars : Subprg_Instance_Array);
+      procedure Add_Subprg_Instance_Assoc
+        (Assocs : in out O_Assoc_List;
+         Vars : Subprg_Instance_Array;
+         Inst1_Type : O_Tnode;
+         Inst1_Val : O_Enode);
+
+      --  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_Array);
+      procedure Finish_Subprg_Instance_Use (Vars : Subprg_Instance_Array);
+
+      subtype Instance_Inters is Subprg_Instance_Array (0 .. 1);
+      Null_Instance_Inters : constant Instance_Inters :=
+        (others => Null_Subprg_Instance_El);
+
+
+      --  Same as above, but for IIR.
+      procedure Create_Subprg_Instance (Interfaces : in out O_Inter_List;
+                                        Subprg : Iir);
+
+      procedure Start_Subprg_Instance_Use (Subprg : Iir);
+      procedure Finish_Subprg_Instance_Use (Subprg : Iir);
+   private
+      type Subprg_Instance_Type;
+      type Subprg_Instance_Stack is access Subprg_Instance_Type;
+
+      type Subprg_Instance_Type is record
+         --  Arguments of push.
+         Decl_Type : O_Tnode;
+         Ptr_Type : O_Tnode;
+         Ident : O_Ident;
+
+         --  Double linked list.
+         Next : Subprg_Instance_Stack;
+         Prev : Subprg_Instance_Stack;
+      end record;
+
+      Subprg_Instance_First : Subprg_Instance_Stack := null;
+      Subprg_Instance_Last : Subprg_Instance_Stack := null;
+      Subprg_Instance_Unused : Subprg_Instance_Stack := null;
+   end Chap2;
+
+   package Chap5 is
+      --  Attribute specification.
+      procedure Translate_Attribute_Specification
+        (Spec : Iir_Attribute_Specification);
+      procedure Elab_Attribute_Specification
+        (Spec : Iir_Attribute_Specification);
+
+      --  Disconnection specification.
+      procedure Elab_Disconnection_Specification
+        (Spec : Iir_Disconnection_Specification);
+
+      --  Elab an unconstrained port.
+      procedure Elab_Unconstrained_Port (Port : Iir; Actual : Iir);
+
+      --  There are 4 cases of generic/port map:
+      --  1) component instantiation
+      --  2) component configuration (association of a component with an entity
+      --     / architecture)
+      --  3) block header
+      --  4) direct (entity + architecture or configuration) instantiation
+      --
+      --  MAPPING is the node containing the generic/port map aspects.
+      procedure Elab_Map_Aspect (Mapping : Iir; Block_Parent : Iir);
+   end Chap5;
+
+
+   package Chap8 is
+      procedure Translate_Statements_Chain (First : Iir);
+
+      --  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);
+   end Chap8;
+
+   package Chap9 is
+      procedure Translate_Block_Declarations (Block : Iir; Origin : Iir);
+      procedure Translate_Block_Subprograms (Block : Iir; Base_Block : Iir);
+      procedure Elab_Block_Declarations (Block : Iir; Base_Block : Iir);
+
+      --  Generate code to instantiate an entity.
+      --  ASPECT must be an entity_aspect.
+      --  MAPPING must be a node with get_port/generic_map_aspect_list.
+      --  PARENT is the block in which the instantiation is done.
+      --  CONFIG_OVERRIDE, if set, is the configuration to use; if not set, the
+      --    configuration to use is determined from ASPECT.
+      procedure Translate_Entity_Instantiation
+        (Aspect : Iir; Mapping : Iir; Parent : Iir; Config_Override : Iir);
+
+   end Chap9;
+
+   package Rtis is
+      --  Run-Time Information (RTI) Kind.
+      Ghdl_Rtik : O_Tnode;
+      Ghdl_Rtik_Top : O_Cnode;
+      Ghdl_Rtik_Library : O_Cnode;
+      Ghdl_Rtik_Package : O_Cnode;
+      Ghdl_Rtik_Package_Body : O_Cnode;
+      Ghdl_Rtik_Entity : O_Cnode;
+      Ghdl_Rtik_Architecture : O_Cnode;
+      Ghdl_Rtik_Process : O_Cnode;
+      Ghdl_Rtik_Block : O_Cnode;
+      Ghdl_Rtik_If_Generate : O_Cnode;
+      Ghdl_Rtik_For_Generate : O_Cnode;
+      Ghdl_Rtik_Instance : O_Cnode;
+      Ghdl_Rtik_Constant : O_Cnode;
+      Ghdl_Rtik_Iterator : O_Cnode;
+      Ghdl_Rtik_Variable : O_Cnode;
+      Ghdl_Rtik_Signal : O_Cnode;
+      Ghdl_Rtik_File : O_Cnode;
+      Ghdl_Rtik_Port : O_Cnode;
+      Ghdl_Rtik_Generic : O_Cnode;
+      Ghdl_Rtik_Alias : O_Cnode;
+      Ghdl_Rtik_Guard : O_Cnode;
+      Ghdl_Rtik_Component : O_Cnode;
+      Ghdl_Rtik_Attribute : O_Cnode;
+      Ghdl_Rtik_Type_B2 : O_Cnode;
+      Ghdl_Rtik_Type_E8 : O_Cnode;
+      Ghdl_Rtik_Type_E32 : O_Cnode;
+      Ghdl_Rtik_Type_I32 : O_Cnode;
+      Ghdl_Rtik_Type_I64 : O_Cnode;
+      Ghdl_Rtik_Type_F64 : O_Cnode;
+      Ghdl_Rtik_Type_P32 : O_Cnode;
+      Ghdl_Rtik_Type_P64 : O_Cnode;
+      Ghdl_Rtik_Type_Access : O_Cnode;
+      Ghdl_Rtik_Type_Array : O_Cnode;
+      Ghdl_Rtik_Type_Record : O_Cnode;
+      Ghdl_Rtik_Type_File : O_Cnode;
+      Ghdl_Rtik_Subtype_Scalar : O_Cnode;
+      Ghdl_Rtik_Subtype_Array : O_Cnode;
+      Ghdl_Rtik_Subtype_Array_Ptr : 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_Unit : O_Cnode;
+      Ghdl_Rtik_Attribute_Transaction : O_Cnode;
+      Ghdl_Rtik_Attribute_Quiet : O_Cnode;
+      Ghdl_Rtik_Attribute_Stable : 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;
+
+      --  Location of an object.
+      Ghdl_Rti_Loc : O_Tnode;
+      Ghdl_Rti_Loc_Offset : O_Fnode;
+      Ghdl_Rti_Loc_Address : O_Fnode;
+
+      --  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 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.
+      procedure Generate_Top (Arch : Iir);
+
+      --  Add two associations to ASSOC to add an rti_context for NODE.
+      procedure Associate_Rti_Context
+        (Assoc : in out O_Assoc_List; Node : Iir);
+      procedure Associate_Null_Rti_Context (Assoc : in out O_Assoc_List);
+
+      function Get_Context_Rti (Node : Iir) return O_Cnode;
+      function Get_Context_Addr (Node : Iir) return O_Enode;
+   end Rtis;
+
+   type Ortho_Info_Kind is
+     (
+      Kind_Type,
+      Kind_Incomplete_Type,
+      Kind_Expr,
+      Kind_Subprg,
+      Kind_Object,
+      Kind_Alias,
+      Kind_Iterator,
+      Kind_Interface,
+      Kind_Disconnect,
+      Kind_Process,
+      Kind_Loop,
+      Kind_Block,
+      Kind_Component,
+      Kind_Field,
+      Kind_Package,
+      Kind_Config,
+      Kind_Assoc,
+      Kind_Design_File,
+      Kind_Library
+      );
+
+   type O_Fnode_Arr is array (Natural range <>) of O_Fnode;
+   type O_Fnode_Arr_Acc is access O_Fnode_Arr;
+   type Ortho_Info_Type_Kind is
+     (
+      Kind_Type_Scalar,
+      Kind_Type_Array,
+      Kind_Type_Record,
+      Kind_Type_File,
+      Kind_Type_Protected
+      );
+   type O_Tnode_Array is array (Object_Kind_Type) of O_Tnode;
+   type O_Fnode_Array is array (Object_Kind_Type) of O_Fnode;
+   type O_Dnode_Array is array (Object_Kind_Type) of O_Dnode;
+   type Var_Acc_Array is array (Object_Kind_Type) of Var_Acc;
+   type Instance_Inters_Array is array (Object_Kind_Type)
+     of Chap2.Instance_Inters;
+
+   type Rti_Depth_Type is new Natural range 0 .. 255;
+
+   type Ortho_Info_Type_Type (Kind : Ortho_Info_Type_Kind := Kind_Type_Scalar)
+   is record
+      --  For all types:
+      --  This is the maximum depth of RTI, that is the max of the depth of
+      --  the type itself and every types it depends on.
+      Rti_Max_Depth : Rti_Depth_Type;
+
+      case Kind is
+         when Kind_Type_Scalar =>
+            --  For scalar types:
+            --  True if no need to check against low/high bound.
+            Nocheck_Low : Boolean := False;
+            Nocheck_Hi : Boolean := False;
+
+            --  Ortho type for the range record type.
+            Range_Type : O_Tnode;
+
+            --  Ortho type for an access to the range record type.
+            Range_Ptr_Type : O_Tnode;
+
+            --  Tree for the range record declaration.
+            Range_Var : Var_Acc;
+
+            --  Fields of TYPE_RANGE_TYPE.
+            Range_Left : O_Fnode;
+            Range_Right : O_Fnode;
+            Range_Dir : O_Fnode;
+            Range_Length : O_Fnode;
+
+         when Kind_Type_Array =>
+            Base_Type : O_Tnode_Array;
+            Base_Ptr_Type : O_Tnode_Array;
+            Bounds_Type : O_Tnode;
+            Bounds_Ptr_Type : O_Tnode;
+
+            Base_Field : O_Fnode_Array;
+            Bounds_Field : O_Fnode_Array;
+
+            --  Field declaration for each dimension (1 based).
+            Bounds_Vector : O_Fnode_Arr_Acc;
+
+            --  True if the array bounds are static.
+            Static_Bounds : Boolean;
+
+            --  Variable containing the bounds for a constrained array.
+            Array_Bounds : Var_Acc;
+
+            --  Variable containing a 1 length bound for unidimensional
+            --  unconstrained arrays.
+            Array_1bound : Var_Acc;
+
+            --  Variable containing the description for each index.
+            Array_Index_Desc : Var_Acc;
+
+         when Kind_Type_Record =>
+            --  Variable containing the description for each element.
+            Record_El_Desc : Var_Acc;
+
+         when Kind_Type_File =>
+            --  Constant containing the signature of the file.
+            File_Signature : O_Dnode;
+
+         when Kind_Type_Protected =>
+            --  Init procedure for the protected type.
+            Prot_Init_Node : O_Dnode;
+            Prot_Init_Instance : Chap2.Instance_Inters;
+            --  Final procedure.
+            Prot_Final_Node : O_Dnode;
+            Prot_Final_Instance : Chap2.Instance_Inters;
+      end case;
+   end record;
+
+--    Ortho_Info_Type_Scalar_Init : constant Ortho_Info_Type_Type :=
+--      (Kind => Kind_Type_Scalar,
+--       Range_Type => O_Tnode_Null,
+--       Range_Ptr_Type => O_Tnode_Null,
+--       Range_Var => null,
+--       Range_Left => O_Fnode_Null,
+--       Range_Right => O_Fnode_Null,
+--       Range_Dir => O_Fnode_Null,
+--       Range_Length => O_Fnode_Null);
+
+   Ortho_Info_Type_Array_Init : constant Ortho_Info_Type_Type :=
+     (Kind => Kind_Type_Array,
+      Rti_Max_Depth => 0,
+      Base_Type => (O_Tnode_Null, O_Tnode_Null),
+      Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null),
+      Bounds_Type => O_Tnode_Null,
+      Bounds_Ptr_Type => O_Tnode_Null,
+      Base_Field => (O_Fnode_Null, O_Fnode_Null),
+      Bounds_Field => (O_Fnode_Null, O_Fnode_Null),
+      Bounds_Vector => null,
+      Static_Bounds => False,
+      Array_Bounds => null,
+      Array_1bound => null,
+      Array_Index_Desc => null);
+
+   Ortho_Info_Type_Record_Init : constant Ortho_Info_Type_Type :=
+     (Kind => Kind_Type_Record,
+      Rti_Max_Depth => 0,
+      Record_El_Desc => null);
+
+   Ortho_Info_Type_File_Init : constant Ortho_Info_Type_Type :=
+     (Kind => Kind_Type_File,
+      Rti_Max_Depth => 0,
+      File_Signature => O_Dnode_Null);
+
+   Ortho_Info_Type_Prot_Init : constant Ortho_Info_Type_Type :=
+     (Kind => Kind_Type_Protected,
+      Rti_Max_Depth => 0,
+      Prot_Init_Node => O_Dnode_Null,
+      Prot_Init_Instance => Chap2.Null_Instance_Inters,
+      Prot_Final_Node => O_Dnode_Null,
+      Prot_Final_Instance => Chap2.Null_Instance_Inters);
+
+   --  Mode of the type; roughly speaking, this corresponds to its size
+   --  (for scalars) or its layout (for composite types).
+   --  Used to select library subprograms for signals.
+   type Type_Mode_Type is
+     (
+      --  Unknown mode.
+      Type_Mode_Unknown,
+      --  Boolean type, with 2 elements.
+      Type_Mode_B2,
+      --  Enumeration with at most 256 elements.
+      Type_Mode_E8,
+      --  Enumeration with more than 256 elements.
+      Type_Mode_E32,
+      --  Integer types.
+      Type_Mode_I32,
+      Type_Mode_I64,
+      --  Physical types.
+      Type_Mode_P32,
+      Type_Mode_P64,
+      --  Floating point type.
+      Type_Mode_F64,
+      --  File type.
+      Type_Mode_File,
+      --  Thin access.
+      Type_Mode_Acc,
+
+      --  Fat access.
+      Type_Mode_Fat_Acc,
+
+      --  Record.
+      Type_Mode_Record,
+      --  Protected type
+      Type_Mode_Protected,
+      --  Constrained array type (length is known at compile-time).
+      Type_Mode_Array,
+      --  Array pointer type (used for constrained array whose length is
+      --  known at run-time).
+      Type_Mode_Ptr_Array,
+      --  Fat array type (used for unconstrained array).
+      Type_Mode_Fat_Array);
+
+   subtype Type_Mode_Scalar is Type_Mode_Type
+     range Type_Mode_B2 .. Type_Mode_F64;
+
+   subtype Type_Mode_Non_Composite is Type_Mode_Type
+     range Type_Mode_B2 .. Type_Mode_Fat_Acc;
+
+   --  Composite types, with the vhdl meaning: record and arrays.
+   subtype Type_Mode_Composite is Type_Mode_Type
+     range Type_Mode_Record .. Type_Mode_Fat_Array;
+
+   --  Array types.
+   subtype Type_Mode_Arrays is Type_Mode_Type range
+     Type_Mode_Array .. Type_Mode_Fat_Array;
+
+   --  Thin types, ie types whose length is a scalar.
+   subtype Type_Mode_Thin is Type_Mode_Type
+     range Type_Mode_B2 .. Type_Mode_Acc;
+
+   --  Fat types, ie types whose length is longer than a scalar.
+   subtype Type_Mode_Fat is Type_Mode_Type
+     range Type_Mode_Fat_Acc .. Type_Mode_Fat_Array;
+
+   --  These parameters are passed by value, ie the argument of the subprogram
+   --  is the value of the object.
+   subtype Type_Mode_By_Value is Type_Mode_Type
+     range Type_Mode_B2 .. Type_Mode_Acc;
+
+   --  These parameters are passed by copy, ie a copy of the object is created
+   --  and the reference of the copy is passed.  If the object will not be
+   --  modified by the subprogram, the object can be passed by reference.
+   subtype Type_Mode_By_Copy is Type_Mode_Type
+     range Type_Mode_Fat_Acc .. Type_Mode_Fat_Acc;
+
+   --  The parameters are passed by reference, ie the argument of the
+   --  subprogram is an address to the object.
+   subtype Type_Mode_By_Ref is Type_Mode_Type
+     range Type_Mode_Record .. Type_Mode_Fat_Array;
+
+   --  Additional informations for a resolving function.
+   type Subprg_Resolv_Info is record
+      Resolv_Func : O_Dnode;
+      --  Base block which the function was defined in.
+      Resolv_Block : Iir;
+      --  Parameter nodes.
+      Var_Instance : O_Dnode;
+      Var_Vals : O_Dnode;
+      Var_Vec : O_Dnode;
+      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;
+
+   --  Additional info for complex types.
+   type Complex_Type_Info is record
+      --  Variable containing the size of the type.
+      --  This is defined only for types whose size is only known at
+      --  running time (and not a compile-time).
+      Size_Var : Var_Acc_Array;
+
+      Builder_Need_Func : Boolean;
+
+      --  Parameters for type builders.
+      --  NOTE: this is only set for types (and *not* for subtypes).
+      Builder_Instance : Instance_Inters_Array;
+      Builder_Base_Param : O_Dnode_Array;
+      Builder_Bound_Param : O_Dnode_Array;
+      Builder_Func : O_Dnode_Array;
+   end record;
+   type Complex_Type_Info_Acc is access Complex_Type_Info;
+   procedure Free_Complex_Type_Info is new Ada.Unchecked_Deallocation
+     (Complex_Type_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 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;
+
+            --  Additionnal info for complex types.
+            C : Complex_Type_Info_Acc := null;
+
+            --  Ortho node which represents the type.
+            Ortho_Type : O_Tnode_Array;
+            --  Ortho pointer to the type.
+            Ortho_Ptr_Type : O_Tnode_Array;
+
+            --  If true, the type is (still) incomplete.
+            Type_Incomplete : Boolean := False;
+
+            --  Chain of temporary types to be destroyed at end of scope.
+            Type_Transient_Chain : Iir := Null_Iir;
+
+            --  More info according to the type.
+            T : Ortho_Info_Type_Type;
+
+            --  Run-time information.
+            Type_Rti : O_Dnode := O_Dnode_Null;
+
+         when Kind_Incomplete_Type =>
+            --  The declaration of the incomplete type.
+            Incomplete_Type : Iir;
+            Incomplete_Array : Ortho_Info_Acc;
+         when Kind_Expr =>
+            --  Ortho tree which represents the expression, used for
+            --  enumeration literals.
+            Expr_Node : O_Cnode;
+         when Kind_Subprg =>
+            --  Subprogram declaration node.
+            Ortho_Func : O_Dnode;
+
+            --  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;
+
+            --  For a function:
+            --    If the return value is not composite, then this field
+            --      must be O_LNODE_NULL.
+            --    If the return value is a composite type, then the caller must
+            --    give to the callee an area to put the result.  This area is
+            --    given via an (hidden to the user) interface.  Furthermore,
+            --    the function is translated into a procedure.
+            --  For a procedure:
+            --    If there are copy-out interfaces, they are gathered in a
+            --    record and a pointer to the record is passed to the
+            --    procedure.  RES_INTERFACE is the interface for this pointer.
+            Res_Interface : O_Dnode := O_Dnode_Null;
+
+            --  For a procedure with a result interface:
+            --    Type definition for the record.
+            Res_Record_Type : O_Tnode := O_Tnode_Null;
+            --    Type definition for access to the record.
+            Res_Record_Ptr : O_Tnode := O_Tnode_Null;
+
+            --  Instances for the subprograms.
+            Subprg_Instance : Chap2.Instance_Inters :=
+              Chap2.Null_Instance_Inters;
+
+            Subprg_Resolv : Subprg_Resolv_Info_Acc := null;
+
+            --  Local identifier number, set by spec, continued by body.
+            Subprg_Local_Id : Local_Identifier_Type;
+
+            --  If set, return should be converted into exit out of the
+            --  SUBPRG_EXIT loop and the value should be assigned to
+            --  SUBPRG_RESULT, if any.
+            Subprg_Exit : O_Snode := O_Snode_Null;
+            Subprg_Result : O_Dnode := O_Dnode_Null;
+         when Kind_Object =>
+            --  For constants: set when the object is defined as a constant.
+            Object_Static : Boolean;
+            --  The object itself.
+            Object_Var : Var_Acc;
+            --  RTI constant for the object.
+            Object_Rti : O_Dnode := O_Dnode_Null;
+            --  Function to compute the value of object (used for implicit
+            --   guard signal declaration).
+            Object_Function : O_Dnode;
+         when Kind_Alias =>
+            Alias_Var : Var_Acc;
+            Alias_Kind : Object_Kind_Type;
+         when Kind_Iterator =>
+            Iterator_Var : Var_Acc;
+         when Kind_Interface =>
+            --  Ortho node for the interface.
+            Interface_Node : O_Dnode;
+            --  Field of the result record for copy-out arguments of procedure.
+            Interface_Field : O_Fnode;
+            --  Type of the interface.
+            Interface_Type : O_Tnode;
+            --  Ortho node for the interface of the protected subprogram.
+            Interface_Protected : O_Dnode;
+         when Kind_Disconnect =>
+            --  Variable which contains the time_expression of the
+            --  disconnection specification
+            Disconnect_Var : Var_Acc;
+         when Kind_Process =>
+            --  Type of process declarations.
+            Process_Decls_Type : O_Tnode;
+
+            --  Field in the parent block for the declarations in the process.
+            Process_Parent_Field : O_Fnode;
+
+            --  Subprogram for the process.
+            Process_Subprg : O_Dnode;
+
+            --  RTI for the process.
+            Process_Rti_Const : O_Dnode := O_Dnode_Null;
+         when Kind_Loop =>
+            --  Labels for the loop.
+            --  Used for exit/next from while-loop, and to exit from for-loop.
+            Label_Exit : O_Snode;
+            --  Used to next from for-loop, with an exit statment.
+            Label_Next : O_Snode;
+         when Kind_Block =>
+            --  Instance type (ortho record) for declarations contained in the
+            --  block/entity/architecture.
+            Block_Decls_Type : O_Tnode;
+            Block_Decls_Ptr_Type : O_Tnode;
+
+            --  For Entity: field in the instance type containing link to
+            --              parent.
+            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.
+            --  For a direct instantiation: link to the instance.
+            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;
+
+            --  RTI constant for the block.
+            Block_Rti_Const : O_Dnode := O_Dnode_Null;
+         when Kind_Component =>
+            --  Instance for the component.
+            Comp_Type : O_Tnode;
+            Comp_Ptr_Type : O_Tnode;
+            --  Field containing a pointer to the instance link.
+            Comp_Link : O_Fnode;
+            --  RTI for the component.
+            Comp_Rti_Const : O_Dnode;
+         when Kind_Config =>
+            Config_Subprg : O_Dnode;
+         when Kind_Field =>
+            --  Node for a record element declaration.
+            Field_Node : O_Fnode_Array := (O_Fnode_Null, O_Fnode_Null);
+         when Kind_Package =>
+            --  Subprogram which elaborate the package spec/body.
+            --  External units should call the body elaborator.
+            --  The spec elaborator is called only from the body elaborator.
+            Package_Elab_Spec_Subprg : O_Dnode;
+            Package_Elab_Body_Subprg : O_Dnode;
+
+            --  Variable set to true when the package is elaborated.
+            Package_Elab_Var : O_Dnode;
+
+            --  RTI constant for the package.
+            Package_Rti_Const : O_Dnode;
+
+            --  Local id, set by package declaration, continued by package
+            --  body.
+            Package_Local_Id : Local_Identifier_Type;
+         when Kind_Assoc =>
+            Assoc_In : Assoc_Conv_Info;
+            Assoc_Out : Assoc_Conv_Info;
+         when Kind_Design_File =>
+            Design_Filename : O_Dnode;
+         when Kind_Library =>
+            Library_Rti_Const : O_Dnode;
+      end case;
+   end record;
+
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => Ortho_Info_Acc, Object => Ortho_Info_Type);
+
+   subtype Type_Info_Acc is Ortho_Info_Acc (Kind_Type);
+   subtype Incomplete_Type_Info_Acc is Ortho_Info_Acc (Kind_Incomplete_Type);
+   subtype Subprg_Info_Acc is Ortho_Info_Acc (Kind_Subprg);
+   subtype Object_Info_Acc is Ortho_Info_Acc (Kind_Object);
+   subtype Alias_Info_Acc is Ortho_Info_Acc (Kind_Alias);
+   subtype Proc_Info_Acc is Ortho_Info_Acc (Kind_Process);
+   subtype Loop_Info_Acc is Ortho_Info_Acc (Kind_Loop);
+   subtype Block_Info_Acc is Ortho_Info_Acc (Kind_Block);
+   subtype Comp_Info_Acc is Ortho_Info_Acc (Kind_Component);
+   subtype Field_Info_Acc is Ortho_Info_Acc (Kind_Field);
+   subtype Config_Info_Acc is Ortho_Info_Acc (Kind_Config);
+   subtype Assoc_Info_Acc is Ortho_Info_Acc (Kind_Assoc);
+   --subtype Inter_Info_Acc is Ortho_Info_Acc (Kind_Interface);
+   subtype Design_File_Info_Acc is Ortho_Info_Acc (Kind_Design_File);
+   subtype Library_Info_Acc is Ortho_Info_Acc (Kind_Library);
+
+   package Node_Infos is new GNAT.Table
+     (Table_Component_Type => Ortho_Info_Acc,
+      Table_Index_Type => Iir,
+      Table_Low_Bound => 0,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   procedure Update_Node_Infos
+   is
+      use Nodes;
+      F, L : Iir;
+   begin
+      F := Node_Infos.Last;
+      L := Nodes.Get_Last_Node;
+      Node_Infos.Set_Last (L);
+      Node_Infos.Table (F + 1 .. L) := (others => null);
+   end Update_Node_Infos;
+
+   procedure Set_Info (Target : Iir; Info : Ortho_Info_Acc) is
+   begin
+      if Node_Infos.Table (Target) /= null then
+         raise Internal_Error;
+      end if;
+      Node_Infos.Table (Target) := Info;
+   end Set_Info;
+
+   procedure Clear_Info (Target : Iir) is
+   begin
+      Node_Infos.Table (Target) := null;
+   end Clear_Info;
+
+   function Get_Info (Target : Iir) return Ortho_Info_Acc is
+   begin
+      return Node_Infos.Table (Target);
+   end Get_Info;
+
+   --  Create an ortho_info field of kind KIND for iir node TARGET, and
+   --  return it.
+   function Add_Info (Target : Iir; Kind : Ortho_Info_Kind)
+     return Ortho_Info_Acc
+   is
+      Res : Ortho_Info_Acc;
+   begin
+      Res := new Ortho_Info_Type (Kind);
+      Set_Info (Target, Res);
+      return Res;
+   end Add_Info;
+
+   procedure Free_Info (Target : Iir)
+   is
+      Info : Ortho_Info_Acc;
+   begin
+      Info := Get_Info (Target);
+      if Info /= null then
+         case Info.Kind is
+            when Kind_Object =>
+               Free_Var (Info.Object_Var);
+            when Kind_Alias =>
+               Free_Var (Info.Alias_Var);
+            when Kind_Iterator =>
+               Free_Var (Info.Iterator_Var);
+            when others =>
+               null;
+         end case;
+         Unchecked_Deallocation (Info);
+         Clear_Info (Target);
+      end if;
+   end Free_Info;
+
+   procedure Free_Type_Info (Info : in out Type_Info_Acc; Full : Boolean)
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (O_Fnode_Arr, O_Fnode_Arr_Acc);
+   begin
+      case Info.T.Kind is
+         when Kind_Type_Scalar =>
+            Free_Var (Info.T.Range_Var);
+         when Kind_Type_Array =>
+            Free_Var (Info.T.Array_Bounds);
+            if Full then
+               Free (Info.T.Bounds_Vector);
+               Free_Var (Info.T.Array_1bound);
+               Free_Var (Info.T.Array_Index_Desc);
+            end if;
+         when Kind_Type_Record =>
+            if Full then
+               Free_Var (Info.T.Record_El_Desc);
+            end if;
+         when Kind_Type_File =>
+            null;
+         when Kind_Type_Protected =>
+            null;
+      end case;
+      if Info.C /= null then
+         Free_Var (Info.C.Size_Var (Mode_Value));
+         Free_Var (Info.C.Size_Var (Mode_Signal));
+         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
+   begin
+      return Get_Info (Func).Subprg_Resolv.Resolv_Func;
+   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;
+
+   --  Convert an o_lnode to an o_enode, either by taking value or address.
+   function L2e_Node (L : O_Lnode;
+                      Type_Info : Type_Info_Acc;
+                      Kind : Object_Kind_Type)
+     return O_Enode is
+   begin
+      case Type_Info.Type_Mode is
+         when Type_Mode_Unknown =>
+            raise Internal_Error;
+         when Type_Mode_Scalar
+           | Type_Mode_Acc
+           | Type_Mode_Ptr_Array
+           | Type_Mode_File =>
+            return New_Value (L);
+         when Type_Mode_Fat_Array
+           | Type_Mode_Fat_Acc =>
+            return New_Address (L, Type_Info.Ortho_Ptr_Type (Kind));
+         when Type_Mode_Record
+           | Type_Mode_Array
+           | Type_Mode_Protected =>
+            return New_Address (L, Type_Info.Ortho_Ptr_Type (Kind));
+      end case;
+   end L2e_Node;
+
+--    --  Get Lnode from a variable pointer.
+-- function Ptr2l_Node (Var_Ptr : O_Lnode; Info : Type_Info_Acc) return O_Lnode
+--    is
+--    begin
+--       case Info.Type_Mode is
+--          when Type_Mode_Fat_Array
+--            | Type_Mode_Array
+--            | Type_Mode_Record
+--            | Type_Mode_Fat_Acc =>
+--             return New_Access_Element (New_Value (Var_Ptr));
+--          when Type_Mode_Ptr_Array =>
+--             return Var_Ptr;
+--          when others =>
+--             raise Internal_Error;
+--       end case;
+--    end Ptr2l_Node;
+
+--    function Get_Bounds_Ptr (Info : Type_Info_Acc) return O_Enode is
+--    begin
+--       case Info.Type_Mode is
+--          when Type_Mode_Array
+--            | Type_Mode_Ptr_Array =>
+--             return New_Address (Get_Var (Info.T.Array_Bounds),
+--                                 Info.T.Bounds_Ptr_Type);
+--          when others =>
+--             raise Internal_Error;
+--       end case;
+--    end Get_Bounds_Ptr;
+
+   --  In order to simplify the handling of Enode/Lnode, let's introduce
+   --  Mnode (yes, another node).
+   --  An Mnode is a typed union, containing either an Lnode or a Enode.
+   --  See Mstate for a description of the union.
+   --  The real data is contained insisde a record, so that the discriminant
+   --  can be changed.
+   type Mnode;
+
+   --  State of an Mmode.
+   type Mstate is
+     (
+      --  The Mnode contains an Enode, which can be either a value or a
+      --  pointer.
+      --  This Mnode can be used only once.
+      Mstate_E,
+
+      --  The Mnode contains an Lnode representing a value.
+      --  This Lnode can be used only once.
+      Mstate_Lv,
+
+      --  The Mnode contains an Lnode representing a pointer.
+      --  This Lnode can be used only once.
+      Mstate_Lp,
+
+      --  The Mnode contains an Dnode for a variable representing a value.
+      --  This Dnode may be used several times.
+      Mstate_Dv,
+
+      --  The Mnode contains an Dnode for a variable representing a pointer.
+      --  This Dnode may be used several times.
+      Mstate_Dp,
+
+      --  Null Mnode.
+      Mstate_Null,
+
+      --  The Mnode is invalid (such as already used).
+      Mstate_Bad);
+
+   type Mnode1 (State : Mstate := Mstate_Bad) is record
+      --  True if the object is composite (its value cannot be read directly).
+      Comp : Boolean;
+
+      --  Additionnal informations about the objects: kind and type.
+      K : Object_Kind_Type;
+      T : Type_Info_Acc;
+
+      --  Ortho type of the object.
+      Vtype : O_Tnode;
+
+      --  Type for a pointer to the object.
+      Ptype : O_Tnode;
+
+      case State is
+         when Mstate_E =>
+            E : O_Enode;
+         when Mstate_Lv =>
+            Lv : O_Lnode;
+         when Mstate_Lp =>
+            Lp : O_Lnode;
+         when Mstate_Dv =>
+            Dv : O_Dnode;
+         when Mstate_Dp =>
+            Dp : O_Dnode;
+         when Mstate_Bad
+           | Mstate_Null =>
+            null;
+      end case;
+   end record;
+   --pragma Pack (Mnode1);
+
+   type Mnode is record
+      M1 : Mnode1;
+   end record;
+
+   --  Null Mnode.
+   Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null,
+                                                Comp => False,
+                                                K => Mode_Value,
+                                                Ptype => O_Tnode_Null,
+                                                Vtype => O_Tnode_Null,
+                                                T => null));
+
+
+   --  Object kind of a Mnode
+   function Get_Object_Kind (M : Mnode) return Object_Kind_Type;
+
+   --  Transform VAR to Mnode.
+   function Get_Var
+     (Var : Var_Acc; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
+     return Mnode;
+
+   --  Return a stabilized node for M.
+   --  The former M is not usuable anymore.
+   function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode;
+
+   --  Stabilize M.
+   procedure Stabilize (M : in out Mnode);
+
+   --  If M is not stable, create a variable containing the value of M.
+   --  M must be scalar (or access).
+   function Stabilize_Value (M : Mnode) return Mnode;
+
+   --  Create a temporary of type INFO and kind KIND.
+   function Create_Temp (Info : Type_Info_Acc;
+                         Kind : Object_Kind_Type := Mode_Value)
+                        return Mnode;
+
+   package Chap3 is
+      --  Translate the subtype of an object, since an object can define
+      --  a subtype.
+      --  This can be done only for a declaration.
+      --  DECL must have an identifier and a type.
+      procedure Translate_Object_Subtype
+        (Decl : Iir; With_Vars : Boolean := True);
+      procedure Elab_Object_Subtype (Def : Iir);
+
+      --  Translate the subtype of a literal.
+      --  This can be done not at declaration time, ie no variables are created
+      --  for this subtype.
+      --procedure Translate_Literal_Subtype (Def : Iir);
+
+      --  Translation of a type definition:
+      --  1. Create corresponding Ortho type.
+      --  2. Create bounds type
+      --  3. Create bounds declaration
+      --  4. Create bounds constructor
+      --  5. Create type descriptor declaration
+      --  6. Create type descriptor constructor
+
+      procedure Translate_Type_Definition
+        (Def : Iir; With_Vars : Boolean := True);
+
+      procedure Translate_Named_Type_Definition (Def : Iir; Id : Name_Id);
+      procedure Translate_Anonymous_Type_Definition
+        (Def : Iir; Transient : Boolean);
+
+      --  Some expressions may be evaluated several times in different
+      --  contexts.  Type info created for these expressions may not be
+      --  shared between these contexts.
+      procedure Destroy_Type_Info (Atype : Iir);
+
+      --  Translate subprograms for types.
+      procedure Translate_Type_Subprograms (Decl : Iir);
+
+      procedure Create_Type_Definition_Type_Range (Def : Iir);
+      function Create_Static_Array_Subtype_Bounds
+        (Def : Iir_Array_Subtype_Definition)
+        return O_Cnode;
+
+      --  Same as Translate_type_definition only for std.standard.boolean and
+      --  std.standard.bit.
+      procedure Translate_Bool_Type_Definition (Def : Iir);
+
+      procedure Call_Ghdl_Protected_Procedure (Type_Def : Iir; Proc : O_Dnode);
+
+      procedure Translate_Protected_Type_Body (Bod : Iir);
+      procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir);
+
+      --  Translate_type_definition_Elab do 4 and 6.
+      --  It generates code to do type elaboration.
+      procedure Elab_Type_Declaration (Decl : Iir);
+      procedure Elab_Subtype_Declaration (Decl : Iir_Subtype_Declaration);
+
+      --  Builders.
+      --  A complex type is a type whose size is not locally static.
+      --
+      --  The most simple example is an unidimensionnl array whose range
+      --  depends on generics.
+      --
+      --  We call first order complex type any array whose bounds are not
+      --  locally static and whose sub-element size is locally static.
+      --
+      --  First order complex type objects are represented by a pointer to an
+      --  array of sub-element, and the storage area for the array is
+      --  allocated at run-time.
+      --
+      --  Since a sub-element type may be a complex type, a type may be
+      --  complex because one of its sub-element type is complex.
+      --  EG, a record type whose one element is a complex array.
+      --
+      --  A type may be complex either because it is a first order complex
+      --  type (ie an array whose bounds are not locally static) or because
+      --  one of its sub-element type is such a type (this is recursive).
+      --
+      --  We call second order complex type a complex type that is not of first
+      --  order.
+      --  We call third order complex type a second order complex type which is
+      --  an array whose bounds are not locally static.
+      --
+      --  In a complex type, sub-element of first order complex type are
+      --  represented by a pointer.
+      --  Any complex type object (constant, signal, variable, port, generic)
+      --  is represented by a pointer.
+      --
+      --  Creation of a second or third order complex type object consists in
+      --  allocating the memory and building the object.
+      --  Building a object consists in setting internal pointers.
+      --
+      --  A complex type has always a non-null INFO.C, and its size is computed
+      --  during elaboration.
+      --
+      --  For a second or third order complex type, INFO.C.BUILDER_NEED_FUNC
+      --  is set to TRUE.
+
+      --  Call builder for variable pointed VAR of type VAR_TYPE.
+      procedure Gen_Call_Type_Builder (Var : Mnode; Var_Type : Iir);
+
+      --  Build variable given by GET_FIELD_LNODE: ie set internals
+      --  fields.
+      generic
+         with function Get_Field_Lnode return O_Lnode;
+      procedure Builder_Update_Field
+        (Field_Type : Iir; Mem : O_Dnode; Kind : Object_Kind_Type);
+
+      --  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;
+
+      --  Get the length of the array.
+      function Get_Array_Length (Arr : Mnode; Atype : Iir) return O_Enode;
+
+      function Get_Array_Type_Length (Atype : Iir) return O_Enode;
+
+      --  Get the base of array ARR.
+      function Get_Array_Base (Arr : Mnode) return Mnode;
+
+      --  Get the bounds of array ARR.
+      function Get_Array_Bounds (Arr : Mnode) return Mnode;
+
+      --  Get the range ot ATYPE.
+      function Type_To_Range (Atype : Iir) return Mnode;
+
+      --  Get length of range R.
+      function Range_To_Length (R : Mnode) return Mnode;
+
+      --  Get direction of range R.
+      function Range_To_Dir (R : Mnode) return Mnode;
+
+      --  Get left/right bounds for range R.
+      function Range_To_Left (R : Mnode) return Mnode;
+      function Range_To_Right (R : Mnode) return Mnode;
+
+      --  Get range for dimension DIM (1 based) of array bounds B or type
+      --  ATYPE.
+      function Bounds_To_Range (B : Mnode; Atype : Iir; Dim : Positive)
+        return Mnode;
+
+      --  Get the range of dimension DIM (1 based) of array ARR of type ATYPE.
+      function Get_Array_Range (Arr : Mnode; Atype : Iir; Dim : Positive)
+        return Mnode;
+
+      --  Get array bounds for type ATYPE.
+      function Get_Array_Type_Bounds (Atype : Iir) return Mnode;
+
+      --  PTR must be a variable pointing to a bounds of type ATYPE.
+      function Get_Bounds_Ptr_Length (Ptr : O_Dnode; Atype : Iir)
+        return O_Enode;
+
+      --  Return the a pointer to the array base from variable PTR
+      --  containing a pointer to array.
+      function Get_Array_Ptr_Base_Ptr
+        (Ptr : O_Lnode; Atype : Iir; Is_Sig : Object_Kind_Type)
+        return O_Lnode;
+
+      --  Return pointer to range DIM of array pointed by PTR.
+      function Get_Array_Ptr_Range_Ptr (Ptr : O_Lnode;
+                                        Array_Type : Iir;
+                                        Dim : Natural;
+                                        Is_Sig : Object_Kind_Type)
+        return O_Enode;
+
+
+      function Get_Array_Bounds_Ptr
+        (Arr : O_Lnode; Arr_Type : Iir; Is_Sig : Object_Kind_Type)
+        return O_Enode;
+
+      --  Return the bounds field of a fat array from variable PTR containing a
+      --  pointer to a fat array.
+      function Get_Array_Ptr_Bounds_Ptr
+        (Ptr : O_Lnode; Atype : Iir; Is_Sig : Object_Kind_Type)
+        return O_Enode;
+
+      --  Deallocate OBJ.
+      procedure Gen_Deallocate (Obj : O_Enode);
+
+      --  Performs deallocation of PARAM (the parameter of a deallocate call).
+      procedure Translate_Object_Deallocation (Param : Iir);
+
+      --  Allocate an object of type OBJ_TYPE and set RES.
+      --  RES must be a stable access of type ortho_ptr_type.
+      --  For an unconstrained array, BOUNDS is a pointer to the boundaries of
+      --  the object, which are copied.
+      procedure Translate_Object_Allocation
+        (Res : in out Mnode;
+         Alloc_Kind : Allocation_Kind;
+         Obj_Type : Iir;
+         Bounds : O_Enode);
+
+      --  Copy SRC to DEST.
+      --  Both have the same type, OTYPE.
+      --  Furthermore, arrays are of the same length.
+      procedure Translate_Object_Copy
+        (Dest : Mnode; Src : O_Enode; Obj_Type : Iir);
+
+      --  Get size (in bytes with type ghdl_index_type) of object OBJ.
+      --  For an unconstrained array, OBJ must be really an object, otherwise,
+      --  it may be a null_mnode, created by T2M.
+      function Get_Object_Size (Obj : Mnode; Obj_Type : Iir) return O_Enode;
+
+      --  Allocate the base of a fat array, whose length is determined from
+      --  the bounds.
+      --  RES_PTR is a pointer to the fat pointer (must be a variable that
+      --  can be referenced several times).
+      --  ARR_TYPE is the type of the array.
+      procedure Allocate_Fat_Array_Base (Alloc_Kind : Allocation_Kind;
+                                         Res : Mnode;
+                                         Arr_Type : Iir);
+
+      --  Create the bounds for SUB_TYPE.
+      --  SUB_TYPE is expected to be a non-static, anonymous array type.
+      procedure Create_Array_Subtype (Sub_Type : Iir; Transient : Boolean);
+
+      --  Return TRUE if VALUE is not is the range specified by ATYPE.
+      --  VALUE must be stable.
+      function Not_In_Range (Value : O_Dnode; Atype : Iir) return O_Enode;
+
+      --  Return TRUE if base type of ATYPE is larger than its bounds, ie
+      --  if a value of type ATYPE may be out of range.
+      function Need_Range_Check (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);
+
+      --  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 o_lnode_null).
+      --  If L_TYPE (resp. T_TYPE) is a fat array, then L_NODE (resp. R_NODE)
+      --    must be a variable pointing to the array.
+      procedure Check_Array_Match (L_Type : Iir;
+                                   L_Node : O_Lnode;
+                                   L_Mode : Object_Kind_Type;
+                                   R_Type : Iir;
+                                   R_Node : O_Lnode;
+                                   R_Mode : Object_Kind_Type;
+                                   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.
+      procedure Create_Range_From_Length
+        (Index_Type : Iir; Length : O_Dnode; Range_Ptr : O_Dnode);
+
+   end Chap3;
+
+   package Chap4 is
+      --  Translate of a type declaration corresponds to the translation of
+      --  its definition.
+      procedure Translate_Type_Declaration (Decl : Iir);
+      procedure Translate_Anonymous_Type_Declaration (Decl : Iir);
+      procedure Translate_Subtype_Declaration (Decl : Iir_Subtype_Declaration);
+      procedure Translate_Bool_Type_Declaration (Decl : Iir_Type_Declaration);
+
+      --  Translate declaration DECL, which must not be a subprogram
+      --  specification.
+      procedure Translate_Declaration (Decl : Iir);
+
+      --  Translate declarations, except subprograms spec and bodies.
+      procedure Translate_Declaration_Chain (Parent : Iir);
+
+      --  Translate subprograms in declaration chain of PARENT.
+      --  For a global subprograms belonging to an instance (ie, subprograms
+      --  declared in a block, entity or architecture), BLOCK is the info
+      --  for the base block to which the subprograms belong; null if none;
+      --  It is used to add an instance parameter.
+      procedure Translate_Declaration_Chain_Subprograms
+        (Parent : Iir; Block : Iir);
+
+      --  Create subprograms for type/function conversion of signal
+      --  associations.
+      --  ENTITY is the entity instantiated, which can be either
+      --   an entity_declaration (for component configuration or direct
+      --   component instantiation), a component declaration (for a component
+      --   instantiation) or Null_Iir (for a block header).
+      procedure Translate_Association_Subprograms
+        (Assoc_Chain : 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: DECL 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
+        (Decl : Iir; Parent : Iir; Check_Null : Boolean);
+
+      --  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;
+
+      --  Get the ortho type for an element of type TINFO.
+      function Get_Element_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;
+
+      --  Same as Translate_Name, but only for formal names.
+      --  If SCOPE_TYPE and SCOPE_PARAM are not null, use them for the scope
+      --  of the base name.
+      --  Indeed, for recursive instantiation, NAME can designates the actual
+      --  and the formal.
+--       function Translate_Formal_Name (Scope_Type : O_Tnode;
+--                                       Scope_Param : O_Lnode;
+--                                       Name : Iir)
+--                                      return Mnode;
+
+      --  Get record element EL of PREFIX.
+      function Translate_Selected_Element (Prefix : Mnode;
+                                           El : Iir_Element_Declaration)
+        return Mnode;
+
+--       --  Get direction/length/left bound/right bound of dimension DIM of
+--       --  array ARR whose type if ARR_TYPE.
+--       --  For a thin array, ARR is the array;
+--       --  For a fat array, ARR is the fat array (ie the record with base and
+--       --    bounds pointer) and not a pointer.
+--       function Get_Array_Bound_Dir (Arr : O_Lnode;
+--                                     Arr_Type : Iir;
+--                                     Dim : Natural;
+--                                     Is_Sig : Object_Kind_Type)
+--         return O_Enode;
+      function Get_Array_Bound_Length (Arr : O_Lnode;
+                                       Arr_Type : Iir;
+                                       Dim : Natural;
+                                       Is_Sig : Object_Kind_Type)
+
+        return O_Enode;
+      function Get_Array_Ptr_Bound_Length (Ptr : O_Lnode;
+                                           Arr_Type : Iir;
+                                           Dim : Natural;
+                                           Is_Sig : Object_Kind_Type)
+        return O_Enode;
+--       function Get_Array_Bound_Left (Arr : O_Lnode;
+--                                      Arr_Type : Iir;
+--                                      Dim : Natural;
+--                                      Is_Sig : Object_Kind_Type)
+--         return O_Enode;
+--       function Get_Array_Bound_Right (Arr : O_Lnode;
+--                                       Arr_Type : Iir;
+--                                       Dim : Natural;
+--                                       Is_Sig : Object_Kind_Type)
+--         return O_Enode;
+
+      --  Extract from fat array FAT_ARRAY the range corresponding to dimension
+      --  DIM.
+      function Fat_Array_To_Range (Fat_Array : O_Lnode;
+                                   Array_Type : Iir;
+                                   Dim : Natural;
+                                   Is_Sig : Object_Kind_Type)
+        return O_Lnode;
+
+      procedure Gen_Bound_Error (Loc : Iir);
+
+      --  Generate code to emit a program error.
+      procedure Gen_Program_Error (Loc : Iir);
+
+      --  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 offset in the range pointed by RANGE_PTR of INDEX.
+      --  This checks INDEX belongs to the range.
+      function Translate_Index_To_Offset (Range_Ptr : O_Dnode;
+                                          Index : O_Enode;
+                                          Index_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)
+        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.
+      --  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);
+
+      --  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 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;
+
+      --  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_High_Type_Attribute (Atype : Iir) return O_Enode;
+      function Translate_Low_Type_Attribute (Atype : Iir) return O_Enode;
+
+      function Translate_Val_Attribute (Attr : Iir) return O_Enode;
+      function Translate_Pos_Attribute (Attr : Iir; Res_Type : Iir)
+                                       return O_Enode;
+
+      function Translate_Succ_Pred_Attribute (Attr : Iir) return O_Enode;
+
+      function Translate_Image_Attribute (Attr : Iir) return O_Enode;
+      function Translate_Value_Attribute (Attr : Iir) return O_Enode;
+
+      function Translate_Event_Attribute (Attr : Iir) return O_Enode;
+      function Translate_Active_Attribute (Attr : Iir) return O_Enode;
+      function Translate_Last_Value_Attribute (Attr : Iir) return O_Enode;
+
+      function Translate_Last_Time_Attribute (Prefix : Iir; Field : O_Fnode)
+                                             return O_Enode;
+
+      function Translate_Driving_Value_Attribute (Attr : Iir) return O_Enode;
+
+      function Translate_Driving_Attribute (Attr : Iir) return O_Enode;
+
+      function Translate_Path_Instance_Name_Attribute (Attr : Iir)
+                                                      return O_Enode;
+   end Chap14;
+
+   package Helpers is
+      --  Return the value of field FIELD of lnode L that is contains
+      --   a pointer to a record.
+      --  This is equivalent to:
+      --  new_value (new_selected_element (new_access_element (new_value (l)),
+      --                                   field))
+      function New_Value_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
+        return O_Enode;
+      function New_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
+        return O_Lnode;
+
+      function New_Indexed_Acc_Value (L : O_Lnode; I : O_Enode) return O_Lnode;
+
+      --  Equivalent to new_access_element (new_value (l))
+      function New_Acc_Value (L : O_Lnode) return O_Lnode;
+
+      --  Copy a fat pointer.
+      --  D and S are stabilized fat pointers.
+      procedure Copy_Fat_Pointer (D : Mnode; S: Mnode);
+
+      --  Copy a fat access.
+      --  D and S are variable containing address of the fat pointer.
+      --  PTR_TYPE is the type of the fat access.
+      procedure Copy_Fat_Access (D : O_Dnode; S : O_Dnode; Ptr_Type : Iir);
+
+      --  Generate code to initialize a ghdl_index_type variable V to 0.
+      procedure Init_Var (V : O_Dnode);
+
+      --  Generate code to increment/decrement a ghdl_index_type variable V.
+      procedure Inc_Var (V : O_Dnode);
+      --procedure Dec_Var (V : O_Lnode);
+
+      --  Generate code to exit from loop LABEL iff COND is true.
+      procedure Gen_Exit_When (Label : O_Snode; Cond : O_Enode);
+
+      --  Create a uniq identifier.
+      function Create_Uniq_Identifier return O_Ident;
+
+      --  Create a region for temporary variables.
+      procedure Open_Temp;
+      --  Create a temporary variable.
+      function Create_Temp (Atype : O_Tnode) return O_Dnode;
+      --  Create a temporary variable of ATYPE and initialize it with VALUE.
+      function Create_Temp_Init (Atype : O_Tnode; Value : O_Enode)
+        return O_Dnode;
+      --  Create a temporary variable of ATYPE and initialize it with the
+      --  address of NAME.
+      function Create_Temp_Ptr (Atype : O_Tnode; Name : O_Lnode)
+        return O_Dnode;
+      --  Create a temporary variable for ATYPE and assign it with address
+      --  of NAME.
+      function Create_Temp_Ptr
+        (Atype : Iir; Name : O_Lnode; Is_Sig : Object_Kind_Type)
+        return O_Dnode;
+      --  Create a mark in the temporary region for the stack2.
+      --  FIXME: maybe a flag must be added to CLOSE_TEMP where it is known
+      --   stack2 can be released.
+      procedure Create_Temp_Stack2_Mark;
+      --  Add ATYPE in the chain of types to be destroyed at the end of the
+      --  temp scope.
+      procedure Add_Transient_Type_In_Temp (Atype : Iir);
+      --  Close the temporary region.
+      procedure Close_Temp;
+
+      --  Free all old temp.
+      --  Used only to free memory.
+      procedure Free_Old_Temp;
+
+      --  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;
+   private
+   end Helpers;
+   use Helpers;
+
+   function Get_Type_Info (M : Mnode) return Type_Info_Acc is
+   begin
+      return M.M1.T;
+   end Get_Type_Info;
+
+   function Get_Object_Kind (M : Mnode) return Object_Kind_Type is
+   begin
+      return M.M1.K;
+   end Get_Object_Kind;
+
+   function E2M (E : O_Enode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_E,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, E => E,
+                           Vtype => T.Ortho_Type (Kind),
+                           Ptype => T.Ortho_Ptr_Type (Kind)));
+   end E2M;
+
+   function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Lv,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, Lv => L,
+                           Vtype => T.Ortho_Type (Kind),
+                           Ptype => T.Ortho_Ptr_Type (Kind)));
+   end Lv2M;
+
+   function Lv2M (L : O_Lnode;
+                  Comp : Boolean;
+                  Vtype : O_Tnode;
+                  Ptype : O_Tnode;
+                  T : Type_Info_Acc; Kind : Object_Kind_Type)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Lv,
+                           Comp => Comp,
+                           K => Kind, T => T, Lv => L,
+                           Vtype => Vtype, Ptype => Ptype));
+   end Lv2M;
+
+   function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Lp,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, Lp => L,
+                           Vtype => T.Ortho_Type (Kind),
+                           Ptype => T.Ortho_Ptr_Type (Kind)));
+   end Lp2M;
+
+   function Lp2M (L : O_Lnode;
+                  T : Type_Info_Acc;
+                  Kind : Object_Kind_Type;
+                  Vtype : O_Tnode;
+                  Ptype : O_Tnode)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Lp,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, Lp => L,
+                           Vtype => Vtype, Ptype => Ptype));
+   end Lp2M;
+
+   function Lv2M (L : O_Lnode;
+                  T : Type_Info_Acc;
+                  Kind : Object_Kind_Type;
+                  Vtype : O_Tnode;
+                  Ptype : O_Tnode)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Lv,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, Lv => L,
+                           Vtype => Vtype, Ptype => Ptype));
+   end Lv2M;
+
+   function Dv2M (D : O_Dnode;
+                  T : Type_Info_Acc;
+                  Kind : Object_Kind_Type)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Dv,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, Dv => D,
+                           Vtype => T.Ortho_Type (Kind),
+                           Ptype => T.Ortho_Ptr_Type (Kind)));
+   end Dv2M;
+
+   function Dv2M (D : O_Dnode;
+                  T : Type_Info_Acc;
+                  Kind : Object_Kind_Type;
+                  Vtype : O_Tnode;
+                  Ptype : O_Tnode)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Dv,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, Dv => D,
+                           Vtype => Vtype,
+                           Ptype => Ptype));
+   end Dv2M;
+
+   function Dp2M (D : O_Dnode;
+                  T : Type_Info_Acc;
+                  Kind : Object_Kind_Type;
+                  Vtype : O_Tnode;
+                  Ptype : O_Tnode)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Dp,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, Dp => D,
+                           Vtype => Vtype, Ptype => Ptype));
+   end Dp2M;
+
+   function Dp2M (D : O_Dnode;
+                  T : Type_Info_Acc;
+                  Kind : Object_Kind_Type)
+     return Mnode is
+   begin
+      return Mnode'(M1 => (State => Mstate_Dp,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T, Dp => D,
+                           Vtype => T.Ortho_Type (Kind),
+                           Ptype => T.Ortho_Ptr_Type (Kind)));
+   end Dp2M;
+
+   function M2Lv (M : Mnode) return O_Lnode is
+   begin
+      case M.M1.State is
+         when Mstate_E =>
+            case Get_Type_Info (M).Type_Mode is
+               when Type_Mode_Thin =>
+                  --  Scalar to var is not possible.
+                  --  FIXME: This is not coherent with the fact that this
+                  --  conversion is possible when M is stabilized.
+                  raise Internal_Error;
+               when Type_Mode_Fat =>
+                  return New_Access_Element (M.M1.E);
+               when Type_Mode_Unknown =>
+                  raise Internal_Error;
+            end case;
+         when Mstate_Lp =>
+            return New_Acc_Value (M.M1.Lp);
+         when Mstate_Lv =>
+            return M.M1.Lv;
+         when Mstate_Dp =>
+            return New_Acc_Value (New_Obj (M.M1.Dp));
+         when Mstate_Dv =>
+            return New_Obj (M.M1.Dv);
+         when Mstate_Null
+           | Mstate_Bad =>
+            raise Internal_Error;
+      end case;
+   end M2Lv;
+
+   function M2Lp (M : Mnode) return O_Lnode is
+   begin
+      case M.M1.State is
+         when Mstate_E =>
+            raise Internal_Error;
+         when Mstate_Lp =>
+            return M.M1.Lp;
+         when Mstate_Dp =>
+            return New_Obj (M.M1.Dp);
+         when Mstate_Lv =>
+            if Get_Type_Info (M).Type_Mode in Type_Mode_Fat then
+               return New_Obj
+                 (Create_Temp_Init (M.M1.Ptype,
+                                    New_Address (M.M1.Lv, M.M1.Ptype)));
+            else
+               raise Internal_Error;
+            end if;
+         when Mstate_Dv
+           | Mstate_Null
+           | Mstate_Bad =>
+            raise Internal_Error;
+      end case;
+   end M2Lp;
+
+   function M2Dp (M : Mnode) return O_Dnode is
+   begin
+      case M.M1.State is
+         when Mstate_Dp =>
+            return M.M1.Dp;
+         when Mstate_Dv =>
+            return Create_Temp_Init
+              (M.M1.Ptype, New_Address (New_Obj (M.M1.Dv), M.M1.Ptype));
+
+         when others =>
+            raise Internal_Error;
+      end case;
+   end M2Dp;
+
+   function M2Dv (M : Mnode) return O_Dnode is
+   begin
+      case M.M1.State is
+         when Mstate_Dv =>
+            return M.M1.Dv;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end M2Dv;
+
+   function T2M (Atype : Iir; Kind : Object_Kind_Type) return Mnode
+   is
+      T : Type_Info_Acc;
+   begin
+      T := Get_Info (Atype);
+      return Mnode'(M1 => (State => Mstate_Null,
+                           Comp => T.Type_Mode in Type_Mode_Fat,
+                           K => Kind, T => T,
+                           Vtype => T.Ortho_Type (Kind),
+                           Ptype => T.Ortho_Ptr_Type (Kind)));
+   end T2M;
+
+   function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode
+   is
+      D : O_Dnode;
+      K : Object_Kind_Type;
+   begin
+      K := M.M1.K;
+      case M.M1.State is
+         when Mstate_E =>
+            if M.M1.Comp then
+               D := Create_Temp_Init (M.M1.Ptype, M.M1.E);
+               return Mnode'(M1 => (State => Mstate_Dp,
+                                    Comp => M.M1.Comp,
+                                    K => K, T => M.M1.T, Dp => D,
+                                    Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
+            else
+               D := Create_Temp_Init (M.M1.Vtype, M.M1.E);
+               return Mnode'(M1 => (State => Mstate_Dv,
+                                    Comp => M.M1.Comp,
+                                    K => K, T => M.M1.T, Dv => D,
+                                    Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
+            end if;
+         when Mstate_Lp =>
+            D := Create_Temp_Init (M.M1.Ptype, New_Value (M.M1.Lp));
+            return Mnode'(M1 => (State => Mstate_Dp,
+                                 Comp => M.M1.Comp,
+                                 K => K, T => M.M1.T, Dp => D,
+                                 Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
+         when Mstate_Lv =>
+            if M.M1.Ptype = O_Tnode_Null then
+               if not Can_Copy then
+                  raise Internal_Error;
+               end if;
+               D := Create_Temp_Init (M.M1.Vtype, New_Value (M.M1.Lv));
+               return Mnode'(M1 => (State => Mstate_Dv,
+                                    Comp => M.M1.Comp,
+                                    K => K, T => M.M1.T, Dv => D,
+                                    Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
+
+            else
+               D := Create_Temp_Ptr (M.M1.Ptype, M.M1.Lv);
+               return Mnode'(M1 => (State => Mstate_Dp,
+                                    Comp => M.M1.Comp,
+                                    K => K, T => M.M1.T, Dp => D,
+                                    Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
+            end if;
+         when Mstate_Dp
+           | Mstate_Dv =>
+            return M;
+         when Mstate_Bad
+           | Mstate_Null =>
+            raise Internal_Error;
+      end case;
+   end Stabilize;
+
+   procedure Stabilize (M : in out Mnode) is
+   begin
+      M := Stabilize (M);
+   end Stabilize;
+
+   function Stabilize_Value (M : Mnode) return Mnode
+   is
+      D : O_Dnode;
+      E : O_Enode;
+   begin
+      --  M must be scalar or access.
+      if M.M1.Comp then
+         raise Internal_Error;
+      end if;
+      case M.M1.State is
+         when Mstate_E =>
+            E := M.M1.E;
+         when Mstate_Lp =>
+            E := New_Value (New_Acc_Value (M.M1.Lp));
+         when Mstate_Lv =>
+            E := New_Value (M.M1.Lv);
+         when Mstate_Dp
+           | Mstate_Dv =>
+            return M;
+         when Mstate_Bad
+           | Mstate_Null =>
+            raise Internal_Error;
+      end case;
+
+      D := Create_Temp_Init (M.M1.Vtype, E);
+      return Mnode'(M1 => (State => Mstate_Dv,
+                           Comp => M.M1.Comp,
+                           K => M.M1.K, T => M.M1.T, Dv => D,
+                           Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
+   end Stabilize_Value;
+
+   function M2E (M : Mnode) return O_Enode is
+   begin
+      case M.M1.State is
+         when Mstate_E =>
+            return M.M1.E;
+         when Mstate_Lp =>
+            case M.M1.T.Type_Mode is
+               when Type_Mode_Unknown =>
+                  raise Internal_Error;
+               when Type_Mode_Thin =>
+                  return New_Value (New_Acc_Value (M.M1.Lp));
+               when Type_Mode_Fat =>
+                  return New_Value (M.M1.Lp);
+            end case;
+         when Mstate_Dp =>
+            case M.M1.T.Type_Mode is
+               when Type_Mode_Unknown =>
+                  raise Internal_Error;
+               when Type_Mode_Thin =>
+                  return New_Value (New_Acc_Value (New_Obj (M.M1.Dp)));
+               when Type_Mode_Fat =>
+                  return New_Value (New_Obj (M.M1.Dp));
+            end case;
+         when Mstate_Lv =>
+            case M.M1.T.Type_Mode is
+               when Type_Mode_Unknown =>
+                  raise Internal_Error;
+               when Type_Mode_Thin =>
+                  return New_Value (M.M1.Lv);
+               when Type_Mode_Fat =>
+                  return New_Address (M.M1.Lv, M.M1.Ptype);
+            end case;
+         when Mstate_Dv =>
+            case M.M1.T.Type_Mode is
+               when Type_Mode_Unknown =>
+                  raise Internal_Error;
+               when Type_Mode_Thin =>
+                  return New_Value (New_Obj (M.M1.Dv));
+               when Type_Mode_Fat =>
+                  return New_Address (New_Obj (M.M1.Dv), M.M1.Ptype);
+            end case;
+         when Mstate_Bad
+           | Mstate_Null =>
+            raise Internal_Error;
+      end case;
+   end M2E;
+
+   function M2Addr (M : Mnode) return O_Enode is
+   begin
+      case M.M1.State is
+         when Mstate_Lp =>
+            return New_Value (M.M1.Lp);
+         when Mstate_Dp =>
+            return New_Value (New_Obj (M.M1.Dp));
+         when Mstate_Lv =>
+            return New_Address (M.M1.Lv, M.M1.Ptype);
+         when Mstate_Dv =>
+            return New_Address (New_Obj (M.M1.Dv), M.M1.Ptype);
+         when Mstate_E =>
+            if M.M1.Comp then
+               return M.M1.E;
+            else
+               raise Internal_Error;
+            end if;
+         when Mstate_Bad
+           | Mstate_Null =>
+            raise Internal_Error;
+      end case;
+   end M2Addr;
+
+--    function Is_Null (M : Mnode) return Boolean is
+--    begin
+--       return M.M1.State = Mstate_Null;
+--    end Is_Null;
+
+   function Is_Stable (M : Mnode) return Boolean is
+   begin
+      case M.M1.State is
+         when Mstate_Dp
+           | Mstate_Dv =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Stable;
+
+--    function Varv2M
+--      (Var : Var_Acc; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
+--      return Mnode is
+--    begin
+--       return Lv2M (Get_Var (Var), Vtype, Mode);
+--    end Varv2M;
+
+   function Varv2M (Var : Var_Acc;
+                    Var_Type : Type_Info_Acc;
+                    Mode : Object_Kind_Type;
+                    Vtype : O_Tnode;
+                    Ptype : O_Tnode)
+     return Mnode is
+   begin
+      return Lv2M (Get_Var (Var), Var_Type, Mode, Vtype, Ptype);
+   end Varv2M;
+
+   --  Convert a Lnode for a sub object) to an MNODE.
+   function Lo2M (L : O_Lnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
+     return Mnode is
+   begin
+      case Vtype.Type_Mode is
+         when Type_Mode_Scalar
+           | Type_Mode_Acc
+           | Type_Mode_File
+           | Type_Mode_Fat_Array
+           | Type_Mode_Fat_Acc =>
+            return Lv2M (L, Vtype, Mode);
+         when Type_Mode_Ptr_Array
+           | Type_Mode_Array
+           | Type_Mode_Record
+           | Type_Mode_Protected =>
+            if Vtype.C = null then
+               return Lv2M (L, Vtype, Mode);
+            else
+               return Lp2M (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_Ptr_Array
+           | Type_Mode_Array
+           | Type_Mode_Record
+           | Type_Mode_Protected =>
+            if Vtype.C = null then
+               return Dv2M (D, Vtype, Mode);
+            else
+               return Dp2M (D, Vtype, Mode);
+            end if;
+         when Type_Mode_Unknown =>
+            raise Internal_Error;
+      end case;
+   end Lo2M;
+
+   function Get_Var
+     (Var : Var_Acc; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
+     return Mnode
+   is
+      L : O_Lnode;
+      D : O_Dnode;
+      Stable : Boolean;
+   begin
+      --  FIXME: there may be Vv2M and Vp2M.
+      Stable := Is_Var_Stable (Var);
+      if Stable then
+         D := Get_Var_Label (Var);
+      else
+         L := Get_Var (Var);
+      end if;
+      case Vtype.Type_Mode is
+         when Type_Mode_Scalar
+           | Type_Mode_Acc
+           | Type_Mode_File
+           | Type_Mode_Fat_Array
+           | Type_Mode_Fat_Acc =>
+            if Stable then
+               return Dv2M (D, Vtype, Mode);
+            else
+               return Lv2M (L, Vtype, Mode);
+            end if;
+         when Type_Mode_Ptr_Array
+           | Type_Mode_Array
+           | Type_Mode_Record
+           | Type_Mode_Protected =>
+            if Vtype.C = null then
+               if Stable then
+                  return Dv2M (D, Vtype, Mode);
+               else
+                  return Lv2M (L, Vtype, Mode);
+               end if;
+            else
+               if Stable then
+                  return Dp2M (D, Vtype, Mode);
+               else
+                  return Lp2M (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 Info.C /= null 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; Extract_Name : Boolean)
+                                 return Foreign_Info_Type
+   is
+      use Name_Table;
+      Attr : Iir_Attribute_Value;
+      Spec : Iir_Attribute_Specification;
+      Attr_Decl : Iir;
+      Expr : Iir;
+      P : Natural;
+   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 := Get_String_Length (Expr);
+               for I in 1 .. Name_Length loop
+                  Name_Buffer (I) := Ptr (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
+         P := 11;
+
+         --  Skip spaces.
+         while P <= Name_Length and then Name_Buffer (P) = ' ' loop
+            P := P + 1;
+         end loop;
+         if Extract_Name then
+            return Foreign_Info_Type'
+              (Kind => Foreign_Vhpidirect,
+               Subprg => Get_Identifier (Name_Buffer (P .. Name_Length)),
+               Lib => Null_Identifier);
+         else
+            return Foreign_Info_Type'(Kind => Foreign_Vhpidirect,
+                                      Subprg => O_Ident_Nul,
+                                      Lib => Null_Identifier);
+         end if;
+      elsif Name_Length = 14
+        and then Name_Buffer (1 .. 14) = "GHDL intrinsic"
+      then
+         return Foreign_Info_Type'(Kind => Foreign_Intrinsic,
+                                   Subprg => Create_Identifier);
+      else
+         Error_Msg_Sem
+           ("value of 'FOREIGN attribute does not begin with VHPIDIRECT",
+            Spec);
+         return Foreign_Bad;
+      end if;
+   end Translate_Foreign_Id;
+
+   package body Helpers is
+      function New_Value_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
+        return O_Enode is
+      begin
+         return New_Value
+           (New_Selected_Element (New_Access_Element (New_Value (L)), Field));
+      end New_Value_Selected_Acc_Value;
+
+      function New_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
+        return O_Lnode is
+      begin
+         return New_Selected_Element
+           (New_Access_Element (New_Value (L)), Field);
+      end New_Selected_Acc_Value;
+
+      function New_Indexed_Acc_Value (L : O_Lnode; I : O_Enode) return O_Lnode
+      is
+      begin
+         return New_Indexed_Element (New_Access_Element (New_Value (L)), I);
+      end New_Indexed_Acc_Value;
+
+      function New_Acc_Value (L : O_Lnode) return O_Lnode is
+      begin
+         return New_Access_Element (New_Value (L));
+      end New_Acc_Value;
+
+      procedure Copy_Fat_Pointer (D : Mnode; S: Mnode)
+      is
+      begin
+         New_Assign_Stmt (M2Lp (Chap3.Get_Array_Base (D)),
+                          M2Addr (Chap3.Get_Array_Base (S)));
+         New_Assign_Stmt (M2Lp (Chap3.Get_Array_Bounds (D)),
+                          M2Addr (Chap3.Get_Array_Bounds (S)));
+      end Copy_Fat_Pointer;
+
+      procedure Copy_Fat_Pointer
+        (D : O_Dnode; S : O_Dnode; Ftype : Iir; Is_Sig : Object_Kind_Type)
+      is
+         Info : Type_Info_Acc := Get_Info (Ftype);
+      begin
+         New_Assign_Stmt
+           (New_Selected_Acc_Value (New_Obj (D), Info.T.Base_Field (Is_Sig)),
+            New_Value_Selected_Acc_Value (New_Obj (S),
+                                          Info.T.Base_Field (Is_Sig)));
+         New_Assign_Stmt
+           (New_Selected_Acc_Value (New_Obj (D), Info.T.Bounds_Field (Is_Sig)),
+            New_Value_Selected_Acc_Value (New_Obj (S),
+                                          Info.T.Bounds_Field (Is_Sig)));
+      end Copy_Fat_Pointer;
+
+      procedure Copy_Fat_Access (D : O_Dnode; S : O_Dnode; Ptr_Type : Iir)
+      is
+      begin
+         Copy_Fat_Pointer (D, S, Get_Designated_Type (Ptr_Type), Mode_Value);
+      end Copy_Fat_Access;
+
+      procedure Inc_Var (V : O_Dnode) is
+      begin
+         New_Assign_Stmt
+           (New_Obj (V), New_Dyadic_Op
+            (ON_Add_Ov,
+             New_Value (New_Obj (V)),
+             New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, 1))));
+      end Inc_Var;
+
+--       procedure Dec_Var (V : O_Lnode) is
+--       begin
+--          New_Assign_Stmt
+--            (V, New_Dyadic_Op (ON_Sub_Ov,
+--                               New_Value (V),
+--                               New_Unsigned_Literal (Ghdl_Index_Type, 1)));
+--       end Dec_Var;
+
+      procedure Init_Var (V : O_Dnode) is
+      begin
+         New_Assign_Stmt
+           (New_Obj (V), New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, 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 O_Ident
+      is
+         Str : String (1 .. 12);
+         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;
+         --Str (12) := Nul;
+         return Get_Identifier (Str (1 .. 11));
+      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;
+
+      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;
+      end Open_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 Close_Temp
+      is
+         L : Temp_Level_Acc;
+         Constr : O_Assoc_List;
+      begin
+         if Temp_Level = null then
+            --  OPEN_TEMP was not called.
+            raise Internal_Error;
+         end if;
+         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);
+         end if;
+         if Temp_Level.Emitted then
+            Finish_Declare_Stmt;
+         end if;
+
+         --  Destroy transcient types.
+         if Temp_Level.Transient_Types /= Null_Iir then
+            declare
+               Atype : Iir;
+               N_Atype : Iir;
+            begin
+               Atype := Temp_Level.Transient_Types;
+               while Atype /= Null_Iir loop
+                  N_Atype := Get_Info (Atype).Type_Transient_Chain;
+                  Chap3.Destroy_Type_Info (Atype);
+                  Atype := N_Atype;
+               end loop;
+            end;
+         end if;
+
+         --  Unlink temp_level.
+         L := Temp_Level;
+         Temp_Level := L.Prev;
+         L.Prev := Old_Level;
+         Old_Level := L;
+      end Close_Temp;
+
+      procedure Free_Old_Temp
+      is
+         procedure Free is new Ada.Unchecked_Deallocation
+           (Temp_Level_Type, Temp_Level_Acc);
+         T : Temp_Level_Acc;
+      begin
+         if Temp_Level /= null then
+            raise Internal_Error;
+         end if;
+         loop
+            T := Old_Level;
+            exit when T = null;
+            Old_Level := Old_Level.Prev;
+            Free (T);
+         end loop;
+      end Free_Old_Temp;
+
+      procedure Create_Temp_Stack2_Mark
+      is
+         Constr : O_Assoc_List;
+      begin
+         if Temp_Level.Stack2_Mark /= O_Dnode_Null then
+            --  Only the first mark in a region is registred.
+            --  The release operation frees the memory allocated after the
+            --  first mark.
+            return;
+         end if;
+         Temp_Level.Stack2_Mark := Create_Temp (Ghdl_Ptr_Type);
+         Start_Association (Constr, Ghdl_Stack2_Mark);
+         New_Assign_Stmt (New_Obj (Temp_Level.Stack2_Mark),
+                          New_Function_Call (Constr));
+      end Create_Temp_Stack2_Mark;
+
+      function Create_Temp (Atype : O_Tnode) return O_Dnode
+      is
+         Str : String (1 .. 12);
+         Val : Natural;
+         Res : O_Dnode;
+         P : Natural;
+      begin
+         if Temp_Level = null then
+            --  OPEN_TEMP was never called.
+            raise Internal_Error;
+            --  This is an hack, just to allow array subtype to array type
+            --  conversion.
+            --New_Var_Decl
+            --  (Res, Create_Uniq_Identifier, O_Storage_Private, Atype);
+            --return Res;
+         else
+            if not Temp_Level.Emitted then
+               Temp_Level.Emitted := True;
+               Start_Declare_Stmt;
+            end if;
+         end if;
+         Val := Temp_Level.Id;
+         Temp_Level.Id := Temp_Level.Id + 1;
+         P := Str'Last;
+         loop
+            Str (P) := Character'Val (Val mod 10 + Character'Pos ('0'));
+            Val := Val / 10;
+            P := P - 1;
+            exit when Val = 0;
+         end loop;
+         Str (P) := '_';
+         P := P - 1;
+         Val := Temp_Level.Level;
+         loop
+            Str (P) := Character'Val (Val mod 10 + Character'Pos ('0'));
+            Val := Val / 10;
+            P := P - 1;
+            exit when Val = 0;
+         end loop;
+         Str (P) := 'T';
+         --Str (12) := Nul;
+         New_Var_Decl
+           (Res, Get_Identifier (Str (P .. Str'Last)), O_Storage_Local, Atype);
+         return Res;
+      end Create_Temp;
+
+      function Create_Temp_Init (Atype : O_Tnode; Value : O_Enode)
+        return O_Dnode
+      is
+         Res : O_Dnode;
+      begin
+         Res := Create_Temp (Atype);
+         New_Assign_Stmt (New_Obj (Res), Value);
+         return Res;
+      end Create_Temp_Init;
+
+      function Create_Temp_Ptr (Atype : O_Tnode; Name : O_Lnode)
+        return O_Dnode is
+      begin
+         return Create_Temp_Init (Atype, New_Address (Name, Atype));
+      end Create_Temp_Ptr;
+
+      function Create_Temp_Ptr
+        (Atype : Iir; Name : O_Lnode; Is_Sig : Object_Kind_Type)
+        return O_Dnode
+      is
+         Temp_Type : O_Tnode;
+      begin
+         Temp_Type := Get_Info (Atype).Ortho_Ptr_Type (Is_Sig);
+         return Create_Temp_Init (Temp_Type, New_Address (Name, Temp_Type));
+      end Create_Temp_Ptr;
+
+      --  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_Array =>
+               declare
+                  Var_I : O_Dnode;
+                  Var_Array : Mnode;
+                  Label : O_Snode;
+                  Composite_Data : Composite_Data_Type;
+                  Sub_Data : Data_Type;
+               begin
+                  Open_Temp;
+                  Var_Array := Stabilize (Targ);
+                  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);
+                  Composite_Data :=
+                    Prepare_Data_Array (Var_Array, Targ_Type, Data);
+                  Start_Loop_Stmt (Label);
+                  Gen_Exit_When
+                    (Label,
+                     New_Compare_Op (ON_Ge,
+                                     New_Value (New_Obj (Var_I)),
+                                     Chap3.Get_Array_Type_Length (Targ_Type),
+                                     Ghdl_Bool_Type));
+                  Sub_Data := Update_Data_Array
+                    (Composite_Data, Targ_Type, Var_I);
+                  Foreach_Non_Composite
+                    (Chap3.Index_Base (Var_Array, 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_Fat_Array
+              | Type_Mode_Ptr_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;
+                  El : Iir_Element_Declaration;
+               begin
+                  Open_Temp;
+                  Var_Record := Stabilize (Targ);
+                  Composite_Data :=
+                    Prepare_Data_Record (Var_Record, Targ_Type, Data);
+                  El := Get_Element_Declaration_Chain
+                    (Get_Base_Type (Targ_Type));
+                  while El /= Null_Iir loop
+                     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);
+                     El := Get_Chain (El);
+                  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)
+      is
+         Proc_1 : O_Dnode := Proc;
+      begin
+         Register_Signal_1 (Targ, Targ_Type, Proc_1);
+      end Register_Signal;
+
+      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_Ptr_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;
+   end Helpers;
+
+   package body Chap1 is
+      procedure Start_Block_Decl (Blk : Iir)
+      is
+         Info : Block_Info_Acc;
+      begin
+         Info := Get_Info (Blk);
+         New_Uncomplete_Record_Type (Info.Block_Decls_Type);
+         New_Type_Decl (Create_Identifier ("INSTTYPE"), Info.Block_Decls_Type);
+         Info.Block_Decls_Ptr_Type := New_Access_Type (Info.Block_Decls_Type);
+         New_Type_Decl (Create_Identifier ("INSTPTR"),
+                        Info.Block_Decls_Ptr_Type);
+      end Start_Block_Decl;
+
+      procedure Translate_Entity_Init (Entity : Iir)
+      is
+         Info : Block_Info_Acc;
+         El : Iir;
+         El_Type : Iir;
+      begin
+         Info := Get_Info (Entity);
+
+         Push_Local_Factory;
+
+         --  Generics.
+         El := Get_Generic_Chain (Entity);
+         while El /= Null_Iir loop
+            Chap4.Elab_Object_Value (El, Get_Default_Value (El));
+            El := Get_Chain (El);
+         end loop;
+
+         --  Ports.
+         El := Get_Port_Chain (Entity);
+         while El /= Null_Iir loop
+            El_Type := Get_Type (El);
+            if Get_Kind (El_Type)
+              in Iir_Kinds_Unconstrained_Array_Type_Definition
+            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);
+
+            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.Instance_Inters;
+      begin
+         Info := Add_Info (Entity, Kind_Block);
+         Chap1.Start_Block_Decl (Entity);
+         Push_Instance_Factory (Info.Block_Decls_Type);
+
+         --  Entity link (RTI and pointer to parent).
+         Info.Block_Link_Field := Add_Instance_Factory_Field
+           (Wki_Rti, Rtis.Ghdl_Entity_Link_Type);
+
+         --  generics, ports.
+         Chap4.Translate_Generic_Chain (Entity);
+         Chap4.Translate_Port_Chain (Entity);
+
+         Chap9.Translate_Block_Declarations (Entity, Entity);
+
+         Pop_Instance_Factory (Info.Block_Decls_Type);
+
+         Chap2.Push_Subprg_Instance (Info.Block_Decls_Type,
+                                     Info.Block_Decls_Ptr_Type,
+                                     Wki_Instance);
+
+         --  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);
+
+         --  Generate RTI.
+         if Flag_Rti then
+            Rtis.Generate_Unit (Entity);
+         end if;
+
+         if Global_Storage /= O_Storage_External then
+            --  Entity process subprograms.
+            Chap9.Translate_Block_Subprograms (Entity, Entity);
+
+            --  Elaborator Body.
+            Start_Subprogram_Body (Info.Block_Elab_Subprg);
+            Push_Local_Factory;
+            Chap2.Start_Subprg_Instance_Use (Instance);
+            --  Set entity name.
+            New_Debug_Line_Stmt (Get_Line_Number (Entity));
+            Chap2.Elab_Dependence (Get_Design_Unit (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);
+      end Translate_Entity_Declaration;
+
+      --  Push scope for architecture ARCH via INSTANCE, and for its
+      --  entity via the entity field of the instance.
+      procedure Push_Architecture_Scope (Arch : Iir; Instance : O_Dnode)
+      is
+         Arch_Info : Block_Info_Acc;
+         Entity : Iir;
+         Entity_Info : Block_Info_Acc;
+      begin
+         Arch_Info := Get_Info (Arch);
+         Entity := Get_Entity (Arch);
+         Entity_Info := Get_Info (Entity);
+
+         Push_Scope (Arch_Info.Block_Decls_Type, Instance);
+         Push_Scope (Entity_Info.Block_Decls_Type,
+                     Arch_Info.Block_Parent_Field, Arch_Info.Block_Decls_Type);
+      end Push_Architecture_Scope;
+
+      --  Pop scopes created by Push_Architecture_Scope.
+      procedure Pop_Architecture_Scope (Arch : Iir)
+      is
+         Arch_Info : Block_Info_Acc;
+         Entity : Iir;
+         Entity_Info : Block_Info_Acc;
+      begin
+         Arch_Info := Get_Info (Arch);
+         Entity := Get_Entity (Arch);
+         Entity_Info := Get_Info (Entity);
+
+         Pop_Scope (Entity_Info.Block_Decls_Type);
+         Pop_Scope (Arch_Info.Block_Decls_Type);
+      end Pop_Architecture_Scope;
+
+      procedure Translate_Architecture_Declaration (Arch : Iir)
+      is
+         Info : Block_Info_Acc;
+         Entity : Iir;
+         Entity_Info : Block_Info_Acc;
+         Interface_List : O_Inter_List;
+         Constr : O_Assoc_List;
+         Instance : O_Dnode;
+         Var_Arch_Instance : O_Dnode;
+      begin
+         if Get_Foreign_Flag (Arch) then
+            Error_Msg_Sem ("FOREIGN architectures are not yet handled", Arch);
+         end if;
+
+         Info := Add_Info (Arch, Kind_Block);
+         Start_Block_Decl (Arch);
+         Push_Instance_Factory (Info.Block_Decls_Type);
+
+         Entity := Get_Entity (Arch);
+         Entity_Info := Get_Info (Entity);
+         Info.Block_Parent_Field := Add_Instance_Factory_Field
+           (Get_Identifier ("ENTITY"), Entity_Info.Block_Decls_Type);
+
+         Chap9.Translate_Block_Declarations (Arch, Arch);
+
+         Pop_Instance_Factory (Info.Block_Decls_Type);
+
+         --  Declare the constant containing the size of the instance.
+         New_Const_Decl
+           (Info.Block_Instance_Size, Create_Identifier ("INSTSIZE"),
+            Global_Storage, Ghdl_Index_Type);
+         if Global_Storage /= O_Storage_External then
+            Start_Const_Value (Info.Block_Instance_Size);
+            Finish_Const_Value
+              (Info.Block_Instance_Size,
+               New_Sizeof (Info.Block_Decls_Type, Ghdl_Index_Type));
+         end if;
+
+         --  Elaborator.
+         Start_Procedure_Decl
+           (Interface_List, Create_Identifier ("ELAB"), Global_Storage);
+         New_Interface_Decl
+           (Interface_List, Instance, Wki_Instance,
+            Entity_Info.Block_Decls_Ptr_Type);
+         Finish_Subprogram_Decl (Interface_List, Info.Block_Elab_Subprg);
+
+         --  Generate RTI.
+         if Flag_Rti then
+            Rtis.Generate_Unit (Arch);
+         end if;
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         Chap2.Push_Subprg_Instance (Info.Block_Decls_Type,
+                                     Info.Block_Decls_Ptr_Type,
+                                     Wki_Instance);
+
+         --  Create process subprograms.
+         Push_Scope (Entity_Info.Block_Decls_Type,
+                     Info.Block_Parent_Field, Info.Block_Decls_Type);
+         Chap9.Translate_Block_Subprograms (Arch, Arch);
+         Pop_Scope (Entity_Info.Block_Decls_Type);
+
+         Chap2.Pop_Subprg_Instance (Wki_Instance);
+
+         --  Elaborator body.
+         Start_Subprogram_Body (Info.Block_Elab_Subprg);
+         Push_Local_Factory;
+
+         ----  Allocate memory for the instance.
+         --New_Assign_Stmt
+         --  (Instance, Gen_Alloc (Alloc_Memory,
+         --                        New_Sizeof (Info.Block_Decls_Type,
+         --                                    Ghdl_Index_Type),
+         --                        Info.Block_Decls_Ptr_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 elaborator.
+         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_Declaration;
+
+      procedure Translate_Component_Configuration_Decl
+        (Cfg : Iir;
+         Arch : Iir_Architecture_Declaration;
+         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;
+
+         Arch_Info : Block_Info_Acc;
+         Arch_Param : 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_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);
+
+         Arch_Info := Get_Info (Arch);
+
+         Chap4.Translate_Association_Subprograms
+           (Get_Port_Map_Aspect_Chain (Binding), Arch,
+            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, Arch_Param, Get_Identifier ("ARCH"),
+                             Arch_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;
+
+         Push_Architecture_Scope (Arch, Arch_Param);
+         Push_Scope (Comp_Info.Comp_Type, Instance);
+
+         if Conf_Info /= null then
+            Clear_Info (Cfg);
+            Set_Info (Cfg, Conf_Info);
+         end if;
+         Chap9.Translate_Entity_Instantiation
+           (Entity_Aspect, Binding, Comp, Conf_Override);
+         if Conf_Info /= null then
+            Clear_Info (Cfg);
+            Set_Info (Cfg, Info);
+         end if;
+
+         Pop_Scope (Comp_Info.Comp_Type);
+         Pop_Architecture_Scope (Arch);
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Component_Configuration_Decl;
+
+      --  Create subprogram specifications for each configuration_specification
+      --  in BLOCK_CONFIG and its sub-blocks.
+      --  ARCH is the architecture being configured.
+      --  NUM is an integer used to generate uniq names.
+      procedure Translate_Block_Configuration_Decls
+        (Block_Config : Iir_Block_Configuration;
+         Arch : Iir_Architecture_Declaration;
+         Num : in out Iir_Int32)
+      is
+         El : Iir;
+         Mark : Id_Mark_Type;
+         Blk : 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, Arch, Num);
+               when Iir_Kind_Block_Configuration =>
+                  Blk := Get_Block_From_Block_Specification
+                    (Get_Block_Specification (El));
+                  Push_Identifier_Prefix (Mark, Get_Identifier (Blk));
+                  Translate_Block_Configuration_Decls (El, Arch, Num);
+                  Pop_Identifier_Prefix (Mark);
+               when others =>
+                  Error_Kind ("translate_block_configuration_decls(1)", El);
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end Translate_Block_Configuration_Decls;
+
+      procedure Translate_Component_Configuration_Call
+        (Cfg : Iir;
+         Arch : Iir_Architecture_Declaration;
+         Block_Info : Block_Info_Acc)
+      is
+         Cfg_Info : Config_Info_Acc;
+         Arch_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);
+         Arch_Info := Get_Info (Arch);
+
+         --  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;
+               case Get_Kind (El) is
+                  when Iir_Kind_Component_Instantiation_Statement =>
+                     declare
+                        Assoc : O_Assoc_List;
+                        Info : Block_Info_Acc;
+                        V : O_Lnode;
+                     begin
+                        Info := Get_Info (El);
+                        Start_Association (Assoc, Cfg_Info.Config_Subprg);
+                        V := Get_Instance_Ref (Block_Info.Block_Decls_Type);
+                        V := New_Selected_Element (V, Info.Block_Parent_Field);
+                        New_Association
+                          (Assoc, New_Address (V, Info.Block_Decls_Ptr_Type));
+                        V := Get_Instance_Ref (Arch_Info.Block_Decls_Type);
+                        New_Association
+                          (Assoc,
+                           New_Address (V, Arch_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;
+         Arch : Iir_Architecture_Declaration;
+         Info : Block_Info_Acc);
+
+      procedure Translate_Generate_Block_Configuration_Calls
+        (Block_Config : Iir_Block_Configuration;
+         Arch : Iir_Architecture_Declaration;
+         Parent_Info : Block_Info_Acc)
+      is
+         Spec : Iir;
+         Block : Iir_Generate_Statement;
+         Scheme : Iir;
+         Info : Block_Info_Acc;
+
+         --  Generate a call for a iterative generate block whose index is
+         --  INDEX.
+         --  FAILS is true if it is an error if the block is already
+         --  configured.
+         procedure Gen_Subblock_Call (Index : O_Enode; Fails : Boolean)
+         is
+            Var_Inst : O_Dnode;
+            If_Blk : O_If_Block;
+         begin
+            Open_Temp;
+            Var_Inst := Create_Temp (Info.Block_Decls_Ptr_Type);
+            New_Assign_Stmt
+              (New_Obj (Var_Inst),
+               New_Address (New_Indexed_Element
+                            (New_Acc_Value
+                             (New_Selected_Element
+                              (Get_Instance_Ref (Parent_Info.Block_Decls_Type),
+                               Info.Block_Parent_Field)),
+                             Index),
+                            Info.Block_Decls_Ptr_Type));
+            --  Configure only if not yet configured.
+            Start_If_Stmt
+              (If_Blk,
+               New_Compare_Op (ON_Eq,
+                               New_Value_Selected_Acc_Value
+                               (New_Obj (Var_Inst),
+                                Info.Block_Configured_Field),
+                               New_Lit (Ghdl_Bool_False_Node),
+                               Ghdl_Bool_Type));
+            --  Mark the block as configured.
+            New_Assign_Stmt
+              (New_Selected_Acc_Value (New_Obj (Var_Inst),
+                                       Info.Block_Configured_Field),
+               New_Lit (Ghdl_Bool_True_Node));
+            Push_Scope (Info.Block_Decls_Type, Var_Inst);
+            Push_Scope_Via_Field_Ptr
+              (Parent_Info.Block_Decls_Type,
+               Info.Block_Origin_Field,
+               Info.Block_Decls_Type);
+            Translate_Block_Configuration_Calls (Block_Config, Arch, Info);
+            Pop_Scope (Parent_Info.Block_Decls_Type);
+            Pop_Scope (Info.Block_Decls_Type);
+
+            if Fails then
+               New_Else_Stmt (If_Blk);
+               --  Already configured.
+               Chap6.Gen_Program_Error (Block_Config);
+            end if;
+
+            Finish_If_Stmt (If_Blk);
+            Close_Temp;
+         end Gen_Subblock_Call;
+
+         Type_Info : Type_Info_Acc;
+         Iter_Type : Iir;
+      begin
+         Spec := Get_Block_Specification (Block_Config);
+         Block := Get_Block_From_Block_Specification (Spec);
+         Info := Get_Info (Block);
+         Scheme := Get_Generation_Scheme (Block);
+         if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+            Iter_Type := Get_Type (Scheme);
+            Type_Info := Get_Info (Get_Base_Type (Iter_Type));
+            case Get_Kind (Spec) is
+               when Iir_Kind_Generate_Statement
+                 | Iir_Kind_Selected_Name =>
+                  --  Apply for all/remaining blocks.
+                  declare
+                     Var_I : O_Dnode;
+                     Label : O_Snode;
+                  begin
+                     Start_Declare_Stmt;
+                     New_Var_Decl (Var_I, Wki_I, O_Storage_Local,
+                                   Ghdl_Index_Type);
+                     Init_Var (Var_I);
+                     Start_Loop_Stmt (Label);
+                     Gen_Exit_When
+                       (Label,
+                        New_Compare_Op
+                        (ON_Eq,
+                         New_Value (New_Obj (Var_I)),
+                         New_Value
+                         (New_Selected_Element
+                          (Get_Var (Get_Info (Iter_Type).T.Range_Var),
+                           Type_Info.T.Range_Length)),
+                         Ghdl_Bool_Type));
+                     --  Selected_name is for default configurations, so
+                     --  program should not fail if a block is already
+                     --  configured but continue silently.
+                     Gen_Subblock_Call
+                       (New_Value (New_Obj (Var_I)),
+                        Get_Kind (Spec) /= Iir_Kind_Selected_Name);
+                     Inc_Var (Var_I);
+                     Finish_Loop_Stmt (Label);
+                     Finish_Declare_Stmt;
+                  end;
+               when Iir_Kind_Indexed_Name =>
+                  declare
+                     Range_Ptr : O_Dnode;
+                  begin
+                     Open_Temp;
+                     Range_Ptr := Create_Temp_Ptr
+                       (Type_Info.T.Range_Ptr_Type,
+                        Get_Var (Get_Info (Iter_Type).T.Range_Var));
+                     Gen_Subblock_Call
+                       (Chap6.Translate_Index_To_Offset
+                        (Range_Ptr,
+                         Chap7.Translate_Expression
+                         (Get_Nth_Element (Get_Index_List (Spec), 0),
+                          Iter_Type),
+                         Iter_Type,
+                         Spec),
+                        True);
+                     Close_Temp;
+                  end;
+               when Iir_Kind_Slice_Name =>
+                  declare
+                     Range_Ptr : O_Dnode;
+                     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;
+                     Range_Ptr := Create_Temp_Ptr
+                       (Type_Info.T.Range_Ptr_Type,
+                        Get_Var (Get_Info (Iter_Type).T.Range_Var));
+                     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
+                        (Range_Ptr,
+                         New_Value (New_Selected_Element
+                                    (New_Obj (Slice), Type_Info.T.Range_Left)),
+                         Iter_Type,
+                         Spec));
+                     Right := Create_Temp_Init
+                       (Ghdl_Index_Type,
+                        Chap6.Translate_Index_To_Offset
+                        (Range_Ptr,
+                         New_Value (New_Selected_Element
+                                    (New_Obj (Slice),
+                                     Type_Info.T.Range_Right)),
+                         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,
+                                        New_Value_Selected_Acc_Value
+                                        (New_Obj (Range_Ptr),
+                                         Type_Info.T.Range_Dir),
+                                        New_Value
+                                        (New_Selected_Element
+                                         (New_Obj (Slice),
+                                          Type_Info.T.Range_Dir)),
+                                        Ghdl_Bool_Type));
+                     --  Same direction, so left to right.
+                     New_Assign_Stmt (New_Obj (Index),
+                                      New_Value (New_Obj (Left)));
+                     New_Assign_Stmt (New_Obj (High),
+                                      New_Value (New_Obj (Right)));
+                     New_Else_Stmt (If_Blk);
+                     --  Opposite direction, so right to left.
+                     New_Assign_Stmt (New_Obj (Index),
+                                      New_Value (New_Obj (Right)));
+                     New_Assign_Stmt (New_Obj (High),
+                                      New_Value (New_Obj (Left)));
+                     Finish_If_Stmt (If_Blk);
+
+                     --  Loop.
+                     Start_Loop_Stmt (Label);
+                     Gen_Exit_When
+                       (Label, New_Compare_Op (ON_Gt,
+                                               New_Value (New_Obj (Index)),
+                                               New_Value (New_Obj (High)),
+                                               Ghdl_Bool_Type));
+                     Open_Temp;
+                     Gen_Subblock_Call (New_Value (New_Obj (Index)), True);
+                     Close_Temp;
+                     Inc_Var (Index);
+                     Finish_Loop_Stmt (Label);
+                     Close_Temp;
+                  end;
+               when others =>
+                  Error_Kind
+                    ("translate_generate_block_configuration_calls", Spec);
+            end case;
+         else
+            --  Conditional generate statement.
+            declare
+               Var : O_Dnode;
+               If_Blk : O_If_Block;
+            begin
+               --  Configure the block only if it was created.
+               Open_Temp;
+               Var := Create_Temp_Init
+                 (Info.Block_Decls_Ptr_Type,
+                  New_Value (New_Selected_Element
+                             (Get_Instance_Ref (Parent_Info.Block_Decls_Type),
+                              Info.Block_Parent_Field)));
+               Start_If_Stmt
+                 (If_Blk,
+                  New_Compare_Op
+                  (ON_Neq,
+                   New_Obj_Value (Var),
+                   New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)),
+                   Ghdl_Bool_Type));
+               Push_Scope (Info.Block_Decls_Type, Var);
+               Push_Scope_Via_Field_Ptr (Parent_Info.Block_Decls_Type,
+                                         Info.Block_Origin_Field,
+                                         Info.Block_Decls_Type);
+               Translate_Block_Configuration_Calls (Block_Config, Arch, Info);
+               Pop_Scope (Parent_Info.Block_Decls_Type);
+               Pop_Scope (Info.Block_Decls_Type);
+               Finish_If_Stmt (If_Blk);
+               Close_Temp;
+            end;
+         end if;
+      end Translate_Generate_Block_Configuration_Calls;
+
+      procedure Translate_Block_Configuration_Calls
+        (Block_Config : Iir_Block_Configuration;
+         Arch : Iir_Architecture_Declaration;
+         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, Arch, Info);
+               when Iir_Kind_Block_Configuration =>
+                  declare
+                     Block : Iir;
+                     Block_Info : Block_Info_Acc;
+                  begin
+                     Block := Get_Block_Specification (El);
+                     if Get_Kind (Block) = Iir_Kind_Block_Statement then
+                        Block_Info := Get_Info (Block);
+                        Push_Scope (Block_Info.Block_Decls_Type,
+                                    Block_Info.Block_Parent_Field,
+                                    Info.Block_Decls_Type);
+                        Translate_Block_Configuration_Calls
+                          (El, Arch, Block_Info);
+                        Pop_Scope (Block_Info.Block_Decls_Type);
+                     else
+                        Translate_Generate_Block_Configuration_Calls
+                          (El, Arch, Info);
+                     end if;
+                  end;
+               when others =>
+                  Error_Kind ("translate_block_configuration_calls(2)", El);
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end Translate_Block_Configuration_Calls;
+
+      procedure Translate_Configuration_Declaration (Config : Iir)
+      is
+         Interface_List : O_Inter_List;
+         Block_Config : Iir_Block_Configuration;
+         Arch : Iir_Architecture_Declaration;
+         Arch_Info : Block_Info_Acc;
+         Config_Info : Config_Info_Acc;
+         Instance : O_Dnode;
+         Num : Iir_Int32;
+         Final : Boolean;
+      begin
+         if Get_Kind (Config) = Iir_Kind_Configuration_Declaration then
+            Chap4.Translate_Declaration_Chain (Config);
+         end if;
+
+         Config_Info := Add_Info (Config, Kind_Config);
+         Block_Config := Get_Block_Configuration (Config);
+         Arch := Get_Block_Specification (Block_Config);
+         Arch_Info := Get_Info (Arch);
+
+         --  Configurator.
+         Start_Procedure_Decl
+           (Interface_List, Create_Identifier, Global_Storage);
+         New_Interface_Decl (Interface_List, Instance, Wki_Instance,
+                             Arch_Info.Block_Decls_Ptr_Type);
+         Finish_Subprogram_Decl (Interface_List, Config_Info.Config_Subprg);
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         --  Declare subprograms for configuration.
+         Num := 0;
+         Translate_Block_Configuration_Decls (Block_Config, Arch, 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
+            Chap4.Elab_Declaration_Chain (Config, Final);
+            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");
+
+      --  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
+         Info : Ortho_Info_Acc;
+         Mode : Object_Kind_Type;
+         Tinfo : Type_Info_Acc;
+      begin
+         Info := Get_Info (Inter);
+         if Info.Interface_Field = O_Fnode_Null then
+            case Get_Kind (Inter) is
+               when Iir_Kind_Constant_Interface_Declaration
+                 | Iir_Kind_Variable_Interface_Declaration
+                 | Iir_Kind_File_Interface_Declaration =>
+                  Mode := Mode_Value;
+               when Iir_Kind_Signal_Interface_Declaration =>
+                  Mode := Mode_Signal;
+               when others =>
+                  Error_Kind ("translate_interface_type", Inter);
+            end case;
+            Tinfo := Get_Info (Get_Type (Inter));
+            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;
+         else
+            return O_Tnode_Null;
+         end if;
+      end Translate_Interface_Type;
+
+      procedure Translate_Subprogram_Declaration (Spec : Iir)
+      is
+         Inter : Iir;
+         Inter_Type : Iir;
+         Inter_Kind : Iir_Kind;
+         Info : Subprg_Info_Acc;
+         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;
+         Is_Func : Boolean;
+         Rtype : Iir;
+         Id : O_Ident;
+         Storage : O_Storage;
+      begin
+         Info := Get_Info (Spec);
+         Info.Res_Interface := O_Dnode_Null;
+         Is_Func := Get_Kind (Spec) = Iir_Kind_Function_Declaration;
+
+         --  Set the identifier prefix with the subprogram identifier and
+         --  overload number if any.
+         Push_Subprg_Identifier (Spec, Mark);
+
+         if Get_Foreign_Flag (Spec) then
+            declare
+               Fi : Foreign_Info_Type;
+            begin
+               Fi := Translate_Foreign_Id (Spec, True);
+               case Fi.Kind is
+                  when Foreign_Unknown =>
+                     Id := Create_Identifier;
+                  when Foreign_Intrinsic =>
+                     Id := Fi.Subprg;
+                  when Foreign_Vhpidirect =>
+                     Id := Fi.Subprg;
+               end case;
+               Storage := O_Storage_External;
+            end;
+         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 Get_Kind (Rtype)
+                 in Iir_Kinds_Unconstrained_Array_Type_Definition
+               then
+                  Info.Use_Stack2 := True;
+               end if;
+            else
+               Start_Function_Decl
+                 (Interface_List, Id, Storage, Tinfo.Ortho_Type (Mode_Value));
+            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);
+               Inter_Kind := Get_Kind (Inter_Type);
+               Tinfo := Get_Info (Inter_Type);
+               if Get_Kind (Inter) = Iir_Kind_Variable_Interface_Declaration
+                 and then Get_Mode (Inter) in Iir_Out_Modes
+                 and then Tinfo.Type_Mode not in Type_Mode_By_Ref
+               then
+                  --  This interface is done via the result record.
+                  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.
+                  Tinfo := Get_Info (Inter_Type);
+                  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);
+            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;
+
+         Inter := Get_Interface_Declaration_Chain (Spec);
+         while Inter /= Null_Iir loop
+            if Is_Func then
+               Arg_Info := Add_Info (Inter, Kind_Interface);
+               Arg_Info.Interface_Field := O_Fnode_Null;
+            else
+               Arg_Info := Get_Info (Inter);
+            end if;
+
+            Arg_Info.Interface_Type := Translate_Interface_Type (Inter);
+            if Arg_Info.Interface_Type /= O_Tnode_Null then
+               New_Interface_Decl
+                 (Interface_List, Arg_Info.Interface_Node,
+                  Create_Identifier_Without_Prefix (Inter),
+                  Arg_Info.Interface_Type);
+            else
+               --  Parameter is passed by the result record.
+               Arg_Info.Interface_Node := Info.Res_Interface;
+            end if;
+            Inter := Get_Chain (Inter);
+         end loop;
+         Finish_Subprogram_Decl (Interface_List, Info.Ortho_Func);
+
+         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;
+
+      procedure Translate_Subprogram_Body (Subprg : Iir)
+      is
+         Spec : Iir;
+         Func_Decl : O_Dnode;
+         Info : Ortho_Info_Acc;
+         Old_Subprogram : Iir;
+         Mark : Id_Mark_Type;
+         Final : Boolean;
+         Is_Func : Boolean;
+
+         --  Set for a public method.  In this case, the lock must be acquired
+         --  and retained.
+         Is_Prot : Boolean := False;
+
+         Subprg_Instances : Chap2.Subprg_Instance_Stack;
+      begin
+         Spec := Get_Subprogram_Specification (Subprg);
+         Info := Get_Info (Spec);
+         Func_Decl := Info.Ortho_Func;
+
+         --  Do not translate body for foreign subprograms.
+         if Get_Foreign_Flag (Spec) then
+            return;
+         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);
+
+         Start_Subprogram_Body (Func_Decl);
+
+         Start_Subprg_Instance_Use (Spec);
+
+         Push_Local_Factory;
+         Chap2.Save_Subprg_Instance (Subprg_Instances);
+
+         Chap4.Translate_Declaration_Chain (Subprg);
+         Chap4.Translate_Declaration_Chain_Subprograms (Subprg, Null_Iir);
+
+         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_Func := Is_Subprogram_Ortho_Function (Spec);
+            if Is_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;
+         Chap8.Translate_Statements_Chain
+           (Get_Sequential_Statement_Chain (Subprg));
+         Current_Subprogram := Old_Subprogram;
+
+         if Final or Is_Prot then
+            --  FIXME: create a barrier to catch missing return statement.
+            if Get_Kind (Spec) = Iir_Kind_Procedure_Declaration then
+               New_Exit_Stmt (Info.Subprg_Exit);
+            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_Func then
+               New_Return_Stmt (New_Obj_Value (Info.Subprg_Result));
+            end if;
+         end if;
+
+         Chap2.Restore_Subprg_Instance (Subprg_Instances);
+         Pop_Local_Factory;
+
+         Finish_Subprg_Instance_Use (Spec);
+
+         Finish_Subprogram_Body;
+
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Subprogram_Body;
+
+--       procedure Translate_Protected_Subprogram_Declaration
+--         (Def : Iir_Protected_Type_Declaration; Spec : Iir; Block : Iir)
+--       is
+--          Interface_List : O_Inter_List;
+--          Info : Subprg_Info_Acc;
+--          Tinfo : Type_Info_Acc;
+--          Inter : Iir;
+--          Inter_Info : Inter_Info_Acc;
+--          Prot_Subprg : O_Dnode;
+--          Prot_Obj : O_Lnode;
+--          Mark : Id_Mark_Type;
+--          Constr : O_Assoc_List;
+--          Inst_Data : Instance_Data;
+--          Is_Func : Boolean;
+--          Var_Res : O_Lnode;
+--       begin
+--          Chap2.Translate_Subprogram_Declaration (Spec, Block);
+
+--          --  Create protected subprogram
+--          Info := Get_Info (Spec);
+--          Push_Subprg_Identifier (Spec, Info, Mark);
+
+--          Is_Func := Is_Subprogram_Ortho_Function (Spec);
+
+--          if Is_Func then
+--             Tinfo := Get_Info (Get_Return_Type (Spec));
+--             Start_Function_Decl (Interface_List,
+--                                  Create_Identifier ("PROT"),
+--                                  Global_Storage,
+--                                  Tinfo.Ortho_Type (Mode_Value));
+--          else
+--             Start_Procedure_Decl (Interface_List,
+--                                   Create_Identifier ("PROT"),
+--                                   Global_Storage);
+--          end if;
+--          Chap2.Create_Subprg_Instance (Interface_List, Inst_Data, Block);
+
+--          --  FIXME: RES record interface.
+
+--          New_Interface_Decl
+--            (Interface_List,
+--             Prot_Obj,
+--             Get_Identifier ("OBJ"),
+--             Get_Info (Def).Ortho_Ptr_Type (Mode_Value));
+
+--          Inter := Get_Interface_Declaration_Chain (Spec);
+--          while Inter /= Null_Iir loop
+--             Inter_Info := Get_Info (Inter);
+--             if Inter_Info.Interface_Type /= O_Tnode_Null then
+--                New_Interface_Decl
+--                  (Interface_List, Inter_Info.Interface_Protected,
+--                   Create_Identifier_Without_Prefix (Inter),
+--                   Inter_Info.Interface_Type);
+--             end if;
+--             Inter := Get_Chain (Inter);
+--          end loop;
+--          Finish_Subprogram_Decl (Interface_List, Prot_Subprg);
+
+--          if Global_Storage /= O_Storage_External then
+--             --  Body of the protected subprogram.
+--             Start_Subprogram_Body (Prot_Subprg);
+--             Start_Subprg_Instance_Use (Inst_Data);
+
+--             if Is_Func then
+--                New_Var_Decl (Var_Res, Wki_Res, O_Storage_Local,
+--                              Tinfo.Ortho_Type (Mode_Value));
+--             end if;
+
+--             --  Lock the object.
+--             Start_Association (Constr, Ghdl_Protected_Enter);
+--             New_Association
+--              (Constr, New_Convert_Ov (New_Value (Prot_Obj), Ghdl_Ptr_Type));
+--             New_Procedure_Call (Constr);
+
+--             --  Call the unprotected method
+--             Start_Association (Constr, Info.Ortho_Func);
+--             Add_Subprg_Instance_Assoc (Constr, Inst_Data);
+--             New_Association (Constr, New_Value (Prot_Obj));
+--             Inter := Get_Interface_Declaration_Chain (Spec);
+--             while Inter /= Null_Iir loop
+--                Inter_Info := Get_Info (Inter);
+--                if Inter_Info.Interface_Type /= O_Tnode_Null then
+--                   New_Association
+--                     (Constr, New_Value (Inter_Info.Interface_Protected));
+--                end if;
+--                Inter := Get_Chain (Inter);
+--             end loop;
+--             if Is_Func then
+--                New_Assign_Stmt (Var_Res, New_Function_Call (Constr));
+--             else
+--                New_Procedure_Call (Constr);
+--             end if;
+
+--             --  Unlock the object.
+--             Start_Association (Constr, Ghdl_Protected_Leave);
+--             New_Association
+--              (Constr, New_Convert_Ov (New_Value (Prot_Obj), Ghdl_Ptr_Type));
+--             New_Procedure_Call (Constr);
+
+--             if Is_Func then
+--                New_Return_Stmt (New_Value (Var_Res));
+--             end if;
+--             Finish_Subprg_Instance_Use (Inst_Data);
+--             Finish_Subprogram_Body;
+--          end if;
+
+--          Pop_Identifier_Prefix (Mark);
+--       end Translate_Protected_Subprogram_Declaration;
+
+      procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration)
+      is
+         Info : Ortho_Info_Acc;
+         I_List : O_Inter_List;
+         --Storage : O_Storage;
+      begin
+         Chap4.Translate_Declaration_Chain (Decl);
+         Chap4.Translate_Declaration_Chain_Subprograms (Decl, Null_Iir);
+
+--          if Chap10.Global_Storage = O_Storage_Public
+--            and then not Get_Need_Body (Decl)
+--          then
+--             Storage := O_Storage_Public;
+--          else
+--             Storage := O_Storage_External;
+--          end if;
+
+         Info := Add_Info (Decl, Kind_Package);
+
+         Start_Procedure_Decl
+           (I_List, Create_Identifier ("ELAB_SPEC"), Global_Storage);
+         Finish_Subprogram_Decl (I_List, Info.Package_Elab_Spec_Subprg);
+
+         Start_Procedure_Decl
+           (I_List, Create_Identifier ("ELAB_BODY"), Global_Storage);
+         Finish_Subprogram_Decl (I_List, Info.Package_Elab_Body_Subprg);
+
+         New_Var_Decl (Info.Package_Elab_Var, Create_Identifier ("ELABORATED"),
+                       Chap10.Global_Storage, Ghdl_Bool_Type);
+
+         if Flag_Rti then
+            Rtis.Generate_Unit (Decl);
+         end if;
+
+         if Global_Storage = O_Storage_Public then
+            --  Generate RTI.
+            Elab_Package (Decl);
+         end if;
+         Save_Local_Identifier (Info.Package_Local_Id);
+      end Translate_Package_Declaration;
+
+      procedure Translate_Package_Body (Decl : Iir_Package_Body)
+      is
+         Pkg : Iir_Package_Declaration;
+      begin
+         --  May be called during elaboration to generate RTI.
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         if Flag_Rti then
+            Rtis.Generate_Unit (Decl);
+         end if;
+
+         Pkg := Get_Package (Decl);
+         Restore_Local_Identifier (Get_Info (Pkg).Package_Local_Id);
+         Chap4.Translate_Declaration_Chain (Decl);
+         Chap4.Translate_Declaration_Chain_Subprograms (Decl, Null_Iir);
+         Elab_Package_Body (Pkg, Decl);
+      end Translate_Package_Body;
+
+      procedure Elab_Package (Spec : Iir_Package_Declaration)
+      is
+         Info : Ortho_Info_Acc;
+         Final : Boolean;
+      begin
+         Info := Get_Info (Spec);
+         Start_Subprogram_Body (Info.Package_Elab_Spec_Subprg);
+         Push_Local_Factory;
+
+         Elab_Dependence (Get_Design_Unit (Spec));
+         Chap4.Elab_Declaration_Chain (Spec, Final);
+
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+      end Elab_Package;
+
+      procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir)
+      is
+         Info : Ortho_Info_Acc;
+         If_Blk : O_If_Block;
+         Constr : O_Assoc_List;
+         Final : Boolean;
+      begin
+         Info := Get_Info (Spec);
+         Start_Subprogram_Body (Info.Package_Elab_Body_Subprg);
+         Push_Local_Factory;
+
+         --  If the package was already elaborated, return now,
+         --  else mark the package as elaborated.
+         Start_If_Stmt (If_Blk, New_Obj_Value (Info.Package_Elab_Var));
+         New_Return_Stmt;
+         New_Else_Stmt (If_Blk);
+         New_Assign_Stmt (New_Obj (Info.Package_Elab_Var),
+                          New_Lit (Ghdl_Bool_True_Node));
+         Finish_If_Stmt (If_Blk);
+
+         --  Elab Spec.
+         Start_Association (Constr, Info.Package_Elab_Spec_Subprg);
+         New_Procedure_Call (Constr);
+
+         if Bod /= Null_Iir then
+            Elab_Dependence (Get_Design_Unit (Bod));
+            Chap4.Elab_Declaration_Chain (Bod, Final);
+         end if;
+
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+      end Elab_Package_Body;
+
+      procedure Elab_Dependence (Design_Unit: Iir_Design_Unit)
+      is
+         Depend_List: Iir_Design_Unit_List;
+         Design: Iir;
+         Library_Unit: Iir;
+         Info : Ortho_Info_Acc;
+         If_Blk : O_If_Block;
+         Constr : O_Assoc_List;
+      begin
+         Depend_List := Get_Dependence_List (Design_Unit);
+
+         for I in Natural loop
+            Design := Get_Nth_Element (Depend_List, I);
+            exit when Design = Null_Iir;
+            if Get_Kind (Design) = Iir_Kind_Design_Unit then
+               Library_Unit := Get_Library_Unit (Design);
+               case Get_Kind (Library_Unit) is
+                  when Iir_Kind_Package_Declaration =>
+                     if Library_Unit /= Standard_Package then
+                        Info := Get_Info (Library_Unit);
+                        Start_If_Stmt
+                          (If_Blk, New_Monadic_Op
+                           (ON_Not, New_Obj_Value (Info.Package_Elab_Var)));
+                        -- Elaborates only non-elaborated packages.
+                        Start_Association (Constr,
+                                           Info.Package_Elab_Body_Subprg);
+                        New_Procedure_Call (Constr);
+                        Finish_If_Stmt (If_Blk);
+                     end if;
+                  when Iir_Kind_Entity_Declaration =>
+                     --  FIXME: architecture already elaborates its entity.
+                     null;
+                  when Iir_Kind_Configuration_Declaration =>
+                     null;
+                  when Iir_Kind_Architecture_Declaration =>
+                     null;
+                  when others =>
+                     Error_Kind ("elab_dependence", Library_Unit);
+               end case;
+            end if;
+         end loop;
+      end Elab_Dependence;
+
+      procedure Push_Subprg_Instance (Decl_Type : O_Tnode;
+                                      Ptr_Type : O_Tnode;
+                                      Ident : O_Ident)
+      is
+         El : Subprg_Instance_Stack;
+      begin
+         if Subprg_Instance_Unused /= null then
+            El := Subprg_Instance_Unused;
+            Subprg_Instance_Unused := El.Next;
+         else
+            El := new Subprg_Instance_Type;
+         end if;
+         El.all := (Decl_Type => Decl_Type,
+                    Ptr_Type => Ptr_Type,
+                    Ident => Ident,
+                    Next => null,
+                    Prev => Subprg_Instance_Last);
+         if Subprg_Instance_First = null then
+            Subprg_Instance_First := El;
+         else
+            Subprg_Instance_Last.Next := El;
+         end if;
+         Subprg_Instance_Last := El;
+      end Push_Subprg_Instance;
+
+      procedure Pop_Subprg_Instance (Ident : O_Ident)
+      is
+         El : Subprg_Instance_Stack;
+      begin
+         El := Subprg_Instance_Last;
+         if El = null or else not Is_Equal (El.Ident, Ident) then
+            --  POP does not match with a push.
+            raise Internal_Error;
+         end if;
+         Subprg_Instance_Last := El.Prev;
+         if El.Prev = null then
+            Subprg_Instance_First := null;
+         else
+            El.Prev.Next := null;
+         end if;
+         El.Next := Subprg_Instance_Unused;
+         Subprg_Instance_Unused := El;
+      end Pop_Subprg_Instance;
+
+      procedure Save_Subprg_Instance (Stack : out Subprg_Instance_Stack)
+      is
+      begin
+         Stack := Subprg_Instance_First;
+         if Stack /= null then
+            if Stack.Prev /= null then
+               raise Internal_Error;
+            end if;
+            Stack.Prev := Subprg_Instance_Last;
+         end if;
+         Subprg_Instance_First := null;
+         Subprg_Instance_Last := null;
+      end Save_Subprg_Instance;
+
+      procedure Restore_Subprg_Instance (Stack : Subprg_Instance_Stack)
+      is
+      begin
+         if Subprg_Instance_First /= null then
+            --  Not matching with a save.
+            raise Internal_Error;
+         end if;
+         Subprg_Instance_First := Stack;
+         if Stack /= null then
+            Subprg_Instance_Last := Stack.Prev;
+            Stack.Prev := null;
+         end if;
+      end Restore_Subprg_Instance;
+
+      procedure Add_Subprg_Instance_Interfaces
+        (Interfaces : in out O_Inter_List; Vars : out Subprg_Instance_Array)
+      is
+         El : Subprg_Instance_Stack;
+         I : Natural;
+      begin
+         El := Subprg_Instance_First;
+         I := Vars'First;
+         while El /= null loop
+            Vars (I).Inst_Type := El.Decl_Type;
+            Vars (I).Inter_Type := El.Ptr_Type;
+            New_Interface_Decl
+              (Interfaces, Vars (I).Inter, El.Ident, El.Ptr_Type);
+            I := I + 1;
+            El := El.Next;
+         end loop;
+         Vars (I .. Vars'Last) := (others => Null_Subprg_Instance_El);
+      end Add_Subprg_Instance_Interfaces;
+
+      procedure Add_Subprg_Instance_Assoc
+        (Assocs : in out O_Assoc_List; Vars : Subprg_Instance_Array)
+      is
+         Val : O_Enode;
+      begin
+         for I in Vars'Range loop
+            exit when Vars (I).Inter = O_Dnode_Null;
+            Val := New_Address (Get_Instance_Ref (Vars (I).Inst_Type),
+                                Vars (I).Inter_Type);
+            New_Association (Assocs, Val);
+         end loop;
+      end Add_Subprg_Instance_Assoc;
+
+      procedure Add_Subprg_Instance_Assoc
+        (Assocs : in out O_Assoc_List;
+         Vars : Subprg_Instance_Array;
+         Inst1_Type : O_Tnode;
+         Inst1_Val : O_Enode)
+      is
+         Val : O_Enode;
+      begin
+         for I in Vars'Range loop
+            exit when Vars (I).Inter = O_Dnode_Null;
+            if Vars (I).Inst_Type = Inst1_Type then
+               Val := Inst1_Val;
+            else
+               Val := New_Address (Get_Instance_Ref (Vars (I).Inst_Type),
+                                   Vars (I).Inter_Type);
+            end if;
+            New_Association (Assocs, Val);
+         end loop;
+      end Add_Subprg_Instance_Assoc;
+
+      procedure Start_Subprg_Instance_Use (Vars : Subprg_Instance_Array)
+      is
+      begin
+         for I in Vars'Range loop
+            exit when Vars (I).Inter = O_Dnode_Null;
+            Push_Scope (Vars (I).Inst_Type, Vars (I).Inter);
+         end loop;
+      end Start_Subprg_Instance_Use;
+
+      procedure Finish_Subprg_Instance_Use (Vars : Subprg_Instance_Array)
+      is
+      begin
+         for I in reverse Vars'Range loop
+            if Vars (I).Inter /= O_Dnode_Null then
+               Pop_Scope (Vars (I).Inst_Type);
+            end if;
+         end loop;
+      end Finish_Subprg_Instance_Use;
+
+      procedure Create_Subprg_Instance (Interfaces : in out O_Inter_List;
+                                        Subprg : Iir)
+      is
+      begin
+         Add_Subprg_Instance_Interfaces
+           (Interfaces, Get_Info (Subprg).Subprg_Instance);
+      end Create_Subprg_Instance;
+
+      procedure Start_Subprg_Instance_Use (Subprg : Iir) is
+      begin
+         Start_Subprg_Instance_Use (Get_Info (Subprg).Subprg_Instance);
+      end Start_Subprg_Instance_Use;
+
+      procedure Finish_Subprg_Instance_Use (Subprg : Iir) is
+      begin
+         Finish_Subprg_Instance_Use (Get_Info (Subprg).Subprg_Instance);
+      end Finish_Subprg_Instance_Use;
+   end Chap2;
+
+   package body Chap3 is
+      function Create_Static_Type_Definition_Type_Range (Def : Iir)
+        return O_Cnode;
+      procedure Create_Scalar_Type_Range (Def : Iir; Target : O_Lnode);
+
+      --  Finish a type definition: declare the type, define and declare a
+      --   pointer to the type.
+      procedure Finish_Type_Definition
+        (Info : Type_Info_Acc; Completion : Boolean := False)
+      is
+      begin
+         --  Declare the type.
+         if not Completion then
+            New_Type_Decl (Create_Identifier, Info.Ortho_Type (Mode_Value));
+         end if;
+
+         --  Create an access to the type and declare it.
+         Info.Ortho_Ptr_Type (Mode_Value) :=
+           New_Access_Type (Info.Ortho_Type (Mode_Value));
+         New_Type_Decl (Create_Identifier ("PTR"),
+                        Info.Ortho_Ptr_Type (Mode_Value));
+
+         --  Signal type.
+         if Info.Type_Mode in Type_Mode_Scalar then
+            Info.Ortho_Type (Mode_Signal) :=
+              New_Access_Type (Info.Ortho_Type (Mode_Value));
+         end if;
+         if Info.Ortho_Type (Mode_Signal) /= O_Tnode_Null then
+            New_Type_Decl (Create_Identifier ("SIG"),
+                           Info.Ortho_Type (Mode_Signal));
+         end if;
+
+         --  Signal pointer type.
+         if Info.Type_Mode in Type_Mode_Composite
+           and then Info.Ortho_Type (Mode_Signal) /= O_Tnode_Null
+         then
+            Info.Ortho_Ptr_Type (Mode_Signal) :=
+              New_Access_Type (Info.Ortho_Type (Mode_Signal));
+            New_Type_Decl (Create_Identifier ("SIGPTR"),
+                           Info.Ortho_Ptr_Type (Mode_Signal));
+         else
+            Info.Ortho_Ptr_Type (Mode_Signal) := O_Tnode_Null;
+         end if;
+      end Finish_Type_Definition;
+
+      procedure Create_Size_Var (Def : Iir)
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Def);
+         Info.C := new Complex_Type_Info;
+         Info.C.Size_Var (Mode_Value) := Create_Var
+           (Create_Var_Identifier ("SIZE"), Ghdl_Index_Type);
+         if Get_Signal_Type_Flag (Def) then
+            Info.C.Size_Var (Mode_Signal) := 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;
+         Start_Function_Decl
+           (Interface_List, Ident, Global_Storage, Char_Ptr_Type);
+         Chap2.Add_Subprg_Instance_Interfaces
+           (Interface_List, Info.C.Builder_Instance (Kind));
+         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.Builder_Base_Param (Kind),
+            Get_Identifier ("base_ptr"), Ptype);
+         --  Add parameter for array bounds.
+         if Info.Type_Mode in Type_Mode_Arrays then
+            New_Interface_Decl
+              (Interface_List, Info.C.Builder_Bound_Param (Kind),
+               Get_Identifier ("bound"), Info.T.Bounds_Ptr_Type);
+         end if;
+         Finish_Subprogram_Decl (Interface_List, Info.C.Builder_Func (Kind));
+      end Create_Builder_Subprogram_Decl;
+
+      function Gen_Call_Type_Builder (Var_Ptr : O_Dnode;
+                                      Var_Type : Iir;
+                                      Kind : Object_Kind_Type)
+        return O_Enode
+      is
+         Tinfo : Type_Info_Acc;
+         Binfo : Type_Info_Acc;
+         Assoc : O_Assoc_List;
+      begin
+         Tinfo := Get_Info (Var_Type);
+         --  Build the field
+         Binfo := Get_Info (Get_Base_Type (Var_Type));
+         Start_Association (Assoc, Binfo.C.Builder_Func (Kind));
+         Chap2.Add_Subprg_Instance_Assoc
+           (Assoc, Binfo.C.Builder_Instance (Kind));
+         case Tinfo.Type_Mode is
+            when Type_Mode_Record
+              | Type_Mode_Array =>
+               New_Association (Assoc, New_Obj_Value (Var_Ptr));
+            when Type_Mode_Ptr_Array =>
+               --New_Association (Assoc, New_Value (New_Acc_Value (Var_Ptr)));
+               New_Association (Assoc, New_Obj_Value (Var_Ptr));
+            when Type_Mode_Fat_Array =>
+               --  Note: a fat array can only be at the top of a complex type;
+               --  the bounds must have been set.
+               New_Association
+                 (Assoc, New_Value_Selected_Acc_Value
+                  (New_Obj (Var_Ptr), Tinfo.T.Base_Field (Kind)));
+            when others =>
+               raise Internal_Error;
+         end case;
+         case Tinfo.Type_Mode is
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               New_Association
+                 (Assoc,
+                  Get_Array_Bounds_Ptr (O_Lnode_Null, Var_Type, Kind));
+            when Type_Mode_Fat_Array =>
+               New_Association
+                 (Assoc, Get_Array_Ptr_Bounds_Ptr (New_Obj (Var_Ptr),
+                                                   Var_Type, Kind));
+            when Type_Mode_Record =>
+               null;
+            when others =>
+               raise Internal_Error;
+         end case;
+         return New_Function_Call (Assoc);
+      end Gen_Call_Type_Builder;
+
+      procedure Gen_Call_Type_Builder (Var : Mnode; Var_Type : Iir)
+      is
+         Mem : O_Dnode;
+         V : Mnode;
+      begin
+         Open_Temp;
+         V := Stabilize (Var);
+         Mem := Create_Temp (Char_Ptr_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;
+
+      procedure Builder_Update_Field
+        (Field_Type : Iir; Mem : O_Dnode; Kind : Object_Kind_Type)
+      is
+         Tinfo : Type_Info_Acc;
+         Var_Ptr : O_Dnode;
+      begin
+         Tinfo := Get_Info (Field_Type);
+         if Tinfo.C /= null then
+            if Tinfo.C.Builder_Need_Func then
+               --  This is a complex type.
+               Start_Declare_Stmt;
+               New_Var_Decl (Var_Ptr, Get_Identifier ("var_ptr"),
+                             O_Storage_Local, Tinfo.Ortho_Ptr_Type (Kind));
+
+               --  Allocate memory.
+               --  Set the field with mem.
+               --  FIXME: alignment ???
+               New_Assign_Stmt
+                 (New_Obj (Var_Ptr),
+                  New_Convert_Ov (New_Obj_Value (Mem),
+                                  Tinfo.Ortho_Ptr_Type (Kind)));
+               New_Assign_Stmt (Get_Field_Lnode, New_Obj_Value (Var_Ptr));
+
+               --  Build second/third-order complex type.
+               New_Assign_Stmt
+                 (New_Obj (Mem),
+                  Gen_Call_Type_Builder (Var_Ptr, Field_Type, Kind));
+
+               Finish_Declare_Stmt;
+            else
+               --  Allocate memory.
+               New_Assign_Stmt (Get_Field_Lnode,
+                                New_Convert_Ov (New_Obj_Value (Mem),
+                                                Tinfo.Ortho_Ptr_Type (Kind)));
+               --  Allocate memory for first order complex type.
+               New_Assign_Stmt
+                 (New_Obj (Mem),
+                  New_Address
+                  (New_Slice (New_Acc_Value (New_Obj (Mem)),
+                              Chararray_Type,
+                              New_Value (Get_Var (Tinfo.C.Size_Var (Kind)))),
+                   Char_Ptr_Type));
+            end if;
+         end if;
+      end Builder_Update_Field;
+
+      ------------------
+      --  Enumeration --
+      ------------------
+      function Translate_Enumeration_Literal (Lit : Iir_Enumeration_Literal)
+        return O_Ident
+      is
+         El_Str : String (1 .. 4);
+         Id : Name_Id;
+         N : Integer;
+         C : Character;
+      begin
+         Id := Get_Identifier (Lit);
+         if Name_Table.Is_Character (Id) then
+            C := Name_Table.Get_Character (Id);
+            El_Str (1) := 'C';
+            case C is
+               when 'A' .. 'Z'
+                 | 'a' .. 'z'
+                 | '0' .. '9' =>
+                  El_Str (2) := '_';
+                  El_Str (3) := C;
+               when others =>
+                  N := Character'Pos (Name_Table.Get_Character (Id));
+                  El_Str (2) := N2hex (N / 16);
+                  El_Str (3) := N2hex (N mod 16);
+            end case;
+            return Get_Identifier (El_Str (1 .. 3));
+         else
+            return Create_Identifier_Without_Prefix (Lit);
+         end if;
+      end Translate_Enumeration_Literal;
+
+      procedure Translate_Enumeration_Type
+        (Def : Iir_Enumeration_Type_Definition)
+      is
+         El_List : Iir_List;
+         El : Iir_Enumeration_Literal;
+         Constr : O_Enum_List;
+         Lit_Name : O_Ident;
+         Val : O_Cnode;
+         Info : Type_Info_Acc;
+         Nbr : Natural;
+         Size : Natural;
+      begin
+         El_List := Get_Enumeration_Literal_List (Def);
+         Nbr := Get_Nbr_Elements (El_List);
+         if Nbr <= 256 then
+            Size := 8;
+         else
+            Size := 32;
+         end if;
+         Start_Enum_Type (Constr, Size);
+         for I in Natural loop
+            El := Get_Nth_Element (El_List, I);
+            exit when El = Null_Iir;
+
+            Lit_Name := Translate_Enumeration_Literal (El);
+            New_Enum_Literal (Constr, Lit_Name, Val);
+            Set_Ortho_Expr (El, Val);
+         end loop;
+         Info := Get_Info (Def);
+         Finish_Enum_Type (Constr, Info.Ortho_Type (Mode_Value));
+         if Nbr <= 256 then
+            Info.Type_Mode := Type_Mode_E8;
+         else
+            Info.Type_Mode := Type_Mode_E32;
+         end if;
+         --  Enumerations are always in their range.
+         Info.T.Nocheck_Low := True;
+         Info.T.Nocheck_Hi := True;
+         Finish_Type_Definition (Info);
+      end Translate_Enumeration_Type;
+
+      procedure Translate_Bool_Type (Def : Iir_Enumeration_Type_Definition)
+      is
+         Info : Type_Info_Acc;
+         El_List : Iir_List;
+         True_Lit, False_Lit : Iir_Enumeration_Literal;
+         False_Node, True_Node : O_Cnode;
+      begin
+         Info := Get_Info (Def);
+         El_List := Get_Enumeration_Literal_List (Def);
+         if Get_Nbr_Elements (El_List) /= 2 then
+            raise Internal_Error;
+         end if;
+         False_Lit := Get_Nth_Element (El_List, 0);
+         True_Lit := Get_Nth_Element (El_List, 1);
+         New_Boolean_Type
+           (Info.Ortho_Type (Mode_Value),
+            Translate_Enumeration_Literal (False_Lit), False_Node,
+            Translate_Enumeration_Literal (True_Lit), True_Node);
+         Info.Type_Mode := Type_Mode_B2;
+         Set_Ortho_Expr (False_Lit, False_Node);
+         Set_Ortho_Expr (True_Lit, True_Node);
+         Info.T.Nocheck_Low := True;
+         Info.T.Nocheck_Hi := True;
+         Finish_Type_Definition (Info);
+      end Translate_Bool_Type;
+
+      ---------------
+      --  Integer  --
+      ---------------
+      --  Return the number of bits (32 or 64) required to represent the
+      --  (integer or physical) type definition DEF.
+      type Type_Precision is (Precision_32, Precision_64);
+      function Get_Type_Precision (Def : Iir) return Type_Precision
+      is
+         St : Iir;
+         L, H : Iir;
+         Lv, Hv : Iir_Int64;
+      begin
+         St := Get_Subtype_Definition (Get_Type_Declarator (Def));
+         Get_Low_High_Limit (Get_Range_Constraint (St), L, H);
+         Lv := Get_Value (L);
+         Hv := Get_Value (H);
+         if Lv >= -(2 ** 31) and then Hv <= (2 ** 31 - 1) then
+            return Precision_32;
+         else
+            if Flag_Only_32b then
+               Error_Msg_Sem
+                 ("range of " & Disp_Node (Get_Type_Declarator (St))
+                  & " is too large", St);
+               return Precision_32;
+            end if;
+            return Precision_64;
+         end if;
+      end Get_Type_Precision;
+
+      procedure Translate_Integer_Type
+        (Def : Iir_Integer_Type_Definition)
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Def);
+         case Get_Type_Precision (Def) is
+            when Precision_32 =>
+               Info.Ortho_Type (Mode_Value) := New_Signed_Type (32);
+               Info.Type_Mode := Type_Mode_I32;
+            when Precision_64 =>
+               Info.Ortho_Type (Mode_Value) := New_Signed_Type (64);
+               Info.Type_Mode := Type_Mode_I64;
+         end case;
+         --  Integers are always in their ranges.
+         Info.T.Nocheck_Low := True;
+         Info.T.Nocheck_Hi := True;
+
+         Finish_Type_Definition (Info);
+      end Translate_Integer_Type;
+
+      ----------------------
+      --  Floating types  --
+      ----------------------
+      procedure Translate_Floating_Type (Def : Iir_Floating_Type_Definition)
+      is
+         Info : Type_Info_Acc;
+      begin
+         --  FIXME: should check precision
+         Info := Get_Info (Def);
+         Info.Type_Mode := Type_Mode_F64;
+         Info.Ortho_Type (Mode_Value) := New_Float_Type;
+         --  Reals are always in their ranges.
+         Info.T.Nocheck_Low := True;
+         Info.T.Nocheck_Hi := True;
+
+         Finish_Type_Definition (Info);
+      end Translate_Floating_Type;
+
+      ----------------
+      --  Physical  --
+      ----------------
+      procedure Translate_Physical_Type (Def : Iir_Physical_Type_Definition)
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Def);
+         case Get_Type_Precision (Def) is
+            when Precision_32 =>
+               Info.Ortho_Type (Mode_Value) := New_Signed_Type (32);
+               Info.Type_Mode := Type_Mode_P32;
+            when Precision_64 =>
+               Info.Ortho_Type (Mode_Value) := New_Signed_Type (64);
+               Info.Type_Mode := Type_Mode_P64;
+         end case;
+         --  Phyiscals are always in their ranges.
+         Info.T.Nocheck_Low := True;
+         Info.T.Nocheck_Hi := True;
+
+         Finish_Type_Definition (Info);
+      end Translate_Physical_Type;
+
+      procedure Translate_Physical_Units (Def : Iir_Physical_Type_Definition)
+      is
+         Unit : Iir;
+         Info : Object_Info_Acc;
+         Phy_Type : O_Tnode;
+      begin
+         Phy_Type := Get_Ortho_Type (Def, Mode_Value);
+         Unit := Get_Unit_Chain (Def);
+         while Unit /= Null_Iir loop
+            Info := Add_Info (Unit, Kind_Object);
+            Info.Object_Var := Create_Var (Create_Var_Identifier (Unit),
+                                           Phy_Type);
+            Unit := Get_Chain (Unit);
+         end loop;
+      end Translate_Physical_Units;
+
+      ------------
+      --  File  --
+      ------------
+      procedure Translate_File_Type (Def : Iir_File_Type_Definition)
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Def);
+         Info.Ortho_Type (Mode_Value) := Ghdl_File_Index_Type;
+         Info.Ortho_Ptr_Type (Mode_Value) := Ghdl_File_Index_Ptr_Type;
+         Info.Type_Mode := Type_Mode_File;
+      end Translate_File_Type;
+
+      function Get_File_Signature_Length (Def : Iir) return Natural
+      is
+      begin
+         case Get_Kind (Def) is
+            when Iir_Kinds_Scalar_Type_Definition =>
+               return 1;
+            when Iir_Kind_Array_Type_Definition
+              | Iir_Kind_Array_Subtype_Definition
+              | Iir_Kind_Unconstrained_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;
+               begin
+                  Res := 2;
+                  El := Get_Element_Declaration_Chain (Get_Base_Type (Def));
+                  while El /= Null_Iir loop
+                     Res := Res + Get_File_Signature_Length (Get_Type (El));
+                     El := Get_Chain (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
+              | Iir_Kind_Unconstrained_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;
+               begin
+                  Res (Off) := '<';
+                  Off := Off + 1;
+                  El := Get_Element_Declaration_Chain (Get_Base_Type (Def));
+                  while El /= Null_Iir loop
+                     Get_File_Signature (Get_Type (El), Res, Off);
+                     El := Get_Chain (El);
+                  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 : Iir;
+         Info : Type_Info_Acc;
+      begin
+         Type_Name := Get_Type_Mark (Def);
+         if Get_Kind (Type_Name) in Iir_Kinds_Scalar_Type_Definition then
+            return;
+         end if;
+         declare
+            Len : Natural := Get_File_Signature_Length (Type_Name);
+            Sig : String (1 .. Len + 2);
+            Off : Natural := 1;
+         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_Signal_Type_Flag (Def) then
+            return Mode_Signal;
+         else
+            return Mode_Value;
+         end if;
+      end Type_To_Last_Object_Kind;
+
+      procedure Create_Array_Fat_Pointer
+        (Info : Type_Info_Acc; Kind : Object_Kind_Type)
+      is
+         Constr : O_Element_List;
+      begin
+         Start_Record_Type (Constr);
+         New_Record_Field
+           (Constr, Info.T.Base_Field (Kind), Get_Identifier ("BASE"),
+            Info.T.Base_Ptr_Type (Kind));
+         New_Record_Field
+           (Constr, Info.T.Bounds_Field (Kind), Get_Identifier ("BOUNDS"),
+            Info.T.Bounds_Ptr_Type);
+         Finish_Record_Type (Constr, Info.Ortho_Type (Kind));
+      end Create_Array_Fat_Pointer;
+
+      procedure Translate_Incomplete_Array_Type
+        (Def : Iir_Array_Type_Definition)
+      is
+         Arr_Info : Incomplete_Type_Info_Acc;
+         Info : Type_Info_Acc;
+      begin
+         Arr_Info := Get_Info (Def);
+         if Arr_Info.Incomplete_Array /= null then
+            --  This (incomplete) array type was already translated.
+            --  This is the case for a second access type definition to this
+            --   still incomplete array type.
+            return;
+         end if;
+         Info := new Ortho_Info_Type (Kind_Type);
+         Info.Type_Mode := Type_Mode_Fat_Array;
+         Info.Type_Incomplete := True;
+         Arr_Info.Incomplete_Array := Info;
+
+         Info.T := Ortho_Info_Type_Array_Init;
+         Info.T.Bounds_Type := O_Tnode_Null;
+
+         Info.T.Bounds_Ptr_Type := New_Access_Type (Info.T.Bounds_Type);
+         New_Type_Decl (Create_Identifier ("BOUNDP"),
+                        Info.T.Bounds_Ptr_Type);
+
+         Info.T.Base_Ptr_Type (Mode_Value) := New_Access_Type (O_Tnode_Null);
+         New_Type_Decl (Create_Identifier ("BASEP"),
+                        Info.T.Base_Ptr_Type (Mode_Value));
+
+         Create_Array_Fat_Pointer (Info, Mode_Value);
+
+         New_Type_Decl
+           (Create_Identifier, Info.Ortho_Type (Mode_Value));
+      end Translate_Incomplete_Array_Type;
+
+      procedure Translate_Array_Type_Bounds
+        (Def : Iir_Array_Type_Definition;
+         Info : Type_Info_Acc;
+         Complete : Boolean)
+      is
+         Constr : O_Element_List;
+         Dim : String (1 .. 8);
+         N : Natural;
+         P : Natural;
+         Index_List : Iir_List;
+         Index : Iir;
+         Mark : Id_Mark_Type;
+      begin
+         Start_Record_Type (Constr);
+         Index_List := Get_Index_Subtype_List (Def);
+         Info.T.Bounds_Vector :=
+           new O_Fnode_Arr (1 .. Get_Nbr_Elements (Index_List));
+         for I in Natural loop
+            Index := Get_Nth_Element (Index_List, I);
+            exit when Index = Null_Iir;
+            if Get_Info (Index) = null then
+               Push_Identifier_Prefix (Mark, "DIM", Iir_Int32 (I + 1));
+               Translate_Type_Definition (Index, True);
+               Pop_Identifier_Prefix (Mark);
+            end if;
+            N := I + 1;
+            P := Dim'Last;
+            loop
+               Dim (P) := Character'Val (Character'Pos ('0') + N mod 10);
+               P := P - 1;
+               N := N / 10;
+               exit when N = 0;
+            end loop;
+            P := P - 3;
+            Dim (P .. P + 3) := "dim_";
+            New_Record_Field (Constr, Info.T.Bounds_Vector (I + 1),
+                              Get_Identifier (Dim (P .. Dim'Last)),
+                              Get_Info (Get_Base_Type (Index)).T.Range_Type);
+         end loop;
+         Finish_Record_Type (Constr, Info.T.Bounds_Type);
+         New_Type_Decl (Create_Identifier ("BOUND"),
+                        Info.T.Bounds_Type);
+         if Complete then
+            Finish_Access_Type (Info.T.Bounds_Ptr_Type, Info.T.Bounds_Type);
+         else
+            Info.T.Bounds_Ptr_Type := New_Access_Type (Info.T.Bounds_Type);
+            New_Type_Decl (Create_Identifier ("BOUNDP"),
+                           Info.T.Bounds_Ptr_Type);
+         end if;
+      end Translate_Array_Type_Bounds;
+
+      procedure Translate_Array_Type_Base
+        (Def : Iir_Array_Type_Definition;
+         Info : Type_Info_Acc;
+         Complete : Boolean)
+      is
+         El_Type : Iir;
+         El_Tinfo : Type_Info_Acc;
+         Id, Idptr : O_Ident;
+      begin
+         El_Type := Get_Element_Subtype (Def);
+         Translate_Type_Definition (El_Type, True);
+         El_Tinfo := Get_Info (El_Type);
+         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 (Chap4.Get_Element_Type (El_Tinfo, 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 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 : Iir_List;
+         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
+         Indexes := Get_Index_Subtype_List (Def);
+         if Get_Nbr_Elements (Indexes) /= 1 then
+            return;
+         end if;
+         Index_Type := Get_First_Element (Indexes);
+         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, New_Unsigned_Literal (Ghdl_Index_Type, 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_Array_Type (Def : Iir_Array_Type_Definition)
+      is
+         Info : Type_Info_Acc;
+         El_Tinfo : Type_Info_Acc;
+         --  If true, INFO was already partially filled, by a previous access
+         --  type definition to this incomplete array type.
+         Completion : Boolean;
+      begin
+         Info := Get_Info (Def);
+         Completion := Info.Type_Mode = Type_Mode_Fat_Array;
+         if not Completion then
+            Info.Type_Mode := Type_Mode_Fat_Array;
+            Info.T := Ortho_Info_Type_Array_Init;
+         end if;
+         Translate_Array_Type_Base (Def, Info, Completion);
+         Translate_Array_Type_Bounds (Def, Info, Completion);
+         Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
+         if not Completion then
+            Create_Array_Fat_Pointer (Info, Mode_Value);
+         end if;
+         if Get_Signal_Type_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 El_Tinfo.C /= null then
+            --  This is a complex type.
+            Info.C := new Complex_Type_Info;
+            --  No size variable for unconstrained array type.
+            Info.C.Size_Var (Mode_Value) := null;
+            Info.C.Size_Var (Mode_Signal) := null;
+            Info.C.Builder_Need_Func := True;
+         end if;
+         Info.Type_Incomplete := False;
+      end Translate_Array_Type;
+
+      --  Get the length of DEF, ie the number of elements.
+      --  If the length is not statically defined, returns -1.
+      function Get_Array_Subtype_Length (Def : Iir_Array_Subtype_Definition)
+        return Iir_Int64
+      is
+         Index_List : Iir_List;
+         Index : Iir;
+         Len : Iir_Int64;
+      begin
+         Index_List := Get_Index_Subtype_List (Def);
+         --  Check if the bounds of the array are locally static.
+         Len := 1;
+         for I in Natural loop
+            Index := Get_Nth_Element (Index_List, I);
+            exit when Index = Null_Iir;
+            if Get_Type_Staticness (Index) /= Locally then
+               return -1;
+            end if;
+            Len := Len * Eval_Discrete_Type_Length (Index);
+         end loop;
+         return Len;
+      end Get_Array_Subtype_Length;
+
+      procedure Translate_Array_Subtype (Def : Iir_Array_Subtype_Definition)
+      is
+         Info : Type_Info_Acc;
+         Binfo : Type_Info_Acc;
+         Len : Iir_Int64;
+         Ptr : O_Tnode;
+         Id : O_Ident;
+      begin
+         Info := Get_Info (Def);
+         Binfo := Get_Info (Get_Base_Type (Def));
+         Len := Get_Array_Subtype_Length (Def);
+         if Len < 0 then
+            --  Length of the array is not known at compile time.
+            Info.Type_Mode := Type_Mode_Ptr_Array;
+            Info.Ortho_Type := Binfo.T.Base_Ptr_Type;
+            Info.Ortho_Ptr_Type := Binfo.T.Base_Ptr_Type;
+         else
+            --  Length is known.  Create a constrained array.
+            Info.Type_Mode := Type_Mode_Array;
+            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));
+               --Ptr := New_Access_Type (Info.Ortho_Type);
+               --New_Type_Decl (Create_Identifier (Name, "_ARGT"), Ptr);
+               Ptr := Binfo.T.Base_Ptr_Type (I);
+               Info.Ortho_Ptr_Type (I) := Ptr;
+            end loop;
+         end if;
+
+         --  Create a size variable if the length is not known or if
+         --  the element size is not known at compile-time.
+         if Binfo.C /= null then
+            --  The base type is a complex type, so is the type.
+            Create_Size_Var (Def);
+            Info.C.Builder_Need_Func := True;
+         elsif Len < 0 then
+            --  This may creates complex types.
+            Create_Size_Var (Def);
+            Info.C.Builder_Need_Func := False;
+         end if;
+      end Translate_Array_Subtype;
+
+      function Create_Static_Array_Subtype_Bounds
+        (Def : Iir_Array_Subtype_Definition)
+        return O_Cnode
+      is
+         Index_List : Iir_List;
+         Index : Iir;
+         List : O_Record_Aggr_List;
+         Res : O_Cnode;
+         Baseinfo : Type_Info_Acc;
+      begin
+         Index_List := Get_Index_Subtype_List (Def);
+         Baseinfo := Get_Info (Get_Base_Type (Def));
+         Start_Record_Aggr (List, Baseinfo.T.Bounds_Type);
+         for I in Natural loop
+            Index := Get_Nth_Element (Index_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
+         Index_List : Iir_List;
+         Index : Iir;
+         Baseinfo : Type_Info_Acc;
+         Targ : Mnode;
+      begin
+         Baseinfo := Get_Info (Get_Base_Type (Def));
+         Targ := Lv2M (Target, True,
+                       Baseinfo.T.Bounds_Type,
+                       Baseinfo.T.Bounds_Ptr_Type,
+                       null, Mode_Value);
+         Index_List := Get_Index_Subtype_List (Def);
+         Open_Temp;
+         if Get_Nbr_Elements (Index_List) > 1 then
+            Targ := Stabilize (Targ);
+         end if;
+         for I in Natural loop
+            Index := Get_Nth_Element (Index_List, I);
+            exit when Index = Null_Iir;
+            declare
+               Index_Type : Iir;
+               Index_Info : Type_Info_Acc;
+               D : O_Dnode;
+            begin
+               Index_Type := Get_Base_Type (Index);
+               Index_Info := Get_Info (Index_Type);
+               Open_Temp;
+               D := Create_Temp_Ptr
+                 (Index_Info.T.Range_Ptr_Type,
+                  New_Selected_Element (M2Lv (Targ),
+                                        Baseinfo.T.Bounds_Vector (I + 1)));
+               Chap7.Translate_Discrete_Range_Ptr (D, Index);
+               Close_Temp;
+            end;
+         end loop;
+         Close_Temp;
+      end Create_Array_Subtype_Bounds;
+
+      --  Get staticness of the array bounds.
+      function Get_Array_Bounds_Staticness (Def : Iir) return Iir_Staticness
+      is
+         List : Iir_List;
+         El : Iir;
+      begin
+         List := Get_Index_Subtype_List (Def);
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            if Get_Type_Staticness (El) /= Locally then
+               return Globally;
+            end if;
+         end loop;
+         return Locally;
+      end Get_Array_Bounds_Staticness;
+
+      --  Create a variable containing the bounds for array subtype DEF.
+      procedure Create_Array_Subtype_Bounds_Var
+        (Def : Iir; Elab_Now : Boolean)
+      is
+         Info : Type_Info_Acc;
+         Base_Info : Type_Info_Acc;
+         Val : O_Cnode;
+      begin
+         Info := Get_Info (Def);
+         if Info.T.Array_Bounds /= null then
+            return;
+         end if;
+         Base_Info := Get_Info (Get_Base_Type (Def));
+         case Get_Array_Bounds_Staticness (Def) is
+            when None
+              | Globally =>
+               Info.T.Static_Bounds := False;
+               Info.T.Array_Bounds := Create_Var
+                 (Create_Var_Identifier ("STB"), Base_Info.T.Bounds_Type);
+               if Elab_Now then
+                  Create_Array_Subtype_Bounds
+                    (Def, Get_Var (Info.T.Array_Bounds));
+               end if;
+            when Locally =>
+               Info.T.Static_Bounds := True;
+               if Global_Storage = O_Storage_External then
+                  --  Do not create the value of the type desc, since it
+                  --  is never dereferenced in a static type desc.
+                  Val := O_Cnode_Null;
+               else
+                  Val := Create_Static_Array_Subtype_Bounds (Def);
+               end if;
+               Info.T.Array_Bounds := Create_Global_Const
+                 (Create_Identifier ("STB"),
+                  Base_Info.T.Bounds_Type, Global_Storage, Val);
+
+            when Unknown =>
+               raise Internal_Error;
+         end case;
+      end Create_Array_Subtype_Bounds_Var;
+
+      procedure Create_Array_Type_Builder
+        (Def : Iir_Array_Type_Definition; Kind : Object_Kind_Type)
+      is
+         Base : O_Dnode;
+         Var_I : O_Dnode;
+
+         function Get_Field_Lnode return O_Lnode is
+         begin
+            return New_Indexed_Element (New_Acc_Value (New_Obj (Base)),
+                                        New_Obj_Value (Var_I));
+         end Get_Field_Lnode;
+
+         procedure Update_Field is new Builder_Update_Field (Get_Field_Lnode);
+
+         Mem : O_Dnode;
+         Info : Type_Info_Acc;
+         El_Info : Type_Info_Acc;
+         Var_Length : O_Dnode;
+         Label : O_Snode;
+      begin
+         Info := Get_Info (Def);
+         Start_Subprogram_Body (Info.C.Builder_Func (Kind));
+         Chap2.Start_Subprg_Instance_Use (Info.C.Builder_Instance (Kind));
+
+         --  Aliased
+         Base := Info.C.Builder_Base_Param (Kind);
+
+         --  Compute length of the array.
+         New_Var_Decl (Var_Length, Wki_Length, O_Storage_Local,
+                       Ghdl_Index_Type);
+         New_Var_Decl (Mem, Get_Identifier ("mem"), O_Storage_Local,
+                       Char_Ptr_Type);
+         New_Assign_Stmt
+           (New_Obj (Var_Length),
+            Chap3.Get_Bounds_Ptr_Length (Info.C.Builder_Bound_Param (Kind),
+                                         Def));
+
+         --  Reserve the size of the array vector.
+         El_Info := Get_Info (Get_Element_Subtype (Def));
+         New_Assign_Stmt
+           (New_Obj (Mem),
+            New_Address
+            (New_Slice
+             (New_Access_Element
+              (New_Convert_Ov (New_Obj_Value (Base), Char_Ptr_Type)),
+              Chararray_Type,
+              New_Dyadic_Op (ON_Mul_Ov,
+                             New_Obj_Value (Var_Length),
+                             New_Lit (New_Sizeof
+                                      (El_Info.Ortho_Ptr_Type (Kind),
+                                       Ghdl_Index_Type)))),
+             Char_Ptr_Type));
+
+         --  Set each index of the array.
+         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_Obj_Value (Var_I),
+                                        New_Obj_Value (Var_Length),
+                                        Ghdl_Bool_Type));
+         Update_Field (Get_Element_Subtype (Def), Mem, Kind);
+         Inc_Var (Var_I);
+         Finish_Loop_Stmt (Label);
+
+         New_Return_Stmt (New_Obj_Value (Mem));
+
+         Chap2.Finish_Subprg_Instance_Use (Info.C.Builder_Instance (Kind));
+         Finish_Subprogram_Body;
+      end Create_Array_Type_Builder;
+
+      --------------
+      --  record  --
+      --------------
+      procedure Translate_Record_Type (Def : Iir_Record_Type_Definition)
+      is
+         El_List : O_Element_List;
+         El : Iir_Element_Declaration;
+         Info : Type_Info_Acc;
+         Field_Info : Ortho_Info_Acc;
+         El_Type : Iir;
+         El_Tinfo : Type_Info_Acc;
+
+         --  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;
+         El := Get_Element_Declaration_Chain (Def);
+         while El /= Null_Iir loop
+            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 Get_Info (El_Type).C /= null then
+               Need_Size := True;
+            end if;
+            Field_Info := Add_Info (El, Kind_Field);
+            El := Get_Chain (El);
+         end loop;
+
+         for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
+            Start_Record_Type (El_List);
+            El := Get_Element_Declaration_Chain (Def);
+            while El /= Null_Iir loop
+               Field_Info := Get_Info (El);
+               El_Tinfo := Get_Info (Get_Type (El));
+               New_Record_Field (El_List, Field_Info.Field_Node (Kind),
+                                 Create_Identifier_Without_Prefix (El),
+                                 Chap4.Get_Element_Type (El_Tinfo, Kind));
+               El := Get_Chain (El);
+            end loop;
+            Finish_Record_Type (El_List, Info.Ortho_Type (Kind));
+         end loop;
+         if Get_Signal_Type_Flag (Def) = False then
+            Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
+         end if;
+         Info.Type_Mode := Type_Mode_Record;
+         Finish_Type_Definition (Info);
+
+         if Need_Size then
+            Create_Size_Var (Def);
+            Info.C.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
+         Base : O_Dnode;
+         El : Iir_Element_Declaration;
+
+         function Get_Field_Lnode
+           return O_Lnode
+         is
+         begin
+            return New_Selected_Element (New_Acc_Value (New_Obj (Base)),
+                                         Get_Info (El).Field_Node (Kind));
+         end Get_Field_Lnode;
+
+         procedure Update_Field is new
+           Builder_Update_Field (Get_Field_Lnode);
+
+         Info : Type_Info_Acc;
+         Mem : O_Dnode;
+         El_Type : Iir;
+      begin
+         Info := Get_Info (Def);
+         Start_Subprogram_Body (Info.C.Builder_Func (Kind));
+         Chap2.Start_Subprg_Instance_Use (Info.C.Builder_Instance (Kind));
+
+         --  Aliases.
+         Base := Info.C.Builder_Base_Param (Kind);
+
+         New_Var_Decl (Mem, Get_Identifier ("mem"), O_Storage_Local,
+                       Char_Ptr_Type);
+
+         --  Reserve memory for the record, ie:
+         --  MEM = BASE + SIZEOF (record).
+         New_Assign_Stmt
+           (New_Obj (Mem),
+            New_Address
+            (New_Slice (New_Access_Element
+                        (New_Convert_Ov (New_Obj_Value (Base), Char_Ptr_Type)),
+                        Chararray_Type,
+                        New_Lit (New_Sizeof (Info.Ortho_Type (Kind),
+                                             Ghdl_Index_Type))),
+             Char_Ptr_Type));
+
+         --  Set memory for each complex element.
+         El := Get_Element_Declaration_Chain (Def);
+         while El /= Null_Iir loop
+            El_Type := Get_Type (El);
+            if Get_Info (El_Type).C /= null then
+               --  Complex type.
+               Update_Field (El_Type, Mem, Kind);
+            end if;
+            El := Get_Chain (El);
+         end loop;
+         Chap2.Finish_Subprg_Instance_Use (Info.C.Builder_Instance (Kind));
+         New_Return_Stmt (New_Obj_Value (Mem));
+         Finish_Subprogram_Body;
+      end Create_Record_Type_Builder;
+
+      --------------
+      --  Access  --
+      --------------
+      procedure Translate_Access_Type (Def : Iir_Access_Type_Definition)
+      is
+         D_Type : Iir;
+         D_Info : Ortho_Info_Acc;
+         Dtype : O_Tnode;
+         Def_Info : Type_Info_Acc;
+         Arr_Info : Type_Info_Acc;
+      begin
+         D_Type := Get_Designated_Type (Def);
+         D_Info := Get_Info (D_Type);
+         Def_Info := Get_Info (Def);
+
+         if Get_Kind (D_Type) in Iir_Kinds_Unconstrained_Array_Type_Definition
+         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;
+            if D_Info.Kind = Kind_Incomplete_Type then
+               Dtype := O_Tnode_Null;
+            elsif D_Info.Type_Mode in Type_Mode_Arrays then
+               --  The designated type cannot be a sub array inside ortho.
+               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);
+            Def_Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
+            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;
+         return;
+--          Info := Get_Info (Def);
+--          Ftype := Get_Type (Get_Type_Declarator (Def));
+--          case Get_Kind (Ftype) is
+--             when Iir_Kind_Record_Type_Definition =>
+--                Info.Type_Mode := Type_Mode_Unknown;
+--                for I in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
+--                   New_Uncomplete_Record_Type (Info.Ortho_Type (I));
+--                end loop;
+--             when others =>
+--                Error_Kind ("translate_incomplete_type", Ftype);
+--          end case;
+--          Set_Info (Ftype, Info);
+--          Finish_Type_Definition (Info, Incomplete_Type);
+      end Translate_Incomplete_Type;
+
+      --  CTYPE is the type which has been completed.
+      procedure Translate_Complete_Type
+        (Incomplete_Info : in out Incomplete_Type_Info_Acc; Ctype : Iir)
+      is
+         List : Iir_List;
+         Atype : Iir;
+         Def_Info : Type_Info_Acc;
+         C_Info : Type_Info_Acc;
+         Dtype : O_Tnode;
+      begin
+         C_Info := Get_Info (Ctype);
+         List := Get_Incomplete_Type_List (Incomplete_Info.Incomplete_Type);
+         for I in Natural loop
+            Atype := Get_Nth_Element (List, I);
+            exit when Atype = Null_Iir;
+            if Get_Kind (Atype) /= Iir_Kind_Access_Type_Definition then
+               raise Internal_Error;
+            end if;
+            Def_Info := Get_Info (Atype);
+            case C_Info.Type_Mode is
+               when Type_Mode_Arrays =>
+                  Dtype := C_Info.T.Base_Type (Mode_Value);
+               when others =>
+                  Dtype := C_Info.Ortho_Type (Mode_Value);
+            end case;
+            Finish_Access_Type (Def_Info.Ortho_Type (Mode_Value), Dtype);
+         end loop;
+         Unchecked_Deallocation (Incomplete_Info);
+      end Translate_Complete_Type;
+
+      -----------------
+      --  protected  --
+      -----------------
+      procedure Translate_Protected_Type (Def : Iir_Protected_Type_Declaration)
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Def);
+
+         New_Uncomplete_Record_Type (Info.Ortho_Type (Mode_Value));
+         New_Type_Decl (Create_Identifier, Info.Ortho_Type (Mode_Value));
+
+         Info.Ortho_Ptr_Type (Mode_Value) :=
+           New_Access_Type (Info.Ortho_Type (Mode_Value));
+         New_Type_Decl (Create_Identifier ("PTR"),
+                        Info.Ortho_Ptr_Type (Mode_Value));
+
+         Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
+         Info.Ortho_Ptr_Type (Mode_Signal) := O_Tnode_Null;
+
+         Info.Type_Mode := Type_Mode_Protected;
+
+         Info.C := new Complex_Type_Info;
+         Info.C.Size_Var (Mode_Value) := Create_Global_Const
+           (Create_Identifier ("SIZE"), Ghdl_Index_Type,
+            O_Storage_External, O_Cnode_Null);
+         Info.C.Builder_Need_Func := False;
+
+         --  This is just use to set overload number on subprograms, and to
+         --  translate interfaces.
+         Chap4.Translate_Declaration_Chain (Def);
+      end Translate_Protected_Type;
+
+      procedure Translate_Protected_Type_Subprograms
+        (Def : Iir_Protected_Type_Declaration)
+      is
+         El : Iir;
+         Info : Type_Info_Acc;
+         Inter_List : O_Inter_List;
+         Mark : Id_Mark_Type;
+      begin
+         Push_Identifier_Prefix
+           (Mark, Get_Identifier (Get_Type_Declarator (Def)));
+
+         Info := Get_Info (Def);
+
+         Chap2.Push_Subprg_Instance (Info.Ortho_Type (Mode_Value),
+                                     Info.Ortho_Ptr_Type (Mode_Value),
+                                     Wki_Obj);
+
+         --  Init.
+         Start_Procedure_Decl
+           (Inter_List, Create_Identifier ("INIT"), Global_Storage);
+         Chap2.Add_Subprg_Instance_Interfaces
+           (Inter_List, Info.T.Prot_Init_Instance);
+         Finish_Subprogram_Decl (Inter_List, Info.T.Prot_Init_Node);
+
+         --  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_Node);
+
+         --  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 =>
+                  Chap2.Translate_Subprogram_Declaration (El);
+               when others =>
+                  Error_Kind ("translate_protected_type_subprograms", El);
+            end case;
+            El := Get_Chain (El);
+         end loop;
+
+         Chap2.Pop_Subprg_Instance (Wki_Obj);
+
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Protected_Type_Subprograms;
+
+      procedure Translate_Protected_Type_Body (Bod : Iir)
+      is
+         Decl : Iir_Protected_Type_Declaration;
+         Mark : Id_Mark_Type;
+         Info : Type_Info_Acc;
+         Lock_Field : O_Fnode;
+      begin
+         Decl := Get_Protected_Type_Declaration (Bod);
+         Info := Get_Info (Decl);
+
+         Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
+
+         Push_Instance_Factory (Info.Ortho_Type (Mode_Value));
+         Lock_Field := Add_Instance_Factory_Field
+           (Get_Identifier ("LOCK"), Ghdl_Ptr_Type);
+
+         --  Translate declarations.
+         Chap4.Translate_Declaration_Chain (Bod);
+
+         Pop_Instance_Factory (Info.Ortho_Type (Mode_Value));
+         if Global_Storage /= O_Storage_External then
+            Info.C.Size_Var (Mode_Value) := Create_Global_Const
+              (Create_Identifier ("SIZE"), Ghdl_Index_Type,
+               Global_Storage, New_Sizeof (Info.Ortho_Type (Mode_Value),
+                                           Ghdl_Index_Type));
+         end if;
+
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Protected_Type_Body;
+
+      procedure Call_Ghdl_Protected_Procedure (Type_Def : Iir; Proc : O_Dnode)
+      is
+         Assoc : O_Assoc_List;
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Type_Def);
+         Start_Association (Assoc, Proc);
+         New_Association
+           (Assoc,
+            New_Unchecked_Address
+            (Get_Instance_Ref (Info.Ortho_Type (Mode_Value)), Ghdl_Ptr_Type));
+         New_Procedure_Call (Assoc);
+      end Call_Ghdl_Protected_Procedure;
+
+      procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir)
+      is
+         Decl : Iir;
+         Info : Type_Info_Acc;
+         Final : Boolean;
+      begin
+         Decl := Get_Protected_Type_Declaration (Bod);
+         Info := Get_Info (Decl);
+
+         --  Subprograms of BOD.
+         Chap2.Push_Subprg_Instance (Info.Ortho_Type (Mode_Value),
+                                     Info.Ortho_Ptr_Type (Mode_Value),
+                                     Wki_Obj);
+
+         Chap4.Translate_Declaration_Chain_Subprograms (Bod, Null_Iir);
+
+         Chap2.Pop_Subprg_Instance (Wki_Obj);
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         --  Init
+         Start_Subprogram_Body (Info.T.Prot_Init_Node);
+         Chap2.Start_Subprg_Instance_Use (Info.T.Prot_Init_Instance);
+
+         --   Create lock.
+         Call_Ghdl_Protected_Procedure (Decl, Ghdl_Protected_Init);
+
+         --   Elaborate fields.
+         Chap4.Elab_Declaration_Chain (Bod, Final);
+
+         Chap2.Finish_Subprg_Instance_Use (Info.T.Prot_Init_Instance);
+         Finish_Subprogram_Body;
+
+
+         --  Fini
+         Start_Subprogram_Body (Info.T.Prot_Final_Node);
+         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 Translate_Protected_Type_Body_Subprograms;
+
+      ---------------
+      --  Scalars  --
+      ---------------
+
+      --  Create a type_range structure.
+      procedure Create_Scalar_Type_Range (Def : Iir; Target : O_Lnode)
+      is
+         T_Info : Type_Info_Acc;
+         Base_Type : Iir;
+         Expr : Iir;
+         V : O_Dnode;
+      begin
+         Base_Type := Get_Base_Type (Def);
+         T_Info := Get_Info (Base_Type);
+         Expr := Get_Range_Constraint (Def);
+         Open_Temp;
+         V := Create_Temp_Ptr (T_Info.T.Range_Ptr_Type, Target);
+         Chap7.Translate_Range_Ptr (V, Expr, Def);
+         Close_Temp;
+      end Create_Scalar_Type_Range;
+
+      function Create_Static_Scalar_Type_Range (Def : Iir) return O_Cnode is
+      begin
+         return Chap7.Translate_Static_Range (Get_Range_Constraint (Def),
+                                              Get_Base_Type (Def));
+      end Create_Static_Scalar_Type_Range;
+
+      procedure Create_Scalar_Type_Range_Type
+        (Def : Iir; With_Length : Boolean)
+      is
+         Constr : O_Element_List;
+         Info : Ortho_Info_Acc;
+      begin
+         Info := Get_Info (Def);
+         Start_Record_Type (Constr);
+         New_Record_Field
+           (Constr, Info.T.Range_Left, Wki_Left,
+            Info.Ortho_Type (Mode_Value));
+         New_Record_Field
+           (Constr, Info.T.Range_Right, Wki_Right,
+            Info.Ortho_Type (Mode_Value));
+         New_Record_Field
+           (Constr, Info.T.Range_Dir, Wki_Dir, Ghdl_Dir_Type_Node);
+         if With_Length then
+            New_Record_Field
+              (Constr, Info.T.Range_Length, Wki_Length, Ghdl_Index_Type);
+         else
+            Info.T.Range_Length := O_Fnode_Null;
+         end if;
+         Finish_Record_Type (Constr, Info.T.Range_Type);
+         New_Type_Decl (Create_Identifier ("TRT"), Info.T.Range_Type);
+         Info.T.Range_Ptr_Type := New_Access_Type (Info.T.Range_Type);
+         New_Type_Decl (Create_Identifier ("TRPTR"),
+                        Info.T.Range_Ptr_Type);
+      end Create_Scalar_Type_Range_Type;
+
+      function Create_Static_Type_Definition_Type_Range (Def : Iir)
+        return O_Cnode
+      is
+      begin
+         case Get_Kind (Def) is
+            when Iir_Kind_Enumeration_Type_Definition
+              | Iir_Kind_Enumeration_Subtype_Definition
+              | Iir_Kind_Integer_Subtype_Definition
+              | Iir_Kind_Floating_Subtype_Definition
+              | Iir_Kind_Physical_Subtype_Definition =>
+               return Create_Static_Scalar_Type_Range (Def);
+
+            when Iir_Kind_Array_Subtype_Definition =>
+               return Create_Static_Array_Subtype_Bounds (Def);
+
+            when Iir_Kind_Array_Type_Definition =>
+               return O_Cnode_Null;
+
+            when others =>
+               Error_Kind ("create_static_type_definition_type_range", Def);
+         end case;
+      end Create_Static_Type_Definition_Type_Range;
+
+      procedure Create_Type_Definition_Type_Range (Def : Iir)
+      is
+         Target : O_Lnode;
+         Info : Type_Info_Acc;
+      begin
+         case Get_Kind (Def) is
+            when Iir_Kind_Enumeration_Type_Definition
+              | Iir_Kind_Enumeration_Subtype_Definition
+              | Iir_Kind_Integer_Subtype_Definition
+              | Iir_Kind_Floating_Subtype_Definition
+              | Iir_Kind_Physical_Subtype_Definition =>
+               Target := Get_Var (Get_Info (Def).T.Range_Var);
+               Create_Scalar_Type_Range (Def, Target);
+
+            when Iir_Kind_Array_Subtype_Definition =>
+               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;
+
+            when Iir_Kind_Array_Type_Definition =>
+               --  FIXME: create unidimensional array bound of length 1
+               return;
+            when Iir_Kind_Access_Type_Definition
+              | Iir_Kind_Access_Subtype_Definition
+              | Iir_Kind_Unconstrained_Array_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;
+
+      function Get_Additionnal_Size (Def : Iir; Kind : Object_Kind_Type)
+        return O_Enode
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Def);
+
+         if Info.C = null then
+            --  Short-cut.
+            return O_Enode_Null;
+         else
+            return New_Value (Get_Var (Info.C.Size_Var (Kind)));
+         end if;
+      end Get_Additionnal_Size;
+
+      procedure Create_Type_Definition_Size_Var (Def : Iir)
+      is
+         Info : Type_Info_Acc;
+         Res : O_Enode;
+         V : O_Cnode;
+         Add : O_Enode;
+      begin
+         Info := Get_Info (Def);
+         if Info.C = null then
+            return;
+         end if;
+         for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
+            if Info.C.Size_Var (Kind) /= null then
+               Open_Temp;
+               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_Array =>
+                     V := New_Sizeof (Info.Ortho_Type (Kind),
+                                      Ghdl_Index_Type);
+                     Add := Get_Additionnal_Size
+                       (Get_Element_Subtype (Def), Kind);
+                     if Add /= O_Enode_Null then
+                        Add := New_Dyadic_Op
+                          (ON_Mul_Ov, Get_Array_Type_Length (Def), Add);
+                        Res := New_Dyadic_Op (ON_Add_Ov, New_Lit (V), Add);
+                     else
+                        Res := New_Lit (V);
+                     end if;
+                  when Type_Mode_Record =>
+                     declare
+                        El : Iir_Element_Declaration;
+                        N_Res : O_Enode;
+                     begin
+                        V := New_Sizeof (Info.Ortho_Type (Kind),
+                                         Ghdl_Index_Type);
+                        El := Get_Element_Declaration_Chain
+                          (Get_Base_Type (Def));
+                        Res := New_Lit (V);
+                        while El /= Null_Iir loop
+                           N_Res := Get_Additionnal_Size (Get_Type (El), Kind);
+                           if N_Res /= O_Enode_Null then
+                              Res := New_Dyadic_Op
+                                (ON_Add_Ov, Res, N_Res);
+                           end if;
+                           El := Get_Chain (El);
+                        end loop;
+                     end;
+                  when Type_Mode_Ptr_Array =>
+                     --  If element is a composite type then
+                     --    Return length * (sizeof (element)
+                     --                     + sizeof (element_ptr))
+                     --  else
+                     --    Return length * sizeof (element)
+                     --  end if
+                     declare
+                        El_Type : Iir;
+                        El_Tinfo : Type_Info_Acc;
+                     begin
+                        El_Type := Get_Element_Subtype (Def);
+                        El_Tinfo := Get_Info (El_Type);
+                        Res := Chap3.Get_Object_Size
+                          (T2M (El_Type, Kind), El_Type);
+                        if El_Tinfo.C /= null then
+                           Res := New_Dyadic_Op
+                             (ON_Add_Ov,
+                              Res,
+                              New_Lit
+                              (New_Sizeof (El_Tinfo.Ortho_Ptr_Type (Kind),
+                                           Ghdl_Index_Type)));
+                        end if;
+                        Res := New_Dyadic_Op
+                          (ON_Mul_Ov,
+                           Chap3.Get_Array_Type_Length (Def),
+                           Res);
+                     end;
+               end case;
+               New_Assign_Stmt (Get_Var (Info.C.Size_Var (Kind)), Res);
+               Close_Temp;
+            end if;
+         end loop;
+      end Create_Type_Definition_Size_Var;
+
+      procedure Create_Type_Range_Var (Def : Iir)
+      is
+         Info : Type_Info_Acc;
+         Base_Info : Type_Info_Acc;
+         Val : O_Cnode;
+         Suffix : String (1 .. 3) := "xTR";
+      begin
+         Info := Get_Info (Def);
+         case Get_Kind (Def) is
+            when Iir_Kinds_Subtype_Definition =>
+               Suffix (1) := 'S'; -- "STR";
+            when Iir_Kind_Enumeration_Type_Definition =>
+               Suffix (1) := 'B'; -- "BTR";
+            when others =>
+               raise Internal_Error;
+         end case;
+         Base_Info := Get_Info (Get_Base_Type (Def));
+         case Get_Type_Staticness (Def) is
+            when None
+              | Globally =>
+               Info.T.Range_Var := Create_Var
+                 (Create_Var_Identifier (Suffix), Base_Info.T.Range_Type);
+            when Locally =>
+               if Global_Storage = O_Storage_External then
+                  --  Do not create the value of the type desc, since it
+                  --  is never dereferenced in a static type desc.
+                  Val := O_Cnode_Null;
+               else
+                  Val := Create_Static_Type_Definition_Type_Range (Def);
+               end if;
+               Info.T.Range_Var := Create_Global_Const
+                 (Create_Identifier (Suffix),
+                  Base_Info.T.Range_Type, Global_Storage, Val);
+            when Unknown =>
+               raise Internal_Error;
+         end case;
+      end Create_Type_Range_Var;
+
+
+      --  Call HANDLE_A_SUBTYPE for all type/subtypes declared with DEF
+      --  (of course, this is a noop if DEF is not a composite type).
+      generic
+         with procedure Handle_A_Subtype (Atype : Iir);
+      procedure Handle_Anonymous_Subtypes (Def : Iir);
+
+      procedure Handle_Anonymous_Subtypes (Def : Iir) is
+      begin
+         case Get_Kind (Def) is
+            when Iir_Kind_Array_Type_Definition
+              | Iir_Kind_Array_Subtype_Definition =>
+               declare
+                  Asub : Iir;
+               begin
+                  Asub := Get_Element_Subtype (Def);
+                  if Is_Anonymous_Type_Definition (Asub) then
+                     Handle_A_Subtype (Asub);
+                  end if;
+               end;
+            when Iir_Kind_Record_Type_Definition =>
+               declare
+                  El : Iir;
+                  Asub : Iir;
+               begin
+                  El := Get_Element_Declaration_Chain (Def);
+                  while El /= Null_Iir loop
+                     Asub := Get_Type (El);
+                     if Is_Anonymous_Type_Definition (Asub) then
+                        Handle_A_Subtype (Asub);
+                     end if;
+                     El := Get_Chain (El);
+                  end loop;
+               end;
+            when others =>
+               null;
+         end case;
+      end Handle_Anonymous_Subtypes;
+
+      --  Return TRUE iff LIT is equal to the high (IS_HI=TRUE) or low
+      --  (IS_HI=false) limit of the base type of DEF.  MODE is the mode of
+      --  DEF.
+      function Is_Equal_Limit (Lit : Iir;
+                               Is_Hi : Boolean;
+                               Def : Iir;
+                               Mode : Type_Mode_Type) return Boolean
+      is
+      begin
+         case Mode is
+            when Type_Mode_B2 =>
+               declare
+                  V : Iir_Int32;
+               begin
+                  V := Get_Enum_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 := Get_Enum_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_Literal_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_Literal_Value (Lit);
+                  if Is_Hi then
+                     return V = Iir_Int64'Last;
+                  else
+                     return V = Iir_Int64'First;
+                  end if;
+               end;
+            when Type_Mode_F64 =>
+               declare
+                  V : Iir_Fp64;
+               begin
+                  V := Get_Fp_Value (Lit);
+                  if Is_Hi then
+                     return V = Iir_Fp64'Last;
+                  else
+                     return V = Iir_Fp64'First;
+                  end if;
+               end;
+            when others =>
+               Error_Kind ("is_equal_limit " & Type_Mode_Type'Image (Mode),
+                           Lit);
+         end case;
+      end Is_Equal_Limit;
+
+      procedure Create_Subtype_Info_From_Type (Def : Iir;
+                                               Subtype_Info : Type_Info_Acc;
+                                               Base_Info : Type_Info_Acc)
+      is
+         Base_Type : Iir;
+         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.
+            Base_Type := Get_Base_Type (Def);
+            Get_Low_High_Limit (Rng, Lo, Hi);
+            Subtype_Info.T.Nocheck_Hi :=
+              Is_Equal_Limit (Hi, True, Def, Base_Info.Type_Mode);
+            Subtype_Info.T.Nocheck_Low :=
+              Is_Equal_Limit (Lo, False, Def, Base_Info.Type_Mode);
+         end if;
+      end Create_Subtype_Info_From_Type;
+
+      --  Note: boolean types are translated by translate_bool_type_definition!
+      procedure Translate_Type_Definition
+        (Def : Iir; With_Vars : Boolean := True)
+      is
+         Info : Ortho_Info_Acc;
+         Base_Info : Type_Info_Acc;
+         Base_Type : Iir;
+         Complete_Info : Incomplete_Type_Info_Acc;
+      begin
+         --  Handle the special case of incomplete type.
+         if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
+            Translate_Incomplete_Type (Def);
+            return;
+         end if;
+
+         --  If the definition is already translated, return now.
+         Info := Get_Info (Def);
+         if Info /= null then
+            if Info.Kind = Kind_Type then
+               return;
+            end if;
+            if Info.Kind = Kind_Incomplete_Type then
+               Complete_Info := Info;
+               Clear_Info (Def);
+               if Complete_Info.Incomplete_Array /= null then
+                  Info := Complete_Info.Incomplete_Array;
+                  Set_Info (Def, Info);
+                  Unchecked_Deallocation (Complete_Info);
+               else
+                  Info := Add_Info (Def, Kind_Type);
+               end if;
+            else
+               raise Internal_Error;
+            end if;
+         else
+            Complete_Info := null;
+            Info := Add_Info (Def, Kind_Type);
+         end if;
+
+         Base_Type := Get_Base_Type (Def);
+         Base_Info := Get_Info (Base_Type);
+
+         case Get_Kind (Def) is
+            when Iir_Kind_Enumeration_Type_Definition =>
+               Translate_Enumeration_Type (Def);
+               Create_Scalar_Type_Range_Type (Def, True);
+               Create_Type_Range_Var (Def);
+               --Create_Type_Desc_Var (Def);
+
+            when Iir_Kind_Integer_Type_Definition =>
+               Translate_Integer_Type (Def);
+               Create_Scalar_Type_Range_Type (Def, True);
+
+            when Iir_Kind_Physical_Type_Definition =>
+               Translate_Physical_Type (Def);
+               Create_Scalar_Type_Range_Type (Def, False);
+               if With_Vars and Get_Type_Staticness (Def) /= Locally then
+                  Translate_Physical_Units (Def);
+               else
+                  Info.T.Range_Var := null;
+               end if;
+
+            when Iir_Kind_Floating_Type_Definition =>
+               Translate_Floating_Type (Def);
+               Create_Scalar_Type_Range_Type (Def, False);
+
+            when Iir_Kind_Enumeration_Subtype_Definition
+              | Iir_Kind_Physical_Subtype_Definition
+              | Iir_Kind_Integer_Subtype_Definition
+              | Iir_Kind_Floating_Subtype_Definition =>
+               Create_Subtype_Info_From_Type (Def, Info, Base_Info);
+               if With_Vars then
+                  Create_Type_Range_Var (Def);
+               else
+                  Info.T.Range_Var := null;
+               end if;
+
+            when Iir_Kind_Array_Type_Definition =>
+               declare
+                  El_Type : Iir;
+                  Mark : Id_Mark_Type;
+               begin
+                  El_Type := Get_Element_Subtype (Def);
+                  if Get_Info (El_Type) = null then
+                     Push_Identifier_Prefix (Mark, "ET");
+                     Translate_Type_Definition (El_Type);
+                     Pop_Identifier_Prefix (Mark);
+                  end if;
+               end;
+               Translate_Array_Type (Def);
+            -- Info.Type_Range_Type := Create_Array_Type_Bounds_Type (Def, Id);
+
+            when Iir_Kind_Array_Subtype_Definition =>
+               if Base_Info = null or else Base_Info.Type_Incomplete then
+                  declare
+                     Mark : Id_Mark_Type;
+                  begin
+                     Push_Identifier_Prefix (Mark, "BT");
+                     Translate_Type_Definition (Base_Type);
+                     Pop_Identifier_Prefix (Mark);
+                     Base_Info := Get_Info (Base_Type);
+                  end;
+               end if;
+               Translate_Array_Subtype (Def);
+               Info.T := Base_Info.T;
+               --Info.Type_Range_Type := Base_Info.Type_Range_Type;
+               if With_Vars then
+                  Create_Array_Subtype_Bounds_Var (Def, False);
+               end if;
+
+            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
+              | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+               Free_Info (Def);
+               Set_Info (Def, Base_Info);
+
+            when Iir_Kind_Access_Type_Definition =>
+               declare
+                  Dtype : 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
+         Decl : Iir;
+         Id : Name_Id;
+         Info : Type_Info_Acc;
+         Base_Type : Iir;
+      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);
+         Base_Type := Get_Base_Type (Def);
+         Decl := Get_Type_Declarator (Def);
+
+         Id := Get_Identifier (Decl);
+
+         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 (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 Tinfo.C = null or else Tinfo.C.Builder_Need_Func = False then
+            return;
+         end if;
+
+         --  Declare subprograms.
+         Id := Get_Identifier (Decl);
+         Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value);
+         if Get_Signal_Type_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_Signal_Type_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_Signal_Type_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
+         Info : Type_Info_Acc;
+      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;
+
+         Info := Get_Info (Def);
+
+         Elab_Type_Definition_Depend (Def);
+
+         Create_Type_Definition_Type_Range (Def);
+         Create_Type_Definition_Size_Var (Def);
+      end Elab_Type_Definition;
+
+      procedure Translate_Named_Type_Definition (Def : Iir; Id : Name_Id)
+      is
+         Mark : Id_Mark_Type;
+      begin
+         Push_Identifier_Prefix (Mark, Id);
+         Chap3.Translate_Type_Definition (Def);
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Named_Type_Definition;
+
+      procedure Translate_Anonymous_Type_Definition
+        (Def : Iir; Transient : Boolean)
+      is
+         Mark : Id_Mark_Type;
+         Type_Info : Type_Info_Acc;
+      begin
+         Type_Info := Get_Info (Def);
+         if Type_Info /= null then
+            return;
+         end if;
+         Push_Identifier_Prefix_Uniq (Mark);
+         Chap3.Translate_Type_Definition (Def, False);
+         if Transient then
+            Add_Transient_Type_In_Temp (Def);
+         end if;
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Anonymous_Type_Definition;
+
+      procedure Destroy_Type_Info (Atype : Iir)
+      is
+         Type_Info : Type_Info_Acc;
+      begin
+         Type_Info := Get_Info (Atype);
+         Free_Type_Info (Type_Info, False);
+         Clear_Info (Atype);
+      end Destroy_Type_Info;
+
+      procedure Translate_Object_Subtype (Decl : Iir;
+                                          With_Vars : Boolean := True)
+      is
+         Mark : Id_Mark_Type;
+         Mark2 : Id_Mark_Type;
+         Def : Iir;
+      begin
+         Def := Get_Type (Decl);
+         if Is_Anonymous_Type_Definition (Def) then
+            Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+            Push_Identifier_Prefix (Mark2, "OT");
+            Chap3.Translate_Type_Definition (Def, With_Vars);
+            Pop_Identifier_Prefix (Mark2);
+            Pop_Identifier_Prefix (Mark);
+         end if;
+      end Translate_Object_Subtype;
+
+      procedure Elab_Object_Subtype (Def : Iir) is
+      begin
+         if Is_Anonymous_Type_Definition (Def) then
+            Elab_Type_Definition (Def);
+         end if;
+      end Elab_Object_Subtype;
+
+      procedure Elab_Type_Declaration (Decl : Iir)
+      is
+      begin
+         Elab_Type_Definition (Get_Type (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
+         Index_List : Iir_List;
+         Nbr_Dim : Natural;
+         Val : Iir_Int64;
+         Rng : Iir;
+      begin
+         Index_List := Get_Index_Subtype_List (Atype);
+         Nbr_Dim := Get_Nbr_Elements (Index_List);
+         Val := 1;
+         for I in 0 .. Nbr_Dim - 1 loop
+            Rng := Get_Range_Constraint
+              (Get_Nth_Element (Index_List, I));
+            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 Get_Bounds_Ptr_Length (Ptr : O_Dnode; Atype : Iir)
+        return O_Enode
+      is
+         Index_List : Iir_List;
+         Index_Type : Iir;
+         Nbr_Dim : Natural;
+         Dim_Length : O_Enode;
+         Res : O_Enode;
+         Type_Info : Type_Info_Acc;
+         Index_Info : Type_Info_Acc;
+      begin
+         Index_List := Get_Index_Subtype_List (Atype);
+         Nbr_Dim := Get_Nbr_Elements (Index_List);
+
+         Type_Info := Get_Info (Get_Base_Type (Atype));
+         for Dim in 1 .. Nbr_Dim loop
+            Index_Type := Get_Nth_Element (Index_List, Dim - 1);
+            Index_Info := Get_Info (Get_Base_Type (Index_Type));
+            Dim_Length := New_Value
+              (New_Selected_Element
+               (New_Selected_Element (New_Acc_Value (New_Obj (Ptr)),
+                                      Type_Info.T.Bounds_Vector (Dim)),
+                Index_Info.T.Range_Length));
+            if Dim = 1 then
+               Res := Dim_Length;
+            else
+               Res := New_Dyadic_Op (ON_Mul_Ov, Res, Dim_Length);
+            end if;
+         end loop;
+         return Res;
+      end Get_Bounds_Ptr_Length;
+
+      function Bounds_To_Range (B : Mnode; Atype : Iir; Dim : Positive)
+        return Mnode
+      is
+         Tinfo : Type_Info_Acc;
+         Index_Type : Iir;
+         Iinfo : Type_Info_Acc;
+      begin
+         Tinfo := Get_Type_Info (B);
+         Index_Type := Get_Nth_Element
+           (Get_Index_Subtype_List (Get_Base_Type (Atype)), Dim - 1);
+         Iinfo := Get_Info (Get_Base_Type (Index_Type));
+         return Lv2M (New_Selected_Element (M2Lv (B),
+                                            Tinfo.T.Bounds_Vector (Dim)),
+                      Iinfo,
+                      Get_Object_Kind (B),
+                      Iinfo.T.Range_Type,
+                      Iinfo.T.Range_Ptr_Type);
+      end Bounds_To_Range;
+
+      function Type_To_Range (Atype : Iir) return Mnode
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Atype);
+         return Varv2M (Info.T.Range_Var, Info, Mode_Value,
+                        Info.T.Range_Type, Info.T.Range_Ptr_Type);
+      end Type_To_Range;
+
+      function Range_To_Length (R : Mnode) return Mnode
+      is
+         Tinfo : Type_Info_Acc;
+      begin
+         Tinfo := Get_Type_Info (R);
+         return Lv2M (New_Selected_Element (M2Lv (R),
+                                            Tinfo.T.Range_Length),
+                      Tinfo,
+                      Mode_Value);
+      end Range_To_Length;
+
+      function Range_To_Dir (R : Mnode) return Mnode
+      is
+         Tinfo : Type_Info_Acc;
+      begin
+         Tinfo := Get_Type_Info (R);
+         return Lv2M (New_Selected_Element (M2Lv (R),
+                                            Tinfo.T.Range_Dir),
+                      Tinfo,
+                      Mode_Value);
+      end Range_To_Dir;
+
+      function Range_To_Left (R : Mnode) return Mnode
+      is
+         Tinfo : Type_Info_Acc;
+      begin
+         Tinfo := Get_Type_Info (R);
+         return Lv2M (New_Selected_Element (M2Lv (R),
+                                            Tinfo.T.Range_Left),
+                      Tinfo,
+                      Mode_Value);
+      end Range_To_Left;
+
+      function Range_To_Right (R : Mnode) return Mnode
+      is
+         Tinfo : Type_Info_Acc;
+      begin
+         Tinfo := Get_Type_Info (R);
+         return Lv2M (New_Selected_Element (M2Lv (R),
+                                            Tinfo.T.Range_Right),
+                      Tinfo,
+                      Mode_Value);
+      end Range_To_Right;
+
+      function Get_Array_Type_Bounds (Info : Type_Info_Acc) return Mnode
+      is
+      begin
+         case Info.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               raise Internal_Error;
+            when Type_Mode_Array
+              | Type_Mode_Ptr_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 : 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.Bounds_Field (Kind)),
+                     Info,
+                     Mode_Value,
+                     Info.T.Bounds_Type,
+                     Info.T.Bounds_Ptr_Type);
+               end;
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               return Get_Array_Type_Bounds (Info);
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Get_Array_Bounds;
+
+      function Get_Array_Range (Arr : Mnode; Atype : Iir; Dim : Positive)
+                               return Mnode is
+      begin
+         return Bounds_To_Range (Get_Array_Bounds (Arr), Atype, Dim);
+      end Get_Array_Range;
+
+      function Get_Array_Type_Length (Atype : Iir) return O_Enode
+      is
+         Index_List : Iir_List;
+         Index_Type : Iir;
+         Nbr_Dim : Natural;
+         Dim_Length : O_Enode;
+         Res : O_Enode;
+         Type_Info : Type_Info_Acc;
+         Binfo : Type_Info_Acc;
+         Index_Info : Type_Info_Acc;
+         Bounds : Mnode;
+      begin
+         Index_List := Get_Index_Subtype_List (Atype);
+         Nbr_Dim := Get_Nbr_Elements (Index_List);
+
+         --  Handle thin array case.
+         Type_Info := Get_Info (Atype);
+         case Type_Info.Type_Mode is
+            when Type_Mode_Ptr_Array =>
+               Bounds := Get_Array_Type_Bounds (Atype);
+               if Nbr_Dim > 1 then
+                  Bounds := Stabilize (Bounds);
+               end if;
+            when Type_Mode_Array =>
+               return New_Lit (Get_Thin_Array_Length (Atype));
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         Binfo := Get_Info (Get_Base_Type (Atype));
+         for Dim in 1 .. Nbr_Dim loop
+            Index_Type := Get_Nth_Element (Index_List, Dim - 1);
+            Index_Info := Get_Info (Get_Base_Type (Index_Type));
+            Dim_Length :=
+              M2E (Range_To_Length (Bounds_To_Range (Bounds, Atype, Dim)));
+            if Dim = 1 then
+               Res := Dim_Length;
+            else
+               Res := New_Dyadic_Op (ON_Mul_Ov, Res, Dim_Length);
+            end if;
+         end loop;
+         return Res;
+      end Get_Array_Type_Length;
+
+      function Get_Array_Length (Arr : Mnode; Atype : Iir) return O_Enode
+      is
+         Index_List : Iir_List;
+         Index_Type : Iir;
+         Nbr_Dim : Natural;
+         Dim_Length : O_Enode;
+         Res : O_Enode;
+         Type_Info : Type_Info_Acc;
+         Binfo : Type_Info_Acc;
+         Index_Info : Type_Info_Acc;
+         B : Mnode;
+      begin
+         Index_List := Get_Index_Subtype_List (Atype);
+         Nbr_Dim := Get_Nbr_Elements (Index_List);
+
+         --  Handle thin array case.
+         Type_Info := Get_Info (Atype);
+         case Type_Info.Type_Mode is
+            when Type_Mode_Ptr_Array
+              | Type_Mode_Array =>
+               return Get_Array_Type_Length (Atype);
+            when Type_Mode_Fat_Array =>
+               null;
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         Binfo := Get_Info (Get_Base_Type (Atype));
+         for Dim in 1 .. Nbr_Dim loop
+            Index_Type := Get_Nth_Element (Index_List, Dim - 1);
+            Index_Info := Get_Info (Get_Base_Type (Index_Type));
+            B := Get_Array_Bounds (Arr);
+            Dim_Length :=
+              M2E (Range_To_Length (Bounds_To_Range (B, Atype, Dim)));
+            if Dim = 1 then
+               Res := Dim_Length;
+            else
+               Res := New_Dyadic_Op (ON_Mul_Ov, Res, Dim_Length);
+            end if;
+         end loop;
+         return Res;
+      end Get_Array_Length;
+
+      function Get_Array_Base (Arr : Mnode) return Mnode
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Type_Info (Arr);
+         case Info.Type_Mode is
+            when Type_Mode_Fat_Array
+              | Type_Mode_Fat_Acc =>
+               declare
+                  F : O_Fnode;
+                  Kind : Object_Kind_Type;
+               begin
+                  Kind := Get_Object_Kind (Arr);
+                  F := Info.T.Base_Field (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
+              | Type_Mode_Ptr_Array =>
+               return Arr;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Get_Array_Base;
+
+      function Index_Base (Base : Mnode; Atype : Iir; Index : O_Enode)
+        return Mnode
+      is
+         El_Type : Iir;
+      begin
+         El_Type := Get_Element_Subtype (Atype);
+         return Lo2M (New_Indexed_Element (M2Lv (Base), Index),
+                      Get_Info (El_Type), Get_Object_Kind (Base));
+      end Index_Base;
+
+      function Get_Array_Ptr_Base_Ptr
+        (Ptr : O_Lnode; Atype : Iir; Is_Sig : Object_Kind_Type)
+        return O_Lnode
+      is
+         Tinfo : Type_Info_Acc;
+      begin
+         Tinfo := Get_Info (Atype);
+         case Tinfo.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               return New_Selected_Element
+                 (New_Access_Element (New_Value (Ptr)),
+                  Tinfo.T.Base_Field (Is_Sig));
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               return Ptr;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Get_Array_Ptr_Base_Ptr;
+
+      function Get_Array_Ptr_Range_Ptr (Ptr : O_Lnode;
+                                        Array_Type : Iir;
+                                        Dim : Natural;
+                                        Is_Sig : Object_Kind_Type)
+        return O_Enode
+      is
+         Array_Info : Type_Info_Acc;
+         Res : O_Lnode;
+         Index_Type : Iir;
+         Index_Info : Type_Info_Acc;
+      begin
+         Array_Info := Get_Info (Array_Type);
+         Index_Type := Get_Nth_Element (Get_Index_Subtype_List (Array_Type),
+                                        Dim - 1);
+         Index_Info := Get_Info (Get_Base_Type (Index_Type));
+         case Array_Info.Type_Mode is
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               --  Extract bound variable.
+               Res := Get_Var (Array_Info.T.Array_Bounds);
+            when Type_Mode_Fat_Array =>
+               --  From fat record, extract bounds field.
+               Res := New_Acc_Value
+                 (New_Selected_Acc_Value
+                  (Ptr, Array_Info.T.Bounds_Field (Is_Sig)));
+            when others =>
+               raise Internal_Error;
+         end case;
+         --  Extract the range for the dimension.
+         Res := New_Selected_Element (Res, Array_Info.T.Bounds_Vector (Dim));
+         return New_Address (Res, Index_Info.T.Range_Ptr_Type);
+      end Get_Array_Ptr_Range_Ptr;
+
+      function Get_Array_Ptr_Bounds_Ptr
+        (Ptr : O_Lnode; Atype : Iir; Is_Sig : Object_Kind_Type)
+        return O_Enode
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Atype);
+         case Info.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               return New_Value
+                 (New_Selected_Element (New_Acc_Value (Ptr),
+                                        Info.T.Bounds_Field (Is_Sig)));
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               return New_Address (Get_Var (Info.T.Array_Bounds),
+                                   Info.T.Bounds_Ptr_Type);
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Get_Array_Ptr_Bounds_Ptr;
+
+      function Get_Array_Bounds_Ptr
+        (Arr : O_Lnode; Arr_Type : Iir; Is_Sig : Object_Kind_Type)
+        return O_Enode
+      is
+         Type_Info : Type_Info_Acc;
+      begin
+         Type_Info := Get_Info (Arr_Type);
+         case Type_Info.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               return New_Value (New_Selected_Element
+                                 (Arr, Type_Info.T.Bounds_Field (Is_Sig)));
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               return New_Address (Get_Var (Type_Info.T.Array_Bounds),
+                                   Type_Info.T.Bounds_Ptr_Type);
+            when others =>
+               --  Not an array!
+               raise Internal_Error;
+         end case;
+      end Get_Array_Bounds_Ptr;
+
+      procedure Allocate_Fat_Array_Base (Alloc_Kind : Allocation_Kind;
+                                         Res : Mnode;
+                                         Arr_Type : Iir)
+      is
+         Dinfo : Type_Info_Acc;
+         Length : O_Enode;
+         Kind : Object_Kind_Type;
+      begin
+         Kind := Get_Object_Kind (Res);
+         Dinfo := Get_Info (Get_Base_Type (Arr_Type));
+         --  Compute array size.
+         Length := Get_Object_Size (Res, Arr_Type);
+         --  Allocate the storage for the elements.
+         New_Assign_Stmt
+           (M2Lp (Chap3.Get_Array_Base (Res)),
+            Gen_Alloc (Alloc_Kind, Length, Dinfo.T.Base_Ptr_Type (Kind)));
+
+         if Dinfo.C /= null and then Dinfo.C.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;
+
+      function Get_Memory_Complex_1
+        (Ptr : O_Lnode; Obj_Type : Iir; Kind : Object_Kind_Type)
+        return O_Enode
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Obj_Type);
+         case Info.Type_Mode is
+            when Type_Mode_Ptr_Array =>
+               return New_Value (Ptr);
+            when Type_Mode_Array =>
+               return Get_Memory_Complex_1
+                 (New_Indexed_Element
+                  (Ptr, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, 0))),
+                  Get_Element_Subtype (Obj_Type),
+                  Kind);
+            when Type_Mode_Record =>
+               declare
+                  El : Iir_Element_Declaration;
+                  El_Type : Iir;
+                  El_Info : Type_Info_Acc;
+               begin
+                  El := Get_Element_Declaration_Chain
+                    (Get_Base_Type (Obj_Type));
+                  while El /= Null_Iir loop
+                     El_Type := Get_Type (El);
+                     El_Info := Get_Info (El_Type);
+                     if El_Info.C /= null then
+                        return Get_Memory_Complex_1
+                          (New_Selected_Element
+                           (Ptr, Get_Info (El).Field_Node (Kind)),
+                           El_Type,
+                           Kind);
+                     end if;
+                     El := Get_Chain (El);
+                  end loop;
+                  --  Record is known to be complex but has no complex
+                  --  element.
+                  raise Internal_Error;
+               end;
+            when Type_Mode_Scalar
+              | 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 Get_Memory_Complex_1;
+
+--      --  VAR_PTR is a pointer to an object of type OBJ_TYPE (and kind KIND).
+--       --  This object is known to be of a complex type.
+--       --  Return the value of the first internal pointer of the object.
+--       function Get_Memory_Complex
+--         (Var_Ptr : O_Lnode; Obj_Type : Iir; Kind : Object_Kind_Type)
+--         return O_Enode
+--       is
+--          Info : Type_Info_Acc;
+--          Res : O_Enode;
+--       begin
+--          Info := Get_Info (Obj_Type);
+--          case Info.Type_Mode is
+--             when Type_Mode_Fat_Array
+--               | Type_Mode_Array
+--               | Type_Mode_Ptr_Array =>
+--                Res := Get_Memory_Complex_1
+--                  (New_Indexed_Element
+--                   (New_Acc_Value (Get_Array_Ptr_Base_Ptr
+--                                   (Var_Ptr, Obj_Type, Kind)),
+--                    New_Unsigned_Literal (Ghdl_Index_Type, 0)),
+--                   Get_Element_Subtype (Obj_Type),
+--                   Kind);
+--             when Type_Mode_Record =>
+--                Res := Get_Memory_Complex_1
+--                  (New_Acc_Value (Var_Ptr), Obj_Type, Kind);
+--             when Type_Mode_Non_Composite
+--               | Type_Mode_Unknown =>
+--                --  Cannot be a complex type.
+--                raise Internal_Error;
+--          end case;
+--          return New_Convert_Ov (Res, Char_Ptr_Type_Node);
+--       end Get_Memory_Complex;
+
+      --  Copy SRC to DEST.
+      --  Both have the same type, OTYPE.
+      procedure Translate_Object_Copy (Dest : Mnode;
+                                       Src : O_Enode;
+                                       Obj_Type : Iir)
+      is
+         Info : Type_Info_Acc;
+         D : Mnode;
+         Kind : Object_Kind_Type;
+      begin
+         Kind := Get_Object_Kind (Dest);
+         Info := Get_Info (Obj_Type);
+         if Info.C /= null and then Info.C.Builder_Need_Func then
+            D := Stabilize (Dest);
+            --  A complex type that must be rebuilt.
+            --  Save destinaton.
+            --  Do the copy.
+            case Info.Type_Mode is
+               when Type_Mode_Fat_Array =>
+                  --  a fat array.
+                  Gen_Memcpy
+                    (M2Addr (Chap3.Get_Array_Base (D)),
+                     New_Value
+                     (New_Selected_Element (New_Access_Element (Src),
+                                            Info.T.Base_Field (Kind))),
+                     Get_Object_Size (Dest, Obj_Type));
+               when Type_Mode_Record
+                 | Type_Mode_Array
+                 | Type_Mode_Ptr_Array =>
+                  Gen_Memcpy (M2Addr (D),
+                              Src,
+                              Get_Object_Size (Dest, Obj_Type));
+               when Type_Mode_Unknown
+                 | Type_Mode_File
+                 | Type_Mode_Scalar
+                 | Type_Mode_Acc
+                 | Type_Mode_Fat_Acc
+                 | Type_Mode_Protected =>
+                  raise Internal_Error;
+            end case;
+            --  Rebuilt the type.
+            Gen_Call_Type_Builder (D, Obj_Type);
+         else
+            case Info.Type_Mode is
+               when Type_Mode_Scalar
+                 | Type_Mode_Acc
+                 | Type_Mode_File =>
+                  --  Scalar or thin pointer.
+                  New_Assign_Stmt (M2Lv (Dest), Src);
+               when Type_Mode_Fat_Acc =>
+                  --  a fat pointer.
+                  declare
+                     Var_S : O_Dnode;
+                     Var_D : O_Dnode;
+                  begin
+                     Var_S := Create_Temp_Init (Info.Ortho_Ptr_Type (Kind),
+                                                Src);
+                     Var_D := Create_Temp_Init (Info.Ortho_Ptr_Type (Kind),
+                                                M2Addr (Dest));
+                     Copy_Fat_Access (Var_D, Var_S, Get_Base_Type (Obj_Type));
+                  end;
+               when Type_Mode_Fat_Array =>
+                  --  a fat array.
+                  Gen_Memcpy
+                    (M2Addr (Get_Array_Base (Dest)),
+                     M2Addr (Get_Array_Base (E2M (Src, Info, Kind))),
+                     Get_Object_Size (Dest, Obj_Type));
+               when Type_Mode_Record
+                 | Type_Mode_Ptr_Array =>
+                  Gen_Memcpy
+                    (M2Addr (Dest), Src, Get_Object_Size (Dest, Obj_Type));
+               when Type_Mode_Array =>
+                  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 if;
+      end Translate_Object_Copy;
+
+      function Get_Object_Size (Obj : Mnode; Obj_Type : Iir)
+        return O_Enode
+      is
+         Type_Info : Type_Info_Acc;
+         Kind : Object_Kind_Type;
+      begin
+         Type_Info := Get_Type_Info (Obj);
+         Kind := Get_Object_Kind (Obj);
+         if Type_Info.C /= null
+           and then Type_Info.C.Size_Var (Kind) /= null
+         then
+            return New_Value (Get_Var (Type_Info.C.Size_Var (Kind)));
+         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 El_Tinfo.C /= null then
+                     Sz := New_Dyadic_Op
+                       (ON_Add_Ov,
+                        Sz,
+                        New_Lit (New_Sizeof (El_Tinfo.Ortho_Ptr_Type (Kind),
+                                             Ghdl_Index_Type)));
+                  end if;
+                  return New_Dyadic_Op
+                    (ON_Mul_Ov, Chap3.Get_Array_Length (Obj, Obj_Bt), Sz);
+               end;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Get_Object_Size;
+
+      procedure Translate_Object_Allocation
+        (Res : in out Mnode;
+         Alloc_Kind : Allocation_Kind;
+         Obj_Type : Iir;
+         Bounds : O_Enode)
+      is
+         Dinfo : Type_Info_Acc;
+         Kind : Object_Kind_Type;
+      begin
+         Dinfo := Get_Info (Obj_Type);
+         Kind := Get_Object_Kind (Res);
+         if Dinfo.Type_Mode = Type_Mode_Fat_Array then
+            --  Allocate memory for bounds.
+            New_Assign_Stmt
+              (M2Lp (Chap3.Get_Array_Bounds (Res)),
+               Gen_Alloc (Alloc_Kind,
+                          New_Lit (New_Sizeof (Dinfo.T.Bounds_Type,
+                                               Ghdl_Index_Type)),
+                          Dinfo.T.Bounds_Ptr_Type));
+
+            --  Copy bounds to the allocated area.
+            Gen_Memcpy
+              (M2Addr (Chap3.Get_Array_Bounds (Res)),
+               Bounds,
+               New_Lit (New_Sizeof (Dinfo.T.Bounds_Type, Ghdl_Index_Type)));
+
+            --  Allocate base.
+            Allocate_Fat_Array_Base (Alloc_Kind, Res, Obj_Type);
+         else
+            New_Assign_Stmt
+              (M2Lp (Res),
+               Gen_Alloc
+               (Alloc_Kind,
+                Chap3.Get_Object_Size (T2M (Obj_Type, Kind),
+                                       Obj_Type),
+                Dinfo.Ortho_Ptr_Type (Kind)));
+
+            if Dinfo.C /= null and then Dinfo.C.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 (Atype : Iir) return Boolean
+      is
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Atype);
+         if Info.T.Nocheck_Low and Info.T.Nocheck_Hi then
+            return False;
+         else
+            return True;
+         end if;
+      end Need_Range_Check;
+
+      procedure Check_Range (Value : O_Dnode; Expr : Iir; Atype : Iir)
+      is
+         If_Blk : O_If_Block;
+      begin
+         if not Need_Range_Check (Atype)
+           or else Get_Type (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 (Expr, Atype) then
+               Chap6.Gen_Bound_Error (Expr);
+            end if;
+         else
+            Open_Temp;
+            Start_If_Stmt (If_Blk, Not_In_Range (Value, Atype));
+            Chap6.Gen_Bound_Error (Null_Iir);
+            Finish_If_Stmt (If_Blk);
+            Close_Temp;
+         end if;
+      end Check_Range;
+
+      procedure Check_Array_Match (L_Type : Iir;
+                                   L_Node : O_Lnode;
+                                   L_Mode : Object_Kind_Type;
+                                   R_Type : Iir;
+                                   R_Node : O_Lnode;
+                                   R_Mode : Object_Kind_Type;
+                                   Loc : Iir)
+      is
+         L_Tinfo, R_Tinfo : Type_Info_Acc;
+      begin
+         L_Tinfo := Get_Info (L_Type);
+         R_Tinfo := Get_Info (R_Type);
+         if L_Tinfo.Type_Mode = Type_Mode_Array
+           and R_Tinfo.Type_Mode = Type_Mode_Array
+         then
+            --  Both left and right are thin array.
+            --  Check here the length are the same.
+            declare
+               L_Indexes : Iir_List;
+               R_Indexes : Iir_List;
+               L_El : Iir;
+               R_El : Iir;
+               Err : Boolean;
+            begin
+               L_Indexes := Get_Index_Subtype_List (L_Type);
+               R_Indexes := Get_Index_Subtype_List (R_Type);
+               Err := False;
+               for I in Natural loop
+                  L_El := Get_Nth_Element (L_Indexes, I);
+                  R_El := Get_Nth_Element (R_Indexes, I);
+                  exit when L_El = Null_Iir and R_El = Null_Iir;
+                  if Eval_Discrete_Type_Length (L_El)
+                    /= Eval_Discrete_Type_Length (R_El)
+                  then
+                     if not Err then
+                        Chap6.Gen_Bound_Error (Loc);
+                        Err := True;
+                     end if;
+                  end if;
+               end loop;
+            end;
+         else
+            --  Check length match.
+            declare
+               Index_List : Iir_List;
+               Index : Iir;
+               Cond : O_Enode;
+               Sub_Cond : O_Enode;
+            begin
+               Index_List := Get_Index_Subtype_List (L_Type);
+               for I in Natural loop
+                  Index := Get_Nth_Element (Index_List, I);
+                  exit when Index = Null_Iir;
+                  Sub_Cond := New_Compare_Op
+                    (ON_Neq,
+                     Chap6.Get_Array_Ptr_Bound_Length (L_Node, L_Type,
+                                                       I + 1, L_Mode),
+                     Chap6.Get_Array_Ptr_Bound_Length (R_Node, R_Type,
+                                                       I + 1, R_Mode),
+                     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 (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                           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 (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                           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)
+      is
+         Iinfo : Type_Info_Acc;
+         Op : ON_Op_Kind;
+         Diff : O_Enode;
+         Left_Bound : O_Enode;
+         Var_Right : O_Dnode;
+         If_Blk : O_If_Block;
+         Range_Constr : Iir;
+         Range_Expr : Iir;
+      begin
+         Iinfo := Get_Info (Index_Type);
+         Range_Constr := Get_Range_Constraint (Index_Type);
+         Range_Expr := Eval_Range (Range_Constr);
+         if Range_Expr = Null_Iir 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 (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                           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 (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                          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);
+         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 Tinfo.C /= null 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_Ptr_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;
+
+      --  Get the ortho type for an object of mode MODE.
+      function Get_Element_Type (Tinfo : Type_Info_Acc;
+                                 Kind : Object_Kind_Type)
+        return O_Tnode is
+      begin
+         if Tinfo.C /= null then
+            --  Always use a pointer for a complex type.
+            return Tinfo.Ortho_Ptr_Type (Kind);
+         else
+            return Tinfo.Ortho_Type (Kind);
+         end if;
+      end Get_Element_Type;
+
+      procedure Create_Object (El : Iir)
+      is
+         Obj_Type : O_Tnode;
+         Info : Object_Info_Acc;
+         Tinfo : Type_Info_Acc;
+         Def : Iir;
+         Val : Iir;
+         Storage : O_Storage;
+         Deferred : Iir;
+      begin
+         Def := Get_Type (El);
+         Val := Get_Default_Value (El);
+
+         --  Be sure the object type was translated.
+         if Get_Kind (El) = Iir_Kind_Constant_Declaration
+           and then Get_Deferred_Declaration_Flag (El) = False
+           and then Get_Deferred_Declaration (El) /= Null_Iir
+         then
+            --  This is a full constant declaration which complete a previous
+            --  incomplete constant declaration.
+            --
+            --  Do not create the subtype of this full constant declaration,
+            --  since it was already created by the deferred declaration.
+            --  Use the type of the deferred declaration.
+            Deferred := Get_Deferred_Declaration (El);
+            Def := Get_Type (Deferred);
+            Info := Get_Info (Deferred);
+            Set_Info (El, Info);
+         else
+            Chap3.Translate_Object_Subtype (El);
+            Info := Add_Info (El, Kind_Object);
+         end if;
+
+         Tinfo := Get_Info (Def);
+         Obj_Type := Get_Object_Type (Tinfo, Mode_Value);
+
+         case Get_Kind (El) is
+            when Iir_Kind_Variable_Declaration
+              | Iir_Kind_Constant_Interface_Declaration =>
+               Info.Object_Var := Create_Var (Create_Var_Identifier (El),
+                                              Obj_Type);
+            when Iir_Kind_Constant_Declaration =>
+               if Get_Deferred_Declaration (El) /= Null_Iir then
+                  --  This is a full constant declaration (in a body) of a
+                  --  deferred constant declaration (in a package).
+                  Storage := O_Storage_Public;
+               else
+                  Storage := Global_Storage;
+               end if;
+               if Info.Object_Var = null then
+                  --  Not a full constant declaration (ie a value for an
+                  --   already declared constant).
+                  --  Must create the declaration.
+                  if Get_Expr_Staticness (El) = Locally
+                    or else 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 ?
+
+                  --  Only required for transient types.
+                  --  FIXME: check this (why open/close_temp ?)
+                  Open_Temp;
+                  Define_Global_Const
+                    (Info.Object_Var,
+                     Chap7.Translate_Static_Expression (Val, Def));
+                  Close_Temp;
+               end if;
+            when others =>
+               Error_Kind ("create_objet", El);
+         end case;
+      end Create_Object;
+
+      procedure Create_Signal (Decl : Iir)
+      is
+         Sig_Type : O_Tnode;
+         Type_Info : Type_Info_Acc;
+         Info : Ortho_Info_Acc;
+         Sig_Type_Def : Iir;
+      begin
+         Sig_Type_Def := Get_Type (Decl);
+         Chap3.Translate_Object_Subtype (Decl);
+         Type_Info := Get_Info (Sig_Type_Def);
+         Sig_Type := Get_Object_Type (Type_Info, Mode_Signal);
+         if Sig_Type = O_Tnode_Null then
+            raise Internal_Error;
+         end if;
+
+         Info := Add_Info (Decl, Kind_Object);
+
+         Info.Object_Var := Create_Var
+           (Create_Var_Identifier (Decl), Sig_Type);
+
+         case Get_Kind (Decl) is
+            when Iir_Kind_Signal_Declaration
+              | Iir_Kind_Signal_Interface_Declaration =>
+               Rtis.Generate_Signal_Rti (Decl);
+            when Iir_Kind_Guard_Signal_Declaration =>
+               --  No name created for guard signal.
+               null;
+            when others =>
+               Error_Kind ("create_signal", Decl);
+         end case;
+      end Create_Signal;
+
+      procedure Create_Implicit_Signal (Decl : Iir)
+      is
+         Sig_Type : O_Tnode;
+         Type_Info : Type_Info_Acc;
+         Info : Ortho_Info_Acc;
+         Sig_Type_Def : Iir;
+      begin
+         Sig_Type_Def := Get_Type (Decl);
+         --  This has been disabled since DECL can have an anonymous subtype,
+         --  and DECL has no identifiers, which causes translate_object_subtype
+         --  to crash.
+         --  Note: DECL can only be a iir_kind_delayed_attribute.
+         --Chap3.Translate_Object_Subtype (Decl);
+         Type_Info := Get_Info (Sig_Type_Def);
+         Sig_Type := Type_Info.Ortho_Type (Mode_Signal);
+         if Sig_Type = O_Tnode_Null then
+            raise Internal_Error;
+         end if;
+
+         Info := Add_Info (Decl, Kind_Object);
+
+         Info.Object_Var := Create_Var (Create_Uniq_Identifier, Sig_Type);
+      end Create_Implicit_Signal;
+
+      procedure Create_File_Object (El : Iir_File_Declaration)
+      is
+         Obj_Type : O_Tnode;
+         Info : Ortho_Info_Acc;
+         Obj_Type_Def : Iir;
+      begin
+         Obj_Type_Def := Get_Type (El);
+         Obj_Type := Get_Ortho_Type (Obj_Type_Def, Mode_Value);
+
+         Info := Add_Info (El, Kind_Object);
+
+         Info.Object_Var := Create_Var (Create_Var_Identifier (El), Obj_Type);
+      end Create_File_Object;
+
+      procedure Allocate_Complex_Object (Obj_Type : Iir;
+                                         Alloc_Kind : Allocation_Kind;
+                                         Var : in out Mnode)
+      is
+         Type_Info : Type_Info_Acc;
+         Kind : Object_Kind_Type;
+         Targ : Mnode;
+      begin
+         Type_Info := Get_Type_Info (Var);
+         if Type_Info.Type_Mode = Type_Mode_Fat_Array then
+            --  Cannot allocate unconstrained object (since size is unknown).
+            raise Internal_Error;
+         end if;
+         Kind := Get_Object_Kind (Var);
+
+         if Type_Info.C = null then
+            --  Object is not complex.
+            return;
+         end if;
+
+         if Type_Info.C.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.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);
+
+         --  The object has already been allocated.
+         --  Call the initializator.
+         Start_Association (Assoc, Info.T.Prot_Init_Node);
+         Chap2.Add_Subprg_Instance_Assoc (Assoc, Info.T.Prot_Init_Instance,
+                                          Info.Ortho_Type (Mode_Value),
+                                          M2E (Obj));
+         New_Procedure_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_Node);
+         Chap2.Add_Subprg_Instance_Assoc (Assoc, Info.T.Prot_Final_Instance,
+                                          Info.Ortho_Type (Mode_Value),
+                                          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;
+               begin
+                  Open_Temp;
+                  Sobj := Stabilize (Obj);
+                  El := Get_Element_Declaration_Chain
+                    (Get_Base_Type (Obj_Type));
+                  while El /= Null_Iir loop
+                     Init_Object (Chap6.Translate_Selected_Element (Sobj, El),
+                                  Get_Type (El));
+                     El := Get_Chain (El);
+                  end loop;
+                  Close_Temp;
+               end;
+            when Type_Mode_Protected =>
+               Init_Protected_Object (Obj, Obj_Type);
+            when Type_Mode_Unknown
+              | Type_Mode_File =>
+               raise Internal_Error;
+         end case;
+      end Init_Object;
+
+      procedure Elab_Object_Storage (Obj : Iir)
+      is
+         Obj_Info : Object_Info_Acc;
+
+         Name_Node : Mnode;
+         Obj_Type : Iir;
+
+         Type_Info : Type_Info_Acc;
+         Alloc_Kind : Allocation_Kind;
+      begin
+         --  Elaborate subtype.
+         Obj_Type := Get_Type (Obj);
+         Chap3.Elab_Object_Subtype (Obj_Type);
+
+         Type_Info := Get_Info (Obj_Type);
+         Obj_Info := Get_Info (Obj);
+
+         --  FIXME: the object type may be a fat array!
+         --  FIXME: fat array + aggregate ?
+
+         if Type_Info.C /= null
+           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_Info : Object_Info_Acc;
+
+         Name_Node : Mnode;
+         Value_Node : O_Enode;
+         Obj_Type : Iir;
+
+         Type_Info : Type_Info_Acc;
+         Alloc_Kind : Allocation_Kind;
+      begin
+         --  Elaborate subtype.
+         Obj_Type := Get_Type (Obj);
+         Type_Info := Get_Info (Obj_Type);
+         Obj_Info := Get_Info (Obj);
+
+         Alloc_Kind := Get_Alloc_Kind_For_Var (Obj_Info.Object_Var);
+
+         Open_Temp;
+         if Value = Null_Iir then
+            --  Performs default initialization.
+            Init_Object (Name, Obj_Type);
+         elsif Get_Kind (Value) = Iir_Kind_Aggregate then
+            if Type_Info.Type_Mode = Type_Mode_Fat_Array then
+               --  Allocate.
+               declare
+                  Aggr_Type : Iir;
+               begin
+                  Aggr_Type := Get_Type (Value);
+                  Chap3.Create_Array_Subtype (Aggr_Type, True);
+                  Name_Node := Stabilize (Name);
+                  New_Assign_Stmt
+                    (New_Selected_Element
+                     (M2Lv (Name_Node), Type_Info.T.Bounds_Field (Mode_Value)),
+                     Chap3.Get_Array_Ptr_Bounds_Ptr (O_Lnode_Null, Aggr_Type,
+                                                     Mode_Value));
+                  Chap3.Allocate_Fat_Array_Base
+                    (Alloc_Kind, Name_Node, Get_Base_Type (Aggr_Type));
+               end;
+            else
+               Name_Node := Name;
+            end if;
+            Chap7.Translate_Aggregate (Name_Node, Obj_Type, Value);
+         else
+            Value_Node := Chap7.Translate_Expression (Value, Obj_Type);
+
+            if Type_Info.Type_Mode = Type_Mode_Fat_Array then
+               declare
+                  S : O_Dnode;
+               begin
+                  Name_Node := Stabilize (Name);
+                  S := Create_Temp_Init
+                    (Type_Info.Ortho_Ptr_Type (Mode_Value), Value_Node);
+
+                  if Get_Kind (Value) = Iir_Kind_String_Literal
+                    and then Get_Kind (Obj) = Iir_Kind_Constant_Declaration
+                  then
+                     --  No need to allocate space for the object.
+                     Copy_Fat_Pointer (Name_Node,
+                                       Dp2M (S, Type_Info, Mode_Value));
+                  else
+                     Chap3.Translate_Object_Allocation
+                       (Name_Node, Alloc_Kind, Obj_Type,
+                        Chap3.Get_Array_Ptr_Bounds_Ptr (New_Obj (S),
+                                                        Get_Type (Value),
+                                                        Mode_Value));
+                     Chap3.Translate_Object_Copy
+                       (Name_Node, New_Obj_Value (S), Obj_Type);
+                  end if;
+               end;
+            else
+               Chap3.Translate_Object_Copy (Name, Value_Node, Obj_Type);
+            end if;
+         end if;
+
+         Close_Temp;
+      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) = True 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 Type_Info.C /= null 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 : Type_Info_Acc;
+      begin
+         Info := Get_Info (Sig_Type);
+         case Info.Type_Mode is
+            when Type_Mode_Scalar =>
+               return New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, 1));
+            when Type_Mode_Arrays =>
+               return New_Dyadic_Op
+                 (ON_Mul_Ov,
+                  Chap3.Get_Array_Length (Sig, Sig_Type),
+                  Get_Nbr_Signals (Mnode_Null,
+                                   Get_Element_Subtype (Sig_Type)));
+            when Type_Mode_Record =>
+               declare
+                  El : Iir;
+                  Res : O_Enode;
+                  E : O_Enode;
+               begin
+                  El :=
+                    Get_Element_Declaration_Chain (Get_Base_Type (Sig_Type));
+                  Res := O_Enode_Null;
+                  while El /= Null_Iir loop
+                     E := Get_Nbr_Signals (Mnode_Null, Get_Type (El));
+                     if Res /= O_Enode_Null then
+                        Res := New_Dyadic_Op (ON_Add_Ov, Res, E);
+                     else
+                        Res := E;
+                     end if;
+                     El := Get_Chain (El);
+                  end loop;
+                  if Res = O_Enode_Null then
+                     return New_Lit (New_Unsigned_Literal
+                                     (Ghdl_Index_Type, 0));
+                  else
+                     return Res;
+                  end if;
+               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 (New_Unsigned_Literal (Ghdl_Index_Type, 0)));
+                  Res_Type := Get_Element_Subtype (Res_Type);
+               when Type_Mode_Record =>
+                  declare
+                     Element : Iir;
+                  begin
+                     Element := Get_Element_Declaration_Chain
+                       (Get_Base_Type (Res_Type));
+                     Res := Chap6.Translate_Selected_Element (Res, Element);
+                     Res_Type := Get_Type (Element);
+                  end;
+               when Type_Mode_Unknown
+                 | Type_Mode_File
+                 | Type_Mode_Acc
+                 | Type_Mode_Fat_Acc
+                 | Type_Mode_Protected =>
+                  raise Internal_Error;
+            end case;
+         end loop;
+      end Get_Leftest_Signal;
+
+      --  Add func and instance.
+      procedure Add_Associations_For_Resolver
+        (Assoc : in out O_Assoc_List; Func : Iir)
+      is
+         Func_Info : Subprg_Info_Acc;
+         Resolv_Info : Subprg_Resolv_Info_Acc;
+      begin
+         Func_Info := Get_Info (Get_Named_Entity (Func));
+         Resolv_Info := Func_Info.Subprg_Resolv;
+         New_Association
+           (Assoc, New_Lit (New_Subprogram_Address (Resolv_Info.Resolv_Func,
+                                                    Ghdl_Ptr_Type)));
+         if Resolv_Info.Resolv_Block /= Null_Iir then
+            New_Association
+              (Assoc,
+               New_Convert_Ov (Get_Instance_Access (Resolv_Info.Resolv_Block),
+                               Ghdl_Ptr_Type));
+         else
+            New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type)));
+         end if;
+      end Add_Associations_For_Resolver;
+
+      type O_If_Block_Acc is access O_If_Block;
+
+      type Elab_Signal_Data is record
+         --  Default value of the signal.
+         Val : Mnode;
+         --  If statement for a block of signals.
+         If_Stmt : O_If_Block_Acc;
+         --  True if the default value is set.
+         Has_Val : Boolean;
+         --  True if a resolution function was already attached.
+         Already_Resolved : Boolean;
+         --  True if the signal may already have been created.
+         Check_Null : Boolean;
+      end record;
+
+      procedure Elab_Signal_Non_Composite (Targ : Mnode;
+                                           Targ_Type : Iir;
+                                           Data : Elab_Signal_Data)
+      is
+         Type_Info : Type_Info_Acc;
+         Create_Subprg : O_Dnode;
+         Conv : O_Tnode;
+         Res : O_Enode;
+         Assoc : O_Assoc_List;
+         Init_Val : O_Enode;
+         --  For the resolution function (if any).
+         Func : Iir;
+         If_Stmt : O_If_Block;
+         Targ_Ptr : O_Dnode;
+      begin
+         Type_Info := Get_Info (Targ_Type);
+
+         if Data.Check_Null then
+            Targ_Ptr := Create_Temp_Init
+              (Ghdl_Signal_Ptr_Ptr,
+               New_Unchecked_Address (M2Lv (Targ), Ghdl_Signal_Ptr_Ptr));
+            Start_If_Stmt
+              (If_Stmt,
+               New_Compare_Op (ON_Eq,
+                               New_Value (New_Acc_Value (New_Obj (Targ_Ptr))),
+                               New_Lit (New_Null_Access (Ghdl_Signal_Ptr)),
+                               Ghdl_Bool_Type));
+         end if;
+
+         case Type_Info.Type_Mode is
+            when Type_Mode_B2 =>
+               Create_Subprg := Ghdl_Create_Signal_B2;
+               Conv := Ghdl_Bool_Type;
+            when Type_Mode_E8 =>
+               Create_Subprg := Ghdl_Create_Signal_E8;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_I32
+              | Type_Mode_P32 =>
+               Create_Subprg := Ghdl_Create_Signal_I32;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_P64
+              | Type_Mode_I64 =>
+               Create_Subprg := Ghdl_Create_Signal_I64;
+               Conv := Ghdl_I64_Type;
+            when Type_Mode_F64 =>
+               Create_Subprg := Ghdl_Create_Signal_F64;
+               Conv := Ghdl_Real_Type;
+            when others =>
+               Error_Kind ("elab_signal_non_composite", Targ_Type);
+         end case;
+
+         if Data.Has_Val then
+            Init_Val := M2E (Data.Val);
+         else
+            Init_Val := Chap14.Translate_Left_Type_Attribute (Targ_Type);
+         end if;
+
+         Start_Association (Assoc, Create_Subprg);
+         New_Association (Assoc, New_Convert_Ov (Init_Val, Conv));
+
+         if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then
+            Func := Get_Resolution_Function (Targ_Type);
+         else
+            Func := Null_Iir;
+         end if;
+         if Func /= Null_Iir and then not Data.Already_Resolved then
+            Add_Associations_For_Resolver (Assoc, Func);
+         else
+            New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type)));
+            New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type)));
+         end if;
+
+         Res := New_Function_Call (Assoc);
+
+         if Data.Check_Null then
+            New_Assign_Stmt (New_Acc_Value (New_Obj (Targ_Ptr)), Res);
+            Finish_If_Stmt (If_Stmt);
+         else
+            New_Assign_Stmt
+              (M2Lv (Targ),
+               New_Convert_Ov (Res, Type_Info.Ortho_Type (Mode_Signal)));
+         end if;
+      end Elab_Signal_Non_Composite;
+
+      function Elab_Signal_Prepare_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Elab_Signal_Data)
+        return Elab_Signal_Data
+      is
+         Assoc : O_Assoc_List;
+         Func : Iir;
+         Res : Elab_Signal_Data;
+      begin
+         Res := Data;
+         if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then
+            Func := Get_Resolution_Function (Targ_Type);
+            if Func /= Null_Iir and then not Data.Already_Resolved then
+               if Data.Check_Null then
+                  Res.If_Stmt := new O_If_Block;
+                  Start_If_Stmt
+                    (Res.If_Stmt.all,
+                     New_Compare_Op
+                     (ON_Eq,
+                      New_Convert_Ov (M2E (Get_Leftest_Signal (Targ,
+                                                               Targ_Type)),
+                                      Ghdl_Signal_Ptr),
+                      New_Lit (New_Null_Access (Ghdl_Signal_Ptr)),
+                      Ghdl_Bool_Type));
+                  --Res.Check_Null := False;
+               end if;
+               --  Add resolver.
+               Start_Association (Assoc, Ghdl_Signal_Create_Resolution);
+               Add_Associations_For_Resolver (Assoc, Func);
+               New_Association
+                 (Assoc, New_Convert_Ov (M2Addr (Targ), Ghdl_Ptr_Type));
+               New_Association (Assoc, Get_Nbr_Signals (Targ, Targ_Type));
+               New_Procedure_Call (Assoc);
+               Res.Already_Resolved := True;
+            end if;
+         end if;
+         if Data.Has_Val then
+            if Get_Type_Info (Data.Val).Type_Mode = Type_Mode_Record then
+               Res.Val := Stabilize (Data.Val);
+            else
+               Res.Val := Chap3.Get_Array_Base (Data.Val);
+            end if;
+         end if;
+         return Res;
+      end Elab_Signal_Prepare_Composite;
+
+      procedure Elab_Signal_Finish_Composite (Data : in out Elab_Signal_Data)
+      is
+         procedure Free is new Ada.Unchecked_Deallocation
+           (Object => O_If_Block, Name => O_If_Block_Acc);
+      begin
+         if Data.If_Stmt /= null then
+            Finish_If_Stmt (Data.If_Stmt.all);
+            Free (Data.If_Stmt);
+         end if;
+      end Elab_Signal_Finish_Composite;
+
+      function Elab_Signal_Update_Array (Data : Elab_Signal_Data;
+                                         Targ_Type : Iir;
+                                         Index : O_Dnode)
+        return Elab_Signal_Data
+      is
+      begin
+         if not Data.Has_Val then
+            return Data;
+         else
+            return Elab_Signal_Data'
+              (Val => Chap3.Index_Base (Data.Val, Targ_Type,
+                                        New_Obj_Value (Index)),
+               Has_Val => True,
+               If_Stmt => null,
+               Already_Resolved => Data.Already_Resolved,
+               Check_Null => Data.Check_Null);
+         end if;
+      end Elab_Signal_Update_Array;
+
+      function Elab_Signal_Update_Record (Data : Elab_Signal_Data;
+                                          Targ_Type : Iir;
+                                          El : Iir_Element_Declaration)
+        return Elab_Signal_Data
+      is
+         pragma Unreferenced (Targ_Type);
+      begin
+         if not Data.Has_Val then
+            return Data;
+         else
+            return Elab_Signal_Data'
+              (Val => Chap6.Translate_Selected_Element (Data.Val, El),
+               Has_Val => True,
+               If_Stmt => null,
+               Already_Resolved => Data.Already_Resolved,
+               Check_Null => Data.Check_Null);
+         end if;
+      end Elab_Signal_Update_Record;
+
+      procedure Elab_Signal is new Foreach_Non_Composite
+        (Data_Type => Elab_Signal_Data,
+         Composite_Data_Type => Elab_Signal_Data,
+         Do_Non_Composite => Elab_Signal_Non_Composite,
+         Prepare_Data_Array => Elab_Signal_Prepare_Composite,
+         Update_Data_Array => Elab_Signal_Update_Array,
+         Finish_Data_Array => Elab_Signal_Finish_Composite,
+         Prepare_Data_Record => Elab_Signal_Prepare_Composite,
+         Update_Data_Record => Elab_Signal_Update_Record,
+         Finish_Data_Record => Elab_Signal_Finish_Composite);
+
+      --  Elaborate signal subtypes and allocate the storage for the object.
+      procedure Elab_Signal_Declaration_Storage (Decl : Iir)
+      is
+         Sig_Type : Iir;
+         Type_Info : Type_Info_Acc;
+         Name_Node : Mnode;
+      begin
+         New_Debug_Line_Stmt (Get_Line_Number (Decl));
+
+         Open_Temp;
+
+         Sig_Type := Get_Type (Decl);
+         Chap3.Elab_Object_Subtype (Sig_Type);
+         Type_Info := Get_Info (Sig_Type);
+
+         if Type_Info.Type_Mode = Type_Mode_Fat_Array then
+            Name_Node := Chap6.Translate_Name (Decl);
+            Name_Node := Stabilize (Name_Node);
+            Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Node, Sig_Type);
+         elsif Type_Info.C /= null 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;
+
+      --  Create signal object.
+      --  Note: DECL 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
+        (Decl : Iir; Parent : Iir; Check_Null : Boolean)
+      is
+         Sig_Type : Iir;
+         Type_Info : Type_Info_Acc;
+         Name_Node : Mnode;
+         Val : Iir;
+         Data : Elab_Signal_Data;
+         Base_Decl : Iir;
+      begin
+         New_Debug_Line_Stmt (Get_Line_Number (Decl));
+
+         Open_Temp;
+
+         Sig_Type := Get_Type (Decl);
+         Type_Info := Get_Info (Sig_Type);
+         Base_Decl := Get_Base_Name (Decl);
+
+         --  Set the name of the signal.
+         declare
+            Assoc : O_Assoc_List;
+         begin
+            Start_Association (Assoc, Ghdl_Signal_Name_Rti);
+            New_Association
+              (Assoc,
+               New_Lit (New_Global_Unchecked_Address
+                        (Get_Info (Base_Decl).Object_Rti,
+                         Rtis.Ghdl_Rti_Access)));
+            Rtis.Associate_Rti_Context (Assoc, Parent);
+            New_Procedure_Call (Assoc);
+         end;
+
+         Name_Node := Chap6.Translate_Name (Decl);
+         if Get_Object_Kind (Name_Node) /= Mode_Signal then
+            raise Internal_Error;
+         end if;
+
+         if Decl = Base_Decl then
+            Data.Already_Resolved := False;
+            Data.Check_Null := Check_Null;
+            Val := Get_Default_Value (Base_Decl);
+            if Val = Null_Iir then
+               Data.Has_Val := False;
+            else
+               Data.Has_Val := True;
+               Data.Val := E2M (Chap7.Translate_Expression (Val, Sig_Type),
+                                Get_Info (Sig_Type),
+                                Mode_Value);
+            end if;
+         else
+            --  Sub signal.
+            --  Do not add resolver.
+            --  Do not use default value.
+            Data.Already_Resolved := True;
+            Data.Has_Val := False;
+            Data.Check_Null := False;
+         end if;
+         Elab_Signal (Name_Node, Sig_Type, Data);
+
+         Close_Temp;
+      end Elab_Signal_Declaration_Object;
+
+      procedure Elab_Signal_Declaration
+        (Decl : Iir; Parent : Iir; Check_Null : Boolean)
+      is
+      begin
+         Elab_Signal_Declaration_Storage (Decl);
+         Elab_Signal_Declaration_Object (Decl, Parent, Check_Null);
+      end Elab_Signal_Declaration;
+
+      procedure Elab_Signal_Attribute (Decl : Iir)
+      is
+         Assoc : O_Assoc_List;
+         Dtype : Iir;
+         Type_Info : Type_Info_Acc;
+         Info : Object_Info_Acc;
+         Prefix : Iir;
+         Prefix_Node : Mnode;
+         Res : O_Enode;
+         Val : O_Enode;
+         Param : Iir;
+         Subprg : O_Dnode;
+      begin
+         New_Debug_Line_Stmt (Get_Line_Number (Decl));
+
+         Info := Get_Info (Decl);
+         Dtype := Get_Type (Decl);
+         Type_Info := Get_Info (Dtype);
+         --  Create the signal (with the time)
+         case Get_Kind (Decl) is
+            when Iir_Kind_Stable_Attribute =>
+               Subprg := Ghdl_Create_Stable_Signal;
+            when Iir_Kind_Quiet_Attribute =>
+               Subprg := Ghdl_Create_Quiet_Signal;
+            when Iir_Kind_Transaction_Attribute =>
+               Subprg := Ghdl_Create_Transaction_Signal;
+            when others =>
+               Error_Kind ("elab_signal_attribute", Decl);
+         end case;
+         Start_Association (Assoc, Subprg);
+         case Get_Kind (Decl) is
+            when Iir_Kind_Stable_Attribute
+              | Iir_Kind_Quiet_Attribute =>
+               Param := Get_Parameter (Decl);
+               if Param = Null_Iir then
+                  Val := New_Lit (New_Signed_Literal (Std_Time_Type, 0));
+               else
+                  Val := Chap7.Translate_Expression (Param);
+               end if;
+               New_Association (Assoc, Val);
+            when others =>
+               null;
+         end case;
+         Res := New_Convert_Ov (New_Function_Call (Assoc),
+                                Type_Info.Ortho_Type (Mode_Signal));
+         New_Assign_Stmt (Get_Var (Info.Object_Var), Res);
+
+         --  Register all signals this depends on.
+         Prefix := Get_Prefix (Decl);
+         Prefix_Node := Chap6.Translate_Name (Prefix);
+         Register_Signal (Prefix_Node, Get_Type (Prefix),
+                          Ghdl_Signal_Attribute_Register_Prefix);
+      end Elab_Signal_Attribute;
+
+      type Delayed_Signal_Data is record
+         Pfx : Mnode;
+         Param : Iir;
+      end record;
+
+      procedure Create_Delayed_Signal_Noncomposite
+        (Targ : Mnode; Targ_Type : Iir; Data : Delayed_Signal_Data)
+      is
+         pragma Unreferenced (Targ_Type);
+         Assoc : O_Assoc_List;
+         Type_Info : Type_Info_Acc;
+         Val : O_Enode;
+      begin
+         Start_Association (Assoc, Ghdl_Create_Delayed_Signal);
+         New_Association
+           (Assoc,
+            New_Convert_Ov (New_Value (M2Lv (Data.Pfx)), Ghdl_Signal_Ptr));
+         if Data.Param = Null_Iir then
+            Val := New_Lit (New_Signed_Literal (Std_Time_Type, 0));
+         else
+            Val := Chap7.Translate_Expression (Data.Param);
+         end if;
+         New_Association (Assoc, Val);
+         Type_Info := Get_Type_Info (Targ);
+         New_Assign_Stmt
+           (M2Lv (Targ),
+            New_Convert_Ov (New_Function_Call (Assoc),
+                            Type_Info.Ortho_Type (Mode_Signal)));
+      end Create_Delayed_Signal_Noncomposite;
+
+      function Create_Delayed_Signal_Prepare_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Delayed_Signal_Data)
+        return Delayed_Signal_Data
+      is
+         pragma Unreferenced (Targ_Type);
+         Res : Delayed_Signal_Data;
+      begin
+         Res.Param := Data.Param;
+         if Get_Type_Info (Targ).Type_Mode = Type_Mode_Record then
+            Res.Pfx := Stabilize (Data.Pfx);
+         else
+            Res.Pfx := Chap3.Get_Array_Base (Data.Pfx);
+         end if;
+         return Res;
+      end Create_Delayed_Signal_Prepare_Composite;
+
+      function Create_Delayed_Signal_Update_Data_Array
+        (Data : Delayed_Signal_Data; Targ_Type : Iir; Index : O_Dnode)
+        return Delayed_Signal_Data
+      is
+      begin
+         return Delayed_Signal_Data'
+           (Pfx => Chap3.Index_Base (Data.Pfx, Targ_Type,
+                                     New_Obj_Value (Index)),
+            Param => Data.Param);
+      end Create_Delayed_Signal_Update_Data_Array;
+
+      function Create_Delayed_Signal_Update_Data_Record
+        (Data : Delayed_Signal_Data;
+         Targ_Type : Iir;
+         El : Iir_Element_Declaration)
+        return Delayed_Signal_Data
+      is
+         pragma Unreferenced (Targ_Type);
+      begin
+         return Delayed_Signal_Data'
+           (Pfx => Chap6.Translate_Selected_Element (Data.Pfx, El),
+            Param => Data.Param);
+      end Create_Delayed_Signal_Update_Data_Record;
+
+      procedure Create_Delayed_Signal_Finish_Data_Composite
+        (Data : in out Delayed_Signal_Data)
+      is
+         pragma Unreferenced (Data);
+      begin
+         null;
+      end Create_Delayed_Signal_Finish_Data_Composite;
+
+      procedure Create_Delayed_Signal is new Foreach_Non_Composite
+        (Data_Type => Delayed_Signal_Data,
+         Composite_Data_Type => Delayed_Signal_Data,
+         Do_Non_Composite => Create_Delayed_Signal_Noncomposite,
+         Prepare_Data_Array => Create_Delayed_Signal_Prepare_Composite,
+         Update_Data_Array => Create_Delayed_Signal_Update_Data_Array,
+         Finish_Data_Array => Create_Delayed_Signal_Finish_Data_Composite,
+         Prepare_Data_Record => Create_Delayed_Signal_Prepare_Composite,
+         Update_Data_Record => Create_Delayed_Signal_Update_Data_Record,
+         Finish_Data_Record => Create_Delayed_Signal_Finish_Data_Composite);
+
+      procedure Elab_Signal_Delayed_Attribute (Decl : Iir)
+      is
+         Name_Node : Mnode;
+         Sig_Type : Iir;
+         Type_Info : Type_Info_Acc;
+         Pfx_Node : Mnode;
+         Data: Delayed_Signal_Data;
+      begin
+         Name_Node := Chap6.Translate_Name (Decl);
+         Sig_Type := Get_Type (Decl);
+         Type_Info := Get_Info (Sig_Type);
+
+         if Type_Info.C /= null 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 (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 (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 (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);
+         if Decl_Type = Null_Iir then
+            --  FIXME : todo.
+            raise Internal_Error;
+         end if;
+
+         Chap3.Translate_Named_Type_Definition
+           (Decl_Type, Get_Identifier (Decl));
+
+         Info := Add_Info (Decl, Kind_Alias);
+         case Get_Kind (Get_Base_Name (Decl)) is
+            when Iir_Kind_Signal_Declaration
+              | Iir_Kind_Signal_Interface_Declaration
+              | Iir_Kind_Guard_Signal_Declaration =>
+               Info.Alias_Kind := Mode_Signal;
+            when others =>
+               Info.Alias_Kind := Mode_Value;
+         end case;
+
+         Tinfo := Get_Info (Decl_Type);
+         case Tinfo.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               --  create an object.
+               --  At elaboration: copy base from name, copy bounds from type,
+               --   check for matching bounds.
+               Atype := Get_Ortho_Type (Decl_Type, Info.Alias_Kind);
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               --  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 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;
+         N_Info : Type_Info_Acc;
+         Alias_Info : Alias_Info_Acc;
+         Name_Type : Iir;
+         Tinfo : Type_Info_Acc;
+         Kind : Object_Kind_Type;
+      begin
+         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);
+         --  Evaluate names.
+         Name_Node := Chap6.Translate_Name (Name);
+         Kind := Get_Object_Kind (Name_Node);
+         N_Info := Get_Info (Name_Type);
+         --Chap6.Translate_Name (Decl, Decl_Node, Sig);
+
+         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
+              | Type_Mode_Ptr_Array =>
+               Open_Temp;
+               Stabilize (Name_Node);
+               New_Assign_Stmt
+                 (Get_Var (Alias_Info.Alias_Var),
+                  New_Value (M2Lp (Chap3.Get_Array_Base (Name_Node))));
+               Chap3.Check_Array_Match (Decl_Type, O_Lnode_Null, Kind,
+                                        Name_Type, M2Lp (Name_Node), Kind,
+                                        Decl);
+               Close_Temp;
+            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 others =>
+               raise Internal_Error;
+         end case;
+      end Elab_Object_Alias_Declaration;
+
+      procedure Translate_Port_Chain (Parent : Iir)
+      is
+         Port : Iir;
+      begin
+         Port := Get_Port_Chain (Parent);
+         while Port /= Null_Iir loop
+            Create_Signal (Port);
+            Port := Get_Chain (Port);
+         end loop;
+      end Translate_Port_Chain;
+
+      procedure Translate_Generic_Chain (Parent : Iir)
+      is
+         Decl : Iir;
+      begin
+         Decl := Get_Generic_Chain (Parent);
+         while Decl /= Null_Iir loop
+            Create_Object (Decl);
+            Decl := Get_Chain (Decl);
+         end loop;
+      end Translate_Generic_Chain;
+
+      --  Create instance record for a component.
+      procedure Translate_Component_Declaration (Decl : Iir)
+      is
+         Mark : Id_Mark_Type;
+         Info : Ortho_Info_Acc;
+      begin
+         Info := Add_Info (Decl, Kind_Component);
+         Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+         Push_Instance_Factory (O_Tnode_Null);
+
+         Info.Comp_Link := Add_Instance_Factory_Field
+           (Wki_Instance, Rtis.Ghdl_Component_Link_Type);
+
+         --  Generic and ports.
+         Translate_Generic_Chain (Decl);
+         Translate_Port_Chain (Decl);
+
+         Pop_Instance_Factory (Info.Comp_Type);
+         New_Type_Decl (Create_Identifier ("_COMPTYPE"), Info.Comp_Type);
+         Info.Comp_Ptr_Type := New_Access_Type (Info.Comp_Type);
+         New_Type_Decl (Create_Identifier ("_COMPPTR"), Info.Comp_Ptr_Type);
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Component_Declaration;
+
+      procedure Translate_Declaration (Decl : Iir)
+      is
+      begin
+         case Get_Kind (Decl) is
+            when Iir_Kind_Use_Clause =>
+               null;
+            when Iir_Kind_Configuration_Specification =>
+               null;
+            when Iir_Kind_Disconnection_Specification =>
+               null;
+
+            when Iir_Kind_Component_Declaration =>
+               Chap4.Translate_Component_Declaration (Decl);
+            when Iir_Kind_Type_Declaration =>
+               Chap4.Translate_Type_Declaration (Decl);
+            when Iir_Kind_Anonymous_Type_Declaration =>
+               Chap4.Translate_Anonymous_Type_Declaration (Decl);
+            when Iir_Kind_Subtype_Declaration =>
+               Chap4.Translate_Subtype_Declaration (Decl);
+
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               raise Internal_Error;
+            when Iir_Kind_Function_Body
+              | Iir_Kind_Procedure_Body =>
+               null;
+
+            when Iir_Kind_Protected_Type_Body =>
+               Chap3.Translate_Protected_Type_Body (Decl);
+
+            --when Iir_Kind_Implicit_Function_Declaration =>
+            --when Iir_Kind_Signal_Declaration
+            --  | Iir_Kind_Signal_Interface_Declaration =>
+               --   Chap4.Create_Object (Decl);
+
+            when Iir_Kind_Variable_Declaration
+              | Iir_Kind_Constant_Declaration =>
+               Create_Object (Decl);
+
+            when Iir_Kind_Signal_Declaration =>
+               Create_Signal (Decl);
+
+            when Iir_Kind_Object_Alias_Declaration =>
+               Translate_Object_Alias_Declaration (Decl);
+
+            when Iir_Kind_Non_Object_Alias_Declaration =>
+               null;
+
+            when Iir_Kind_File_Declaration =>
+               Create_File_Object (Decl);
+
+            when Iir_Kind_Attribute_Declaration =>
+               Chap3.Translate_Object_Subtype (Decl);
+
+            when Iir_Kind_Attribute_Specification =>
+               Chap5.Translate_Attribute_Specification (Decl);
+
+            when Iir_Kinds_Signal_Attribute =>
+               Chap4.Create_Implicit_Signal (Decl);
+
+            when Iir_Kind_Guard_Signal_Declaration =>
+               Create_Signal (Decl);
+
+            when Iir_Kind_Group_Template_Declaration =>
+               null;
+            when Iir_Kind_Group_Declaration =>
+               null;
+
+            when others =>
+               Error_Kind ("translate_declaration", Decl);
+         end case;
+      end Translate_Declaration;
+
+      --  Mark FUNC (by adding the subprg_resolv info) iif it can be a
+      --  resolution function.
+      procedure Check_Resolution_Function (Func : Iir)
+      is
+         Param : Iir;
+         Param_Type : Iir;
+         Res_Type : Iir;
+         Info : Subprg_Info_Acc;
+      begin
+         Param := Get_Interface_Declaration_Chain (Func);
+
+         --  Return now if the number of parameters is not 1.
+         if Param = Null_Iir or else Get_Chain (Param) /= Null_Iir then
+            return;
+         end if;
+         Param_Type := Get_Type (Param);
+         case Get_Kind (Param_Type) is
+            when Iir_Kind_Array_Type_Definition
+              | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+               null;
+            when others =>
+               return;
+         end case;
+         Res_Type := Get_Return_Type (Func);
+         if Get_Base_Type (Get_Element_Subtype (Param_Type))
+           /= Get_Base_Type (Res_Type)
+         then
+            return;
+         end if;
+         --  FUNC can be a resolution function.
+         Info := Get_Info (Func);
+         Info.Subprg_Resolv := new Subprg_Resolv_Info;
+      end Check_Resolution_Function;
+
+      procedure Translate_Resolution_Function (Func : Iir; Block : Iir)
+      is
+         --  Type of the resolution function parameter.
+         El_Type : Iir;
+         El_Info : Type_Info_Acc;
+         Finfo : Subprg_Info_Acc;
+         Interface_List : O_Inter_List;
+         Rinfo : Subprg_Resolv_Info_Acc;
+         Block_Info : Block_Info_Acc;
+         Id : O_Ident;
+         Itype : O_Tnode;
+      begin
+         Finfo := Get_Info (Func);
+         Rinfo := Finfo.Subprg_Resolv;
+         if Rinfo = null then
+            return;
+         end if;
+
+         --  Declare the procedure.
+         Id := Create_Identifier (Func, Get_Overload_Number (Func), "_RESOLV");
+         Start_Procedure_Decl (Interface_List, Id, Global_Storage);
+
+         --  The instance.
+         if Block /= Null_Iir then --and then Get_Pure_Flag (Func) = False then
+            Block_Info := Get_Info (Block);
+            Rinfo.Resolv_Block := Block;
+            Itype := Block_Info.Block_Decls_Ptr_Type;
+         else
+            Rinfo.Resolv_Block := Null_Iir;
+            Itype := Ghdl_Ptr_Type;
+         end if;
+         New_Interface_Decl
+           (Interface_List, Rinfo.Var_Instance, Wki_Instance, Itype);
+
+         --  The signal.
+         El_Type := Get_Return_Type (Func);
+         El_Info := Get_Info (El_Type);
+         case El_Info.Type_Mode is
+            when Type_Mode_Thin =>
+               Itype := El_Info.Ortho_Type (Mode_Signal);
+            when Type_Mode_Fat =>
+               Itype := El_Info.Ortho_Ptr_Type (Mode_Signal);
+            when Type_Mode_Unknown =>
+               raise Internal_Error;
+         end case;
+         New_Interface_Decl
+           (Interface_List, Rinfo.Var_Vals, Get_Identifier ("VALS"), Itype);
+
+         New_Interface_Decl
+           (Interface_List, Rinfo.Var_Vec, Get_Identifier ("bool_vec"),
+            Ghdl_Bool_Array_Ptr);
+         New_Interface_Decl
+           (Interface_List, Rinfo.Var_Vlen, Get_Identifier ("vec_len"),
+            Ghdl_Index_Type);
+         New_Interface_Decl
+           (Interface_List, Rinfo.Var_Nbr_Drv, Get_Identifier ("nbr_drv"),
+            Ghdl_Index_Type);
+         New_Interface_Decl
+           (Interface_List, Rinfo.Var_Nbr_Ports, Get_Identifier ("nbr_ports"),
+            Ghdl_Index_Type);
+
+         Finish_Subprogram_Decl (Interface_List, Rinfo.Resolv_Func);
+      end Translate_Resolution_Function;
+
+      type Read_Source_Kind is (Read_Port, Read_Driver);
+      type Read_Source_Data is record
+         Sig : Mnode;
+         Drv_Index : O_Dnode;
+         Kind : Read_Source_Kind;
+      end record;
+
+      procedure Read_Source_Non_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Read_Source_Data)
+      is
+         Assoc : O_Assoc_List;
+         Targ_Info : Type_Info_Acc;
+         E : O_Enode;
+      begin
+         Targ_Info := Get_Info (Targ_Type);
+         case Data.Kind is
+            when Read_Port =>
+               Start_Association (Assoc, Ghdl_Signal_Read_Port);
+            when Read_Driver =>
+               Start_Association (Assoc, Ghdl_Signal_Read_Driver);
+         end case;
+
+         New_Association
+           (Assoc, New_Convert_Ov (M2E (Data.Sig), Ghdl_Signal_Ptr));
+         New_Association (Assoc, New_Obj_Value (Data.Drv_Index));
+         E := New_Convert_Ov (New_Function_Call (Assoc),
+                              Targ_Info.Ortho_Ptr_Type (Mode_Value));
+         New_Assign_Stmt (M2Lv (Targ),
+                          New_Value (New_Access_Element (E)));
+      end Read_Source_Non_Composite;
+
+      function Read_Source_Prepare_Data_Array
+        (Targ: Mnode; Targ_Type : Iir; Data : Read_Source_Data)
+        return Read_Source_Data
+      is
+         pragma Unreferenced (Targ, Targ_Type);
+      begin
+         return Data;
+      end Read_Source_Prepare_Data_Array;
+
+      function Read_Source_Prepare_Data_Record
+        (Targ : Mnode; Targ_Type : Iir; Data : Read_Source_Data)
+        return Read_Source_Data
+      is
+         pragma Unreferenced (Targ, Targ_Type);
+      begin
+         return Read_Source_Data'(Sig => Stabilize (Data.Sig),
+                                  Drv_Index => Data.Drv_Index,
+                                  Kind => Data.Kind);
+      end Read_Source_Prepare_Data_Record;
+
+      function Read_Source_Update_Data_Array
+        (Data : Read_Source_Data; Targ_Type : Iir; Index : O_Dnode)
+        return Read_Source_Data
+      is
+      begin
+         return Read_Source_Data'
+           (Sig => Chap3.Index_Base (Data.Sig, Targ_Type,
+                                     New_Obj_Value (Index)),
+            Drv_Index => Data.Drv_Index,
+            Kind => Data.Kind);
+      end Read_Source_Update_Data_Array;
+
+      function Read_Source_Update_Data_Record
+        (Data : Read_Source_Data;
+         Targ_Type : Iir;
+         El : Iir_Element_Declaration)
+        return Read_Source_Data
+      is
+         pragma Unreferenced (Targ_Type);
+      begin
+         return Read_Source_Data'
+           (Sig => Chap6.Translate_Selected_Element (Data.Sig, El),
+            Drv_Index => Data.Drv_Index,
+            Kind => Data.Kind);
+      end Read_Source_Update_Data_Record;
+
+      procedure Read_Source_Finish_Data_Composite
+        (Data : in out Read_Source_Data)
+      is
+         pragma Unreferenced (Data);
+      begin
+         null;
+      end Read_Source_Finish_Data_Composite;
+
+      procedure Read_Signal_Source is new Foreach_Non_Composite
+        (Data_Type => Read_Source_Data,
+         Composite_Data_Type => Read_Source_Data,
+         Do_Non_Composite => Read_Source_Non_Composite,
+         Prepare_Data_Array => Read_Source_Prepare_Data_Array,
+         Update_Data_Array => Read_Source_Update_Data_Array,
+         Finish_Data_Array => Read_Source_Finish_Data_Composite,
+         Prepare_Data_Record => Read_Source_Prepare_Data_Record,
+         Update_Data_Record => Read_Source_Update_Data_Record,
+         Finish_Data_Record => Read_Source_Finish_Data_Composite);
+
+      procedure Translate_Resolution_Function_Body (Func : Iir; Block : Iir)
+      is
+         --  Type of the resolution function parameter.
+         Arr_Type : Iir;
+         Base_Type, El_Type : Iir;
+         El_Info : Type_Info_Acc;
+         Base_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 : Subprg_Info_Acc;
+         Assoc : O_Assoc_List;
+         Rinfo : Subprg_Resolv_Info_Acc;
+         Block_Info : Block_Info_Acc;
+
+         Data : Read_Source_Data;
+      begin
+         Finfo := Get_Info (Func);
+         Rinfo := Finfo.Subprg_Resolv;
+         if Rinfo = null then
+            return;
+         end if;
+
+         El_Type := Get_Return_Type (Func);
+         El_Info := Get_Info (El_Type);
+
+         Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Func));
+         Base_Type := Get_Base_Type (Arr_Type);
+         Base_Info := Get_Info (Base_Type);
+
+         Index_Type := Get_First_Element (Get_Index_Subtype_List (Arr_Type));
+         Index_Tinfo := Get_Info (Index_Type);
+
+         Start_Subprogram_Body (Rinfo.Resolv_Func);
+         if Rinfo.Resolv_Block /= Null_Iir then
+            Block_Info := Get_Info (Block);
+            Push_Scope (Block_Info.Block_Decls_Type, Rinfo.Var_Instance);
+         end if;
+         Push_Local_Factory;
+
+         --  A signal.
+
+         New_Var_Decl (Var_Res, Get_Identifier ("res"),
+                       O_Storage_Local, El_Info.Ortho_Type (Mode_Value));
+
+         --  I, J.
+         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
+         New_Var_Decl (Var_J, Get_Identifier ("J"),
+                       O_Storage_Local, Ghdl_Index_Type);
+
+         --  Length.
+         New_Var_Decl
+           (Var_Length, Wki_Length, O_Storage_Local, Ghdl_Index_Type);
+
+         New_Var_Decl (Var_Bound, Get_Identifier ("BOUND"), O_Storage_Local,
+                       Base_Info.T.Bounds_Type);
+         New_Var_Decl (Var_Array, Get_Identifier ("ARRAY"), O_Storage_Local,
+                       Base_Info.Ortho_Type (Mode_Value));
+
+         New_Var_Decl (Var_Range_Ptr, Get_Identifier ("RANGE_PTR"),
+                       O_Storage_Local, Index_Tinfo.T.Range_Ptr_Type);
+
+         Open_Temp;
+
+
+         case El_Info.Type_Mode is
+            when Type_Mode_Thin =>
+               Vals := Dv2M (Rinfo.Var_Vals, El_Info, Mode_Signal);
+            when Type_Mode_Fat =>
+               Vals := Dp2M (Rinfo.Var_Vals, El_Info, Mode_Signal);
+            when Type_Mode_Unknown =>
+               raise Internal_Error;
+         end case;
+
+         -- * length := vec_len + nports;
+         New_Assign_Stmt (New_Obj (Var_Length),
+                          New_Dyadic_Op (ON_Add_Ov,
+                                         New_Obj_Value (Rinfo.Var_Vlen),
+                                         New_Obj_Value (Rinfo.Var_Nbr_Ports)));
+
+         -- * range_ptr := BOUND.dim_1'address;
+         New_Assign_Stmt
+           (New_Obj (Var_Range_Ptr),
+            New_Address (New_Selected_Element (New_Obj (Var_Bound),
+                                               Base_Info.T.Bounds_Vector (1)),
+                         Index_Tinfo.T.Range_Ptr_Type));
+
+         --  Create range from length
+         Chap3.Create_Range_From_Length
+           (Index_Type, Var_Length, Var_Range_Ptr);
+         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, El_Info, Mode_Value);
+            Allocate_Complex_Object (El_Type, Alloc_Stack, Res);
+         end if;
+
+         --  Call the resolution function.
+         Start_Association (Assoc, Finfo.Ortho_Func);
+         if Finfo.Res_Interface /= O_Dnode_Null then
+            New_Association (Assoc, M2E (Res));
+         end if;
+         Chap2.Add_Subprg_Instance_Assoc (Assoc, Finfo.Subprg_Instance);
+         New_Association
+           (Assoc, New_Address (New_Obj (Var_Array),
+                                Base_Info.Ortho_Ptr_Type (Mode_Value)));
+
+         if Finfo.Res_Interface = O_Dnode_Null then
+            Res := E2M (New_Function_Call (Assoc), El_Info, Mode_Value);
+         else
+            New_Procedure_Call (Assoc);
+         end if;
+
+         Chap7.Set_Driving_Value (Vals, El_Type, Res);
+
+         Close_Temp;
+         Pop_Local_Factory;
+         if Rinfo.Resolv_Block /= Null_Iir then
+            Pop_Scope (Block_Info.Block_Decls_Type);
+         end if;
+         Finish_Subprogram_Body;
+      end Translate_Resolution_Function_Body;
+
+      procedure Translate_Declaration_Chain (Parent : Iir)
+      is
+         Info : Subprg_Info_Acc;
+         El : Iir;
+      begin
+         El := Get_Declaration_Chain (Parent);
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Procedure_Declaration
+                 | Iir_Kind_Function_Declaration =>
+                  --  Translate interfaces.
+                  if Flag_Discard_Unused
+                    and then not Get_Use_Flag (El)
+                  then
+                     null;
+                  else
+                     Info := Add_Info (El, Kind_Subprg);
+                     Chap2.Translate_Subprogram_Interfaces (El);
+                     if Get_Kind (El) = Iir_Kind_Function_Declaration then
+                        Check_Resolution_Function (El);
+                     end if;
+                  end if;
+               when Iir_Kind_Function_Body
+                 | Iir_Kind_Procedure_Body =>
+                  null;
+               when Iir_Kind_Implicit_Function_Declaration
+                 | Iir_Kind_Implicit_Procedure_Declaration =>
+                  null;
+               when others =>
+                  Translate_Declaration (El);
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end Translate_Declaration_Chain;
+
+      procedure Translate_Declaration_Chain_Subprograms
+        (Parent : Iir; Block : Iir)
+      is
+         El : Iir;
+         Infos  : Chap7.Implicit_Subprogram_Infos;
+      begin
+         El := Get_Declaration_Chain (Parent);
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Procedure_Declaration
+                 | Iir_Kind_Function_Declaration =>
+                  if Get_Info (El) /= null then
+                     Chap2.Translate_Subprogram_Declaration (El);
+                     Translate_Resolution_Function (El, Block);
+                  end if;
+               when Iir_Kind_Function_Body
+                 | Iir_Kind_Procedure_Body =>
+                  if Flag_Discard_Unused
+                    and then
+                    not Get_Use_Flag (Get_Subprogram_Specification (El))
+                  then
+                     null;
+                  else
+                     Chap2.Translate_Subprogram_Body (El);
+                     Translate_Resolution_Function_Body
+                       (Get_Subprogram_Specification (El), Block);
+                  end if;
+               when Iir_Kind_Type_Declaration
+                 | Iir_Kind_Anonymous_Type_Declaration =>
+                  Chap3.Translate_Type_Subprograms (El);
+                  Chap7.Init_Implicit_Subprogram_Infos (Infos);
+               when Iir_Kind_Protected_Type_Body =>
+                  Chap3.Translate_Protected_Type_Body_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_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
+            Open_Temp;
+
+            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;
+
+            Close_Temp;
+
+            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);
+
+      procedure Translate_Association_Subprogram
+        (Assoc : Iir;
+         Mode : Conv_Mode;
+         Conv_Info : in out Assoc_Conv_Info;
+         Base_Block : Iir;
+         Entity : Iir)
+      is
+         Mark2, Mark3 : Id_Mark_Type;
+         Inter_List : O_Inter_List;
+         Formal, Actual : Iir;
+         In_Type, Out_Type : Iir;
+         In_Info, Out_Info : Type_Info_Acc;
+         Itype : O_Tnode;
+         El_List : O_Element_List;
+         Block_Info : Block_Info_Acc;
+         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;
+         Res_Info : Type_Info_Acc;
+         Imp : Iir;
+      begin
+         Formal := Get_Formal (Assoc);
+         Actual := Get_Actual (Assoc);
+
+         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_Base_Name (Formal)));
+
+         Out_Info := Get_Info (Out_Type);
+         In_Info := Get_Info (In_Type);
+
+         --  Start record containing data for the conversion function.
+         Start_Record_Type (El_List);
+
+         --  Add instance field.
+         Conv_Info.Instance_Block := Base_Block;
+         Block_Info := Get_Info (Base_Block);
+         New_Record_Field
+           (El_List, Conv_Info.Instance_Field, Wki_Instance,
+            Block_Info.Block_Decls_Ptr_Type);
+
+         if Entity /= Null_Iir then
+            Conv_Info.Instantiated_Entity := Entity;
+            Entity_Info := Get_Info (Entity);
+            declare
+               Ptr : O_Tnode;
+            begin
+               if Entity_Info.Kind = Kind_Component then
+                  Ptr := Entity_Info.Comp_Ptr_Type;
+               else
+                  Ptr := Entity_Info.Block_Decls_Ptr_Type;
+               end if;
+               New_Record_Field
+                 (El_List, Conv_Info.Instantiated_Field,
+                  Get_Identifier ("instantiated"), Ptr);
+            end;
+         else
+            Conv_Info.Instantiated_Entity := Null_Iir;
+            Conv_Info.Instantiated_Field := O_Fnode_Null;
+         end if;
+
+         --  Add input.
+         case In_Info.Type_Mode is
+            when Type_Mode_Thin =>
+               Itype := In_Info.Ortho_Type (Mode_Signal);
+            when Type_Mode_Fat =>
+               Itype := In_Info.Ortho_Ptr_Type (Mode_Signal);
+            when Type_Mode_Unknown =>
+               raise Internal_Error;
+         end case;
+         New_Record_Field
+           (El_List, Conv_Info.In_Field, Get_Identifier ("val_in"), Itype);
+
+         --  Add output.
+         New_Record_Field
+           (El_List, Conv_Info.Out_Field, Get_Identifier ("val_out"),
+            Get_Object_Type (Out_Info, Mode_Signal));
+         Finish_Record_Type (El_List, Conv_Info.Record_Type);
+         New_Type_Decl (Create_Identifier ("DTYPE"), Conv_Info.Record_Type);
+         Conv_Info.Record_Ptr_Type := New_Access_Type (Conv_Info.Record_Type);
+         New_Type_Decl (Create_Identifier ("DPTR"), Conv_Info.Record_Ptr_Type);
+
+         Start_Procedure_Decl
+           (Inter_List, Create_Identifier, O_Storage_Private);
+         New_Interface_Decl
+           (Inter_List, Var_Data, Get_Identifier ("data"),
+            Conv_Info.Record_Ptr_Type);
+         Finish_Subprogram_Decl (Inter_List, Conv_Info.Subprg);
+
+         Start_Subprogram_Body (Conv_Info.Subprg);
+         Push_Local_Factory;
+         Open_Temp;
+
+         --  Add an access to local block.
+         V := Create_Temp_Init
+           (Block_Info.Block_Decls_Ptr_Type,
+            New_Value_Selected_Acc_Value (New_Obj (Var_Data),
+                                          Conv_Info.Instance_Field));
+         Push_Scope (Block_Info.Block_Decls_Type, V);
+
+         --  Add an access to instantiated entity.
+         --  This may be used to do some type checks.
+         if Conv_Info.Instantiated_Entity /= Null_Iir then
+            declare
+               Ptr_Type : O_Tnode;
+               Decl_Type : O_Tnode;
+            begin
+               if Entity_Info.Kind = Kind_Component then
+                  Ptr_Type := Entity_Info.Comp_Ptr_Type;
+                  Decl_Type := Entity_Info.Comp_Type;
+               else
+                  Ptr_Type := Entity_Info.Block_Decls_Ptr_Type;
+                  Decl_Type := Entity_Info.Block_Decls_Type;
+               end if;
+               V := Create_Temp_Init
+                 (Ptr_Type,
+                  New_Value_Selected_Acc_Value (New_Obj (Var_Data),
+                                                Conv_Info.Instantiated_Field));
+               Push_Scope (Decl_Type, V);
+            end;
+         end if;
+
+         --  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 =>
+               Imp := Get_Implementation (Imp);
+               R := Chap7.Translate_Implicit_Conv
+                 (R, In_Type, Get_Type (Get_Interface_Declaration_Chain (Imp)),
+                  Mode_Value);
+
+               --  Create result value.
+               Subprg_Info := Get_Info (Imp);
+
+               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 : 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;
+
+               --  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);
+
+               Res_Info := Get_Info (Get_Return_Type (Imp));
+               if Subprg_Info.Res_Interface /= O_Dnode_Null then
+                  --  Composite result.
+                  New_Procedure_Call (Constr);
+               else
+                  Res := E2M (New_Function_Call (Constr),
+                              Res_Info, Mode_Value);
+               end if;
+
+            when Iir_Kind_Type_Conversion =>
+               declare
+                  Conv_Type : Iir;
+               begin
+                  Conv_Type := Get_Type (Imp);
+                  Res := E2M (Chap7.Translate_Type_Conversion
+                              (R, In_Type, Conv_Type, Assoc),
+                              Get_Info (Conv_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 Conv_Info.Instantiated_Entity /= Null_Iir then
+            if Entity_Info.Kind = Kind_Component then
+               Pop_Scope (Entity_Info.Comp_Type);
+            else
+               Pop_Scope (Entity_Info.Block_Decls_Type);
+            end if;
+         end if;
+         Pop_Scope (Block_Info.Block_Decls_Type);
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+
+         Pop_Identifier_Prefix (Mark3);
+         Pop_Identifier_Prefix (Mark2);
+      end Translate_Association_Subprogram;
+
+      procedure Translate_Association_Subprograms
+        (Assoc_Chain : Iir; Base_Block : Iir; Entity : Iir)
+      is
+         Assoc : Iir;
+         Info : Assoc_Info_Acc;
+      begin
+         Assoc := Assoc_Chain;
+         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
+                    (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
+                    (Assoc, Conv_Mode_Out, Info.Assoc_Out, Base_Block, Entity);
+               end if;
+            end if;
+            Assoc := Get_Chain (Assoc);
+         end loop;
+      end Translate_Association_Subprograms;
+
+      procedure Elab_Conversion (Sig_In : Iir;
+                                 Sig_Out : Iir;
+                                 Reg_Subprg : O_Dnode;
+                                 Info : Assoc_Conv_Info;
+                                 Ndest : out Mnode)
+      is
+         Out_Type : Iir;
+         Out_Info : Type_Info_Acc;
+         Ssig : Mnode;
+         Constr : O_Assoc_List;
+         Var_Data : O_Dnode;
+         Data : Elab_Signal_Data;
+      begin
+         Out_Type := Get_Type (Sig_Out);
+         Out_Info := Get_Info (Out_Type);
+
+         --  Allocate data for the subprogram.
+         Var_Data := Create_Temp (Info.Record_Ptr_Type);
+         New_Assign_Stmt
+           (New_Obj (Var_Data),
+            Gen_Alloc (Alloc_System,
+                       New_Lit (New_Sizeof (Info.Record_Type,
+                                            Ghdl_Index_Type)),
+                       Info.Record_Ptr_Type));
+
+         --  Set instance.
+         New_Assign_Stmt
+           (New_Selected_Acc_Value (New_Obj (Var_Data), Info.Instance_Field),
+            Get_Instance_Access (Info.Instance_Block));
+
+         --  Set instantiated unit instance (if any).
+         if Info.Instantiated_Entity /= Null_Iir then
+            declare
+               Inst_Addr : O_Enode;
+               Inst_Info : Ortho_Info_Acc;
+            begin
+               if Get_Kind (Info.Instantiated_Entity)
+                 = Iir_Kind_Component_Declaration
+               then
+                  Inst_Info := Get_Info (Info.Instantiated_Entity);
+                  Inst_Addr := New_Address
+                    (Get_Instance_Ref (Inst_Info.Comp_Type),
+                     Inst_Info.Comp_Ptr_Type);
+               else
+                  Inst_Addr := Get_Instance_Access (Info.Instantiated_Entity);
+               end if;
+               New_Assign_Stmt
+                 (New_Selected_Acc_Value (New_Obj (Var_Data),
+                                          Info.Instantiated_Field),
+                  Inst_Addr);
+            end;
+         end if;
+
+         --  Set input.
+         Ssig := Chap6.Translate_Name (Sig_In);
+         Ssig := Stabilize (Ssig, True);
+
+         New_Assign_Stmt
+           (New_Selected_Acc_Value (New_Obj (Var_Data), Info.In_Field),
+            M2E (Ssig));
+
+         --  Create a copy of SIG_OUT.
+         Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data),
+                                                Info.Out_Field),
+                        Out_Info, Mode_Signal);
+         Chap4.Allocate_Complex_Object (Out_Type, Alloc_System, Ndest);
+         --  Note: NDEST will be assigned by ELAB_SIGNAL.
+         Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data),
+                                                Info.Out_Field),
+                        Out_Info, Mode_Signal);
+         Data := Elab_Signal_Data'(Has_Val => False,
+                                   Already_Resolved => True,
+                                   Val => Mnode_Null,
+                                   Check_Null => False,
+                                   If_Stmt => null);
+         Elab_Signal (Ndest, Out_Type, Data);
+
+         Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data),
+                                                Info.Out_Field),
+                        Out_Info, Mode_Signal);
+         Ndest := Stabilize (Ndest, True);
+
+         --  Register.
+         Start_Association (Constr, Reg_Subprg);
+         New_Association
+           (Constr, New_Lit (New_Subprogram_Address (Info.Subprg,
+                                                     Ghdl_Ptr_Type)));
+         New_Association
+           (Constr, New_Convert_Ov (New_Obj_Value (Var_Data), Ghdl_Ptr_Type));
+
+         New_Association
+           (Constr,
+            New_Convert_Ov (M2E (Get_Leftest_Signal (Ssig, Get_Type (Sig_In))),
+                                 Ghdl_Signal_Ptr));
+         New_Association (Constr, Get_Nbr_Signals (Ssig, Get_Type (Sig_In)));
+
+         New_Association
+           (Constr,
+            New_Convert_Ov
+            (M2E (Get_Leftest_Signal (Ndest, Get_Type (Sig_Out))),
+                  Ghdl_Signal_Ptr));
+         New_Association (Constr, Get_Nbr_Signals (Ndest, Get_Type (Sig_Out)));
+
+         New_Procedure_Call (Constr);
+      end Elab_Conversion;
+
+      --  In conversion: from actual to formal.
+      procedure Elab_In_Conversion (Assoc : Iir; Ndest : out Mnode)
+      is
+         Assoc_Info : Assoc_Info_Acc;
+      begin
+         Assoc_Info := Get_Info (Assoc);
+
+         Elab_Conversion
+           (Get_Actual (Assoc), Get_Formal (Assoc),
+            Ghdl_Signal_In_Conversion, Assoc_Info.Assoc_In, Ndest);
+      end Elab_In_Conversion;
+
+      --  Out conversion: from formal to actual.
+      procedure Elab_Out_Conversion (Assoc : Iir; Ndest : out Mnode)
+      is
+         Assoc_Info : Assoc_Info_Acc;
+      begin
+         Assoc_Info := Get_Info (Assoc);
+
+         Elab_Conversion
+           (Get_Formal (Assoc), Get_Actual (Assoc),
+            Ghdl_Signal_Out_Conversion, Assoc_Info.Assoc_Out, Ndest);
+      end Elab_Out_Conversion;
+
+      --  Create a record that describe thes location of an IIR node and
+      --  returns the address of it.
+      function Get_Location (N : Iir) return O_Dnode
+      is
+         Constr : O_Record_Aggr_List;
+         Aggr : O_Cnode;
+         Name : Name_Id;
+         Line : Natural;
+         Col : Natural;
+         C : O_Dnode;
+      begin
+         Files_Map.Location_To_Position (Get_Location (N), Name, Line, Col);
+
+         New_Const_Decl (C, Create_Uniq_Identifier, O_Storage_Private,
+                         Ghdl_Location_Type_Node);
+         Start_Const_Value (C);
+         Start_Record_Aggr (Constr, Ghdl_Location_Type_Node);
+         New_Record_Aggr_El
+           (Constr, New_Global_Address (Current_Filename_Node, Char_Ptr_Type));
+         New_Record_Aggr_El (Constr, New_Signed_Literal (Ghdl_I32_Type,
+                                                         Integer_64 (Line)));
+         New_Record_Aggr_El (Constr, New_Signed_Literal (Ghdl_I32_Type,
+                                                         Integer_64 (Col)));
+         Finish_Record_Aggr (Constr, Aggr);
+         Finish_Const_Value (C, Aggr);
+
+         return C;
+         --return New_Global_Address (C, Ghdl_Location_Ptr_Node);
+      end Get_Location;
+   end Chap4;
+
+   package body Chap5 is
+      procedure Translate_Attribute_Specification
+        (Spec : Iir_Attribute_Specification)
+      is
+         Attr : Iir_Attribute_Declaration;
+         Mark : Id_Mark_Type;
+         Info : Object_Info_Acc;
+         Atinfo : Type_Info_Acc;
+      begin
+         Attr := Get_Attribute_Designator (Spec);
+         Atinfo := Get_Info (Get_Type (Attr));
+         Push_Identifier_Prefix_Uniq (Mark);
+         Info := Add_Info (Spec, Kind_Object);
+         Info.Object_Var := Create_Var
+           (Create_Var_Identifier (Attr),
+            Atinfo.Ortho_Type (Mode_Value),
+            Global_Storage);
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Attribute_Specification;
+
+      procedure Elab_Attribute_Specification
+        (Spec : Iir_Attribute_Specification)
+      is
+         Attr : Iir_Attribute_Declaration;
+      begin
+         Attr := Get_Attribute_Designator (Spec);
+         --  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 : Iir_List;
+         El : Iir;
+      begin
+         Val := Create_Temp_Init
+           (Std_Time_Type, Chap7.Translate_Expression (Get_Expression (Spec)));
+         List := Get_Signal_List (Spec);
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            Gen_Elab_Disconnect (Chap6.Translate_Name (El),
+                                 Get_Type (El), Val);
+         end loop;
+      end Elab_Disconnection_Specification;
+
+      type Connect_Mode is
+        (
+         --  Actual is a source for the formal.
+         Connect_Source,
+
+         --  Both.
+         Connect_Both,
+
+         --  Effective value of actual is the effective value of the formal.
+         Connect_Effective,
+
+         --  Actual is a value.
+         Connect_Value
+        );
+
+      type Connect_Data is record
+         Actual_Node : Mnode;
+         Actual_Type : Iir;
+
+         --  Mode of the connection.
+         Mode : Connect_Mode;
+
+         --  If true, formal signal is a copy of the actual.
+         By_Copy : Boolean;
+      end record;
+
+      --  Connect_effective: FORMAL is set from ACTUAL.
+      --  Connect_Source: ACTUAL is set from FORMAL (source of ACTUAL).
+      procedure Connect_Scalar (Formal_Node : Mnode;
+                                Formal_Type : Iir;
+                                Data : Connect_Data)
+      is
+         Act_Node, Form_Node : Mnode;
+      begin
+         if Data.By_Copy then
+            New_Assign_Stmt (M2Lv (Formal_Node), M2E (Data.Actual_Node));
+            return;
+         end if;
+
+         case Data.Mode is
+            when Connect_Both =>
+               Open_Temp;
+               Act_Node := Stabilize (Data.Actual_Node, True);
+               Form_Node := Stabilize (Formal_Node, True);
+            when Connect_Source
+              | Connect_Effective =>
+               Act_Node := Data.Actual_Node;
+               Form_Node := Formal_Node;
+            when Connect_Value =>
+               null;
+         end case;
+
+         if Data.Mode in Connect_Source .. Connect_Both then
+            --  Formal is a source to actual.
+            declare
+               Constr : O_Assoc_List;
+            begin
+               Start_Association (Constr, Ghdl_Signal_Add_Source);
+               New_Association (Constr, New_Convert_Ov (M2E (Act_Node),
+                                                        Ghdl_Signal_Ptr));
+               New_Association (Constr, New_Convert_Ov (M2E (Form_Node),
+                                                        Ghdl_Signal_Ptr));
+               New_Procedure_Call (Constr);
+            end;
+         end if;
+
+         if Data.Mode in Connect_Both .. Connect_Effective then
+            --  The effective value of formal is the effective value of actual.
+            declare
+               Constr : O_Assoc_List;
+            begin
+               Start_Association (Constr, Ghdl_Signal_Effective_Value);
+               New_Association (Constr, New_Convert_Ov (M2E (Form_Node),
+                                                        Ghdl_Signal_Ptr));
+               New_Association (Constr, New_Convert_Ov (M2E (Act_Node),
+                                                        Ghdl_Signal_Ptr));
+               New_Procedure_Call (Constr);
+            end;
+         end if;
+
+         if Data.Mode = Connect_Value then
+            declare
+               Type_Info : Type_Info_Acc;
+               Subprg : O_Dnode;
+               Constr : O_Assoc_List;
+               Conv : O_Tnode;
+            begin
+               Type_Info := Get_Info (Formal_Type);
+               case Type_Info.Type_Mode is
+                  when Type_Mode_B2 =>
+                     Subprg := Ghdl_Signal_Associate_B2;
+                     Conv := Ghdl_Bool_Type;
+                  when Type_Mode_E8 =>
+                     Subprg := Ghdl_Signal_Associate_E8;
+                     Conv := Ghdl_I32_Type;
+                  when Type_Mode_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 Get_Kind (Actual_Type)
+           not in Iir_Kinds_Unconstrained_Array_Type_Definition
+         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
+            case Get_Kind (Get_Base_Name (Obj)) is
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Signal_Interface_Declaration
+                 | Iir_Kind_Guard_Signal_Declaration
+                 | Iir_Kinds_Signal_Attribute =>
+                  return True;
+               when others =>
+                  return False;
+            end case;
+         else
+            return False;
+         end if;
+      end Is_Signal;
+
+      procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir; By_Copy : Boolean)
+      is
+         Formal, Actual : Iir;
+         Formal_Type, Actual_Type : Iir;
+         Formal_Node, Actual_Node : Mnode;
+         Data : Connect_Data;
+         Mode : Connect_Mode;
+      begin
+         if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression
+           and then Get_Collapse_Signal_Flag (Assoc) = By_Copy
+         then
+            Open_Temp;
+            Formal := Get_Formal (Assoc);
+            Actual := Get_Actual (Assoc);
+            Formal_Type := Get_Type (Formal);
+            Actual_Type := Get_Type (Actual);
+            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 signal
+                  -- is 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 (Get_Base_Name (Formal)) 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;
+
+               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 if;
+      end Elab_Port_Map_Aspect_Assoc;
+
+      --  Return TRUE if the collapse_signal_flag is set for each individual
+      --  association.
+      function Inherit_Collapse_Flag (Assoc : Iir) return Boolean
+      is
+         El : Iir;
+      begin
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_By_Individual =>
+               El := Get_Individual_Association_Chain (Assoc);
+               while El /= Null_Iir loop
+                  if Inherit_Collapse_Flag (El) = False then
+                     return False;
+                  end if;
+                  El := Get_Chain (El);
+               end loop;
+               return True;
+            when Iir_Kind_Choice_By_Expression
+              | Iir_Kind_Choice_By_Range
+              | Iir_Kind_Choice_By_Name =>
+               El := Assoc;
+               while El /= Null_Iir loop
+                  if Inherit_Collapse_Flag (Get_Associated (Assoc)) = False
+                  then
+                     return False;
+                  end if;
+                  El := Get_Chain (El);
+               end loop;
+               return True;
+            when Iir_Kind_Association_Element_By_Expression =>
+               return Get_Collapse_Signal_Flag (Assoc);
+            when others =>
+               Error_Kind ("inherit_collapse_flag", Assoc);
+         end case;
+      end Inherit_Collapse_Flag;
+
+      procedure Elab_Map_Aspect (Mapping : Iir; Block_Parent : Iir)
+      is
+         Assoc : Iir;
+         Formal : Iir;
+         Formal_Base : Iir;
+         Fb_Type : Iir;
+         Fbt_Info : Type_Info_Acc;
+         Collapse_Individual : Boolean := False;
+         Targ : Mnode;
+      begin
+         --  Elab generics, and associate.
+         --  The generic map must be done before the elaboration of
+         --  the ports, since a port subtype may depend on a generic.
+         Assoc := Get_Generic_Map_Aspect_Chain (Mapping);
+         while Assoc /= Null_Iir loop
+            Formal := Get_Formal (Assoc);
+            case Get_Kind (Assoc) is
+               when Iir_Kind_Association_Element_By_Expression =>
+                  if Get_Whole_Association_Flag (Assoc) then
+                     Chap4.Elab_Object_Storage (Formal);
+                     Targ := Chap6.Translate_Name (Formal);
+                     Chap4.Elab_Object_Init (Targ, Formal, Get_Actual (Assoc));
+                  else
+                     Open_Temp;
+                     Targ := Chap6.Translate_Name (Formal);
+                     Chap7.Translate_Assign
+                       (Targ, Get_Actual (Assoc), Get_Type (Formal));
+                     Close_Temp;
+                  end if;
+               when Iir_Kind_Association_Element_Open =>
+                  Chap4.Elab_Object_Value (Formal, Get_Default_Value (Formal));
+               when Iir_Kind_Association_Element_By_Individual =>
+                  --  Create the object.
+                  Open_Temp;
+                  declare
+                     Formal_Node : Mnode;
+                     Formal_Type : Iir;
+                     Obj_Info : Object_Info_Acc;
+                     Obj_Type : Iir;
+                     Type_Info : Type_Info_Acc;
+                     Bounds : O_Enode;
+                  begin
+                     Formal_Type := Get_Type (Formal);
+                     Chap3.Elab_Object_Subtype (Formal_Type);
+                     Type_Info := Get_Info (Formal_Type);
+                     Obj_Info := Get_Info (Formal);
+                     Formal_Node := Get_Var
+                       (Obj_Info.Object_Var, Type_Info, Mode_Value);
+                     Stabilize (Formal_Node);
+                     Obj_Type := Get_Actual_Type (Assoc);
+                     if Obj_Type = Null_Iir then
+                        Chap4.Allocate_Complex_Object
+                          (Formal_Type, Alloc_System, Formal_Node);
+                     else
+                        Chap3.Create_Array_Subtype (Obj_Type, False);
+                        Bounds := M2E (Chap3.Get_Array_Type_Bounds (Obj_Type));
+                        Chap3.Translate_Object_Allocation
+                          (Formal_Node, Alloc_System, Formal_Type, Bounds);
+                     end if;
+                  end;
+                  Close_Temp;
+               when others =>
+                  Error_Kind ("elab_map_aspect(1)", Assoc);
+            end case;
+            Assoc := Get_Chain (Assoc);
+         end loop;
+
+         --  Ports.
+         Assoc := Get_Port_Map_Aspect_Chain (Mapping);
+         while Assoc /= Null_Iir loop
+            Formal := Get_Formal (Assoc);
+            Formal_Base := Get_Base_Name (Formal);
+            Fb_Type := Get_Type (Formal_Base);
+
+            --  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_By_Individual =>
+                     Open_Temp;
+                     declare
+                        Actual_Type : Iir;
+                        Tinfo : Type_Info_Acc;
+                        Bounds : Mnode;
+                        Formal_Node : Mnode;
+                     begin
+                        Actual_Type := Get_Actual_Type (Assoc);
+                        Chap3.Create_Array_Subtype (Actual_Type, False);
+                        Tinfo := Get_Info (Actual_Type);
+                        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;
+                     Close_Temp;
+               when others =>
+                  Error_Kind ("elab_map_aspect(2)", Assoc);
+               end case;
+            end if;
+
+            --  Allocate storage of ports.
+            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;
+
+            --  Create or copy signals.
+            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;
+
+            Assoc := Get_Chain (Assoc);
+         end loop;
+      end Elab_Map_Aspect;
+
+   end Chap5;
+
+   package body Chap6 is
+      --  Extract from fat array FAT_ARRAY the range corresponding to dimension
+      --  DIM.
+      function Fat_Array_To_Range (Fat_Array : O_Lnode;
+                                   Array_Type : Iir;
+                                   Dim : Natural;
+                                   Is_Sig : Object_Kind_Type)
+        return O_Lnode
+      is
+         Lval : O_Lnode;
+         Array_Info : Type_Info_Acc;
+      begin
+         Array_Info := Get_Info (Array_Type);
+         case Array_Info.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               --  From fat record, extract bounds field.
+               Lval := New_Selected_Element
+                 (Fat_Array, Array_Info.T.Bounds_Field (Is_Sig));
+               --  Dereference it.
+               Lval := New_Access_Element (New_Value (Lval));
+            when Type_Mode_Ptr_Array =>
+               Lval := Get_Var (Array_Info.T.Array_Bounds);
+            when others =>
+               raise Internal_Error;
+         end case;
+         --  Extract the range for the dimension.
+         return New_Selected_Element (Lval, Array_Info.T.Bounds_Vector (Dim));
+      end Fat_Array_To_Range;
+
+      function Get_Array_Bound_Length (Arr : O_Lnode;
+                                       Arr_Type : Iir;
+                                       Dim : Natural;
+                                       Is_Sig : Object_Kind_Type)
+        return O_Enode
+      is
+         Tinfo : Type_Info_Acc;
+         Index_Type : Iir;
+         Rinfo : Type_Info_Acc;
+         Constraint : Iir;
+      begin
+         Index_Type := Get_Nth_Element (Get_Index_Subtype_List (Arr_Type),
+                                        Dim - 1);
+
+         Tinfo := Get_Info (Arr_Type);
+         case Tinfo.Type_Mode is
+            when Type_Mode_Fat_Array
+              | Type_Mode_Ptr_Array =>
+               Rinfo := Get_Info (Get_Base_Type (Index_Type));
+               return New_Value
+                 (New_Selected_Element
+                  (Fat_Array_To_Range (Arr, Arr_Type, Dim, Is_Sig),
+                   Rinfo.T.Range_Length));
+            when Type_Mode_Array =>
+               Constraint := Get_Range_Constraint (Index_Type);
+               return New_Lit
+                 (Chap7.Translate_Static_Range_Length (Constraint));
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Get_Array_Bound_Length;
+
+      function Get_Array_Ptr_Bound_Length (Ptr : O_Lnode;
+                                           Arr_Type : Iir;
+                                           Dim : Natural;
+                                           Is_Sig : Object_Kind_Type)
+        return O_Enode
+      is
+         Tinfo : Type_Info_Acc;
+      begin
+         Tinfo := Get_Info (Arr_Type);
+         case Tinfo.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               return Get_Array_Bound_Length
+                 (New_Acc_Value (Ptr), Arr_Type, Dim, Is_Sig);
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               return Get_Array_Bound_Length
+                 (O_Lnode_Null, Arr_Type, Dim, Is_Sig);
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Get_Array_Ptr_Bound_Length;
+
+      --  There is a uniq number associated which each error.
+      Bound_Error_Number : Unsigned_64 := 0;
+
+      procedure Gen_Bound_Error (Loc : Iir)
+      is
+         Constr : O_Assoc_List;
+         Name : Name_Id;
+         Line, Col : Natural;
+      begin
+         if Loc /= Null_Iir then
+            Files_Map.Location_To_Position
+              (Get_Location (Loc), Name, Line, Col);
+
+            Start_Association (Constr, Ghdl_Bound_Check_Failed_L1);
+            New_Association
+              (Constr, New_Lit (New_Global_Address (Current_Filename_Node,
+                                                    Char_Ptr_Type)));
+            New_Association
+              (Constr, New_Lit (New_Signed_Literal (Ghdl_I32_Type,
+                                                    Integer_64 (Line))));
+            New_Procedure_Call (Constr);
+         else
+            Start_Association (Constr, Ghdl_Bound_Check_Failed_L0);
+            New_Association
+              (Constr, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                      Bound_Error_Number)));
+            New_Procedure_Call (Constr);
+            Bound_Error_Number := Bound_Error_Number + 1;
+         end if;
+      end Gen_Bound_Error;
+
+      procedure Gen_Program_Error (Loc : Iir)
+      is
+         pragma Unreferenced (Loc);
+         Constr : O_Assoc_List;
+      begin
+         Start_Association (Constr, Ghdl_Program_Error);
+         New_Procedure_Call (Constr);
+      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;
+
+      function Translate_Index_To_Offset (Range_Ptr : O_Dnode;
+                                          Index : O_Enode;
+                                          Index_Type : Iir;
+                                          Loc : Iir)
+        return O_Enode
+      is
+         Dir : O_Enode;
+         If_Blk : O_If_Block;
+         Res : O_Dnode;
+         Off : O_Dnode;
+         Cond1, Cond2: O_Enode;
+         Index_Node : O_Dnode;
+         Bound_Node : O_Dnode;
+         Index_Info : Type_Info_Acc;
+      begin
+         Index_Info := Get_Info (Index_Type);
+
+         Res := Create_Temp (Ghdl_Index_Type);
+
+         Open_Temp;
+
+         Index_Node := Create_Temp_Init
+           (Index_Info.Ortho_Type (Mode_Value), Index);
+         Bound_Node := Create_Temp_Init
+           (Index_Info.Ortho_Type (Mode_Value),
+            New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
+                                          Index_Info.T.Range_Left));
+         Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
+
+         Dir := New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
+                                              Index_Info.T.Range_Dir);
+
+         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);
+
+         --  Get the offset.
+         New_Assign_Stmt
+           (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off),
+                                           Ghdl_Index_Type));
+
+         --  Check bounds.
+         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),
+            New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
+                                          Index_Info.T.Range_Length),
+            Ghdl_Bool_Type);
+         Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
+
+         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;
+                                            Index_Range : Iir;
+                                            Dim : Natural;
+                                            Expr : Iir)
+        return O_Enode
+      is
+         Obound : O_Cnode;
+         Res : O_Dnode;
+         Off : O_Dnode;
+         Cond2: O_Enode;
+         Index : O_Enode;
+         Index_Info : Type_Info_Acc;
+         V : Iir_Int64;
+         B : Iir_Int64;
+      begin
+         if Get_Expr_Staticness (Expr) = Locally then
+            V := Eval_Pos (Expr);
+            B := Eval_Pos (Get_Left_Limit (Index_Range));
+            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_Info := Get_Info (Get_Base_Type (Index_Type));
+            Res := Create_Temp (Ghdl_Index_Type);
+            Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
+
+            Index := Chap7.Translate_Expression (Expr, Index_Type);
+
+            Obound := Chap7.Translate_Static_Range_Left
+                 (Index_Range, Index_Type);
+
+            if Get_Direction (Index_Range) = Iir_To then
+               --  Direction TO:  INDEX - LEFT.
+               Index := New_Dyadic_Op (ON_Sub_Ov, Index, New_Lit (Obound));
+            else
+               --  Direction DOWNTO:  LEFT - INDEX.
+               Index := New_Dyadic_Op (ON_Sub_Ov, New_Lit (Obound), Index);
+            end if;
+
+            New_Assign_Stmt (New_Obj (Off), Index);
+
+            --  Get the offset.
+            New_Assign_Stmt
+              (New_Obj (Res),
+               New_Convert_Ov (New_Obj_Value (Off), Ghdl_Index_Type));
+
+            --  Since the value is unsigned, both left and right bounds are
+            --  checked in the same time.
+            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);
+
+            return New_Obj_Value (Res);
+         end if;
+      end Translate_Thin_Index_Offset;
+
+      --  Translate an indexed name.
+      function Translate_Indexed_Name (Prefix_Orig : Mnode; Expr : Iir)
+                                      return Mnode
+      is
+         Prefix : Mnode;
+         Prefix_Type : Iir;
+         Index : Iir;
+         Index_List : Iir_List;
+         Type_List : Iir_List;
+         Offset : O_Dnode;
+         R : O_Enode;
+         Length : O_Enode;
+         Itype : Iir;
+         Ibasetype : Iir;
+         Prefix_Info : Type_Info_Acc;
+         Nbr_Dim : Natural;
+         Fat_Ptr : O_Lnode;
+         Range_Ptr : Mnode;
+      begin
+         Prefix_Type := Get_Type (Get_Prefix (Expr));
+         Prefix_Info := Get_Info (Prefix_Type);
+         case Prefix_Info.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               Prefix := Stabilize (Prefix_Orig);
+            when Type_Mode_Array =>
+               Prefix := Prefix_Orig;
+            when Type_Mode_Ptr_Array =>
+               --  FIXME: should save the bounds address ?
+               Fat_Ptr := O_Lnode_Null;
+               Prefix := Prefix_Orig;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Index_List := Get_Index_List (Expr);
+         Type_List := Get_Index_Subtype_List (Prefix_Type);
+         Nbr_Dim := Get_Nbr_Elements (Index_List);
+         Offset := Create_Temp (Ghdl_Index_Type);
+         for Dim in 1 .. Nbr_Dim loop
+            Index := Get_Nth_Element (Index_List, Dim - 1);
+            Itype := Get_Nth_Element (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 := Chap3.Get_Array_Range
+                    (Prefix, Prefix_Type, Dim);
+               when Type_Mode_Ptr_Array =>
+                  Range_Ptr := Chap3.Bounds_To_Range
+                    (Chap3.Get_Array_Type_Bounds (Prefix_Type),
+                     Prefix_Type, Dim);
+               when Type_Mode_Array =>
+                  null;
+               when others =>
+                  raise Internal_Error;
+            end case;
+            case Prefix_Info.Type_Mode is
+               when Type_Mode_Fat_Array
+                 | Type_Mode_Ptr_Array =>
+                  Range_Ptr := Stabilize (Range_Ptr);
+                  R := Translate_Index_To_Offset
+                    (M2Dp (Range_Ptr),
+                     Chap7.Translate_Expression (Index, Ibasetype),
+                     Ibasetype,
+                     Index);
+               when Type_Mode_Array =>
+                  --  BASE is a thin array.
+                  R := Translate_Thin_Index_Offset
+                    (Ibasetype, Get_Range_Constraint (Itype), Dim, Index);
+               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.
+               case Prefix_Info.Type_Mode is
+                  when Type_Mode_Fat_Array
+                    | Type_Mode_Ptr_Array =>
+                     Length := M2E (Chap3.Range_To_Length (Range_Ptr));
+                  when Type_Mode_Array =>
+                     Length := New_Lit (Chap7.Translate_Static_Range_Length
+                                        (Get_Range_Constraint (Itype)));
+                  when others =>
+                     raise Internal_Error;
+               end case;
+               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 Chap3.Index_Base (Chap3.Get_Array_Base (Prefix), Prefix_Type,
+                                  New_Obj_Value (Offset));
+      end Translate_Indexed_Name;
+
+      function Translate_Slice_Name (Prefix : Mnode; Expr : Iir_Slice_Name)
+                                    return Mnode
+      is
+         --  Type of the prefix.
+         Prefix_Type : Iir;
+
+         --  Type info of the prefix.
+         Prefix_Info : Type_Info_Acc;
+
+         --  Type of the slice.
+         Slice_Type : Iir;
+         Slice_Info : Type_Info_Acc;
+         Slice_Binfo : Type_Info_Acc;
+
+         --  Type of the first (and only) index of the prefix array type.
+         Index_Type : Iir;
+
+         --  True iff the direction of the slice is known at compile time.
+         Static_Range : Boolean;
+
+         --  Suffix of the slice (discrete range).
+         Expr_Range : Iir;
+
+         --  Object kind of the prefix.
+         Kind : Object_Kind_Type;
+
+         --  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;
+
+         Res_L : O_Lnode;
+         Res_D : O_Dnode;
+
+         Diff : O_Dnode;
+         Unsigned_Diff : O_Dnode;
+         If_Blk1 : O_If_Block;
+      begin
+         --  Evaluate the prefix.
+         Slice_Type := Get_Type (Expr);
+         Expr_Range := Get_Suffix (Expr);
+         Prefix_Type := Get_Type (Get_Prefix (Expr));
+         Index_Type := Get_Nth_Element
+           (Get_Index_Subtype_List (Prefix_Type), 0);
+
+         --  Evaluate slice bounds.
+         Chap3.Create_Array_Subtype (Slice_Type, True);
+
+         Kind := Get_Object_Kind (Prefix);
+
+         Prefix_Info := Get_Info (Prefix_Type);
+         Slice_Info := Get_Info (Slice_Type);
+
+         if Slice_Info.Type_Mode = Type_Mode_Array
+           and then Prefix_Info.Type_Mode = Type_Mode_Array
+         then
+            --  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_First_Element
+                 (Get_Index_Subtype_List (Slice_Type));
+               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.
+                  return Prefix;
+               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;
+               return Lv2M
+                 (New_Slice (M2Lv (Prefix),
+                             Slice_Info.Ortho_Type (Kind),
+                             New_Lit (New_Unsigned_Literal
+                                      (Ghdl_Index_Type,
+                                       Unsigned_64 (Off)))),
+                  Slice_Info,
+                  Kind);
+            end;
+         end if;
+
+         Slice_Binfo := Get_Info (Get_Base_Type (Slice_Type));
+
+         --  Save prefix.
+         Prefix_Var := Stabilize (Prefix);
+
+         Index_Info := Get_Info (Get_Base_Type (Index_Type));
+
+         --  Save prefix bounds.
+         Prefix_Range := Stabilize
+           (Chap3.Get_Array_Range (Prefix_Var, Prefix_Type, 1));
+
+         --  Save slice bounds.
+         Slice_Range := Stabilize
+           (Chap3.Bounds_To_Range (Chap3.Get_Array_Type_Bounds (Slice_Type),
+                                   Slice_Type, 1));
+
+         --  TRUE if the direction of the slice is known.
+         Static_Range := Get_Kind (Expr_Range) = Iir_Kind_Range_Expression;
+
+         --  Check direction against same direction, error if different.
+         --  FIXME: what about v87 -> if different then null slice
+         if not Static_Range
+           or else Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition
+         then
+            --  Check same direction.
+            Check_Bound_Error
+              (New_Compare_Op (ON_Neq,
+                               M2E (Chap3.Range_To_Dir (Prefix_Range)),
+                               M2E (Chap3.Range_To_Dir (Slice_Range)),
+                               Ghdl_Bool_Type),
+               Expr, 1);
+         end if;
+
+         --  Check if not a null slice.
+         --  FIXME: why ?
+         --Start_If_Stmt
+         --  (If_Blk,
+         --   New_Compare_Op
+         --   (ON_Neq,
+         --    Get_Array_Bound_Length (Res, Prefix_Type, 1, Sig),
+         --    New_Unsigned_Literal (Ghdl_Index_Type, 0),
+         --    Ghdl_Bool_Type_Node));
+
+         Diff := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
+
+         --  Compute the offset in the prefix.
+         if not Static_Range then
+            Start_If_Stmt
+              (If_Blk1, New_Compare_Op (ON_Eq,
+                                        M2E (Chap3.Range_To_Dir (Slice_Range)),
+                                        New_Lit (Ghdl_Dir_To_Node),
+                                        Ghdl_Bool_Type));
+         end if;
+         if not Static_Range or else Get_Direction (Expr_Range) = Iir_To then
+            --  Diff = slice - bounds.
+            New_Assign_Stmt
+              (New_Obj (Diff),
+               New_Dyadic_Op (ON_Sub_Ov,
+                              M2E (Chap3.Range_To_Left (Slice_Range)),
+                              M2E (Chap3.Range_To_Left (Prefix_Range))));
+         end if;
+         if not Static_Range then
+            New_Else_Stmt (If_Blk1);
+         end if;
+         if not Static_Range or else Get_Direction (Expr_Range) = Iir_Downto
+         then
+            --  Diff = bounds - slice.
+            New_Assign_Stmt
+              (New_Obj (Diff),
+               New_Dyadic_Op (ON_Sub_Ov,
+                              M2E (Chap3.Range_To_Left (Prefix_Range)),
+                              M2E (Chap3.Range_To_Left (Slice_Range))));
+         end if;
+         if not Static_Range then
+            Finish_If_Stmt (If_Blk1);
+         end if;
+
+         --  Note: this also check for overflow.
+         Unsigned_Diff := Create_Temp (Ghdl_Index_Type);
+         New_Assign_Stmt
+           (New_Obj (Unsigned_Diff),
+            New_Convert_Ov (New_Obj_Value (Diff), Ghdl_Index_Type));
+
+         --  Check bounds.
+         declare
+            Err_1 : O_Enode;
+            Err_2 : O_Enode;
+         begin
+            --  Bounds error if left of slice is before left of prefix.
+            Err_1 := New_Compare_Op
+              (ON_Lt,
+               New_Obj_Value (Diff),
+               New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
+                                            0)),
+               Ghdl_Bool_Type);
+            --  Bounds error if right of slice is after right of prefix.
+            Err_2 := New_Compare_Op
+              (ON_Gt,
+               New_Dyadic_Op (ON_Add_Ov,
+                              New_Obj_Value (Unsigned_Diff),
+                              M2E (Chap3.Range_To_Length (Slice_Range))),
+               M2E (Chap3.Range_To_Length (Prefix_Range)),
+               Ghdl_Bool_Type);
+            Check_Bound_Error (New_Dyadic_Op (ON_Or, Err_1, Err_2), Expr, 1);
+         end;
+
+         --  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 (Slice_Range)));
+               New_Assign_Stmt
+                 (New_Selected_Element (New_Obj (Res_D),
+                                        Slice_Info.T.Base_Field (Kind)),
+                  New_Address
+                  (New_Slice (M2Lv (Chap3.Get_Array_Base (Prefix_Var)),
+                              Slice_Info.T.Base_Type (Kind),
+                              New_Obj_Value (Unsigned_Diff)),
+                   Slice_Info.T.Base_Ptr_Type (Kind)));
+               return Dv2M (Res_D, Slice_Info, Kind);
+            when Type_Mode_Array
+              | Type_Mode_Ptr_Array =>
+               Res_L := New_Slice
+                 (M2Lv (Chap3.Get_Array_Base (Prefix_Var)),
+                  Slice_Info.T.Base_Type (Kind),
+                  New_Obj_Value (Unsigned_Diff));
+               return Lv2M (Res_L,
+                            True,
+                            Slice_Info.T.Base_Type (Kind),
+                            Slice_Info.T.Base_Ptr_Type (Kind),
+                            Slice_Info, Kind);
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         --Finish_If_Stmt (If_Blk);
+
+      end Translate_Slice_Name;
+
+      function Translate_Interface_Name
+        (Inter : Iir; Info : Ortho_Info_Acc; Kind : Object_Kind_Type)
+        return Mnode
+      is
+         Type_Info : Type_Info_Acc;
+      begin
+         Type_Info := Get_Info (Get_Type (Inter));
+         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.
+               case Type_Info.Type_Mode is
+                  when Type_Mode_Unknown =>
+                     raise Internal_Error;
+                  when Type_Mode_By_Value =>
+                     --  Parameter is passed by value.
+                     if Info.Interface_Field /= O_Fnode_Null then
+                        --  And by copy.
+                        return Lv2M (New_Selected_Acc_Value
+                                     (New_Obj (Info.Interface_Node),
+                                      Info.Interface_Field),
+                                     Type_Info, Kind);
+                     else
+                        return Dv2M (Info.Interface_Node, Type_Info, Kind);
+                     end if;
+                  when Type_Mode_By_Ref
+                    | Type_Mode_By_Copy =>
+                     --  Parameter is passed by reference, dereference it.
+                     return Dp2M (Info.Interface_Node, Type_Info, Kind);
+               end case;
+            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 : Field_Info_Acc;
+         Kind : Object_Kind_Type;
+      begin
+         El_Info := Get_Info (El);
+         Kind := Get_Object_Kind (Prefix);
+         return Lo2M (New_Selected_Element (M2Lv (Prefix),
+                                            El_Info.Field_Node (Kind)),
+                      Get_Info (Get_Type (El)), Kind);
+      end Translate_Selected_Element;
+
+--       function Translate_Formal_Interface_Name (Scope_Type : O_Tnode;
+--                                                 Scope_Param : O_Lnode;
+--                                                 Name : Iir;
+--                                                 Kind : Object_Kind_Type)
+--                                                return Mnode
+--       is
+--          Type_Info : Type_Info_Acc;
+--          Info : Ortho_Info_Acc;
+--          Res : Mnode;
+--       begin
+--          Type_Info := Get_Info (Get_Type (Name));
+--          Info := Get_Info (Name);
+--          Push_Scope_Soft (Scope_Type, Scope_Param);
+--          Res := Get_Var (Info.Object_Var, Type_Info, Kind);
+--          Pop_Scope_Soft (Scope_Type);
+--          return Res;
+--       end Translate_Formal_Interface_Name;
+
+--       function Translate_Formal_Name (Scope_Type : O_Tnode;
+--                                       Scope_Param : O_Lnode;
+--                                       Name : Iir)
+--                                      return Mnode
+--       is
+--          Prefix : Iir;
+--          Prefix_Name : Mnode;
+--       begin
+--          case Get_Kind (Name) is
+--             when Iir_Kind_Constant_Interface_Declaration =>
+--                return Translate_Formal_Interface_Name
+--                  (Scope_Type, Scope_Param, Name, Mode_Value);
+
+--             when Iir_Kind_Signal_Interface_Declaration =>
+--                return Translate_Formal_Interface_Name
+--                  (Scope_Type, Scope_Param, Name, Mode_Signal);
+
+--             when Iir_Kind_Indexed_Name =>
+--                Prefix := Get_Prefix (Name);
+--                Prefix_Name := Translate_Formal_Name
+--                  (Scope_Type, Scope_Param, Prefix);
+--                return Translate_Indexed_Name (Prefix_Name, Name);
+
+--             when Iir_Kind_Slice_Name =>
+--                Prefix := Get_Prefix (Name);
+--                Prefix_Name := Translate_Formal_Name
+--                  (Scope_Type, Scope_Param, Prefix);
+--                return Translate_Slice_Name (Prefix_Name, Name);
+
+--             when Iir_Kind_Selected_Element =>
+--                Prefix := Get_Prefix (Name);
+--                Prefix_Name := Translate_Formal_Name
+--                  (Scope_Type, Scope_Param, Prefix);
+--                return Translate_Selected_Element
+--                  (Prefix_Name, Get_Selected_Element (Name));
+
+--             when others =>
+--                Error_Kind ("translate_generic_name", Name);
+--          end case;
+--       end Translate_Formal_Name;
+
+      function Translate_Name (Name : Iir) return Mnode
+      is
+         Name_Type : Iir;
+         Name_Info : Ortho_Info_Acc;
+         Type_Info : Type_Info_Acc;
+      begin
+         Name_Type := Get_Type (Name);
+         Name_Info := Get_Info (Name);
+         Type_Info := Get_Info (Name_Type);
+         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_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_Ptr_Array
+                       | Type_Mode_Array =>
+                        R := Get_Var (Name_Info.Alias_Var);
+                        return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
+                     when Type_Mode_Scalar =>
+                        R := Get_Var (Name_Info.Alias_Var);
+                        if Name_Info.Alias_Kind = Mode_Signal then
+                           return Lv2M (R, Type_Info, Name_Info.Alias_Kind);
+                        else
+                           return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
+                        end if;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end;
+
+            when Iir_Kind_Signal_Declaration
+              | Iir_Kind_Stable_Attribute
+              | Iir_Kind_Quiet_Attribute
+              | Iir_Kind_Delayed_Attribute
+              | Iir_Kind_Transaction_Attribute
+              | Iir_Kind_Guard_Signal_Declaration =>
+               return Get_Var (Name_Info.Object_Var, Type_Info, Mode_Signal);
+
+            when Iir_Kind_Constant_Interface_Declaration =>
+               return Translate_Interface_Name (Name, Name_Info, Mode_Value);
+
+            when Iir_Kind_File_Interface_Declaration =>
+               return Translate_Interface_Name (Name, Name_Info, Mode_Value);
+
+            when Iir_Kind_Variable_Interface_Declaration =>
+               if Name_Info.Interface_Field /= O_Fnode_Null then
+                  --  Passed via the result record.
+                  return Lv2M
+                    (New_Selected_Element
+                     (New_Acc_Value (New_Obj (Name_Info.Interface_Node)),
+                      Name_Info.Interface_Field),
+                     Type_Info, Mode_Value);
+               else
+                  return Translate_Interface_Name
+                    (Name, Name_Info, Mode_Value);
+               end if;
+
+            when Iir_Kind_Signal_Interface_Declaration =>
+               return Translate_Interface_Name (Name, Name_Info, Mode_Signal);
+
+            when Iir_Kind_Indexed_Name =>
+               return Translate_Indexed_Name
+                 (Translate_Name (Get_Prefix (Name)), Name);
+
+            when Iir_Kind_Slice_Name =>
+               return Translate_Slice_Name
+                 (Translate_Name (Get_Prefix (Name)), Name);
+
+            when Iir_Kind_Dereference
+              | Iir_Kind_Implicit_Dereference =>
+               declare
+                  Pfx : O_Enode;
+               begin
+                  Pfx := Chap7.Translate_Expression (Get_Prefix (Name));
+                  --  FIXME: what about fat pointer ??
+                  return Lv2M (New_Access_Element (Pfx),
+                               Type_Info, Mode_Value);
+               end;
+
+            when Iir_Kind_Selected_Element =>
+               return Translate_Selected_Element
+                 (Translate_Name (Get_Prefix (Name)),
+                  Get_Selected_Element (Name));
+
+            when Iir_Kind_Function_Call =>
+               --  This can appear as a prefix of a name, therefore, the
+               --  result is always a composite type.
+               declare
+                  Imp : Iir;
+                  Obj : Iir;
+                  Assoc_Chain : Iir;
+               begin
+                  Imp := Get_Implementation (Name);
+                  if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration
+                  then
+                     --  FIXME : to be done
+                     raise Internal_Error;
+                  else
+                     Assoc_Chain := Canon.Canon_Subprogram_Call (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;
+   end Chap6;
+
+   package body Chap7 is
+      function Is_Static_Constant (Decl : Iir_Constant_Declaration)
+                                  return Boolean
+      is
+         Expr : Iir;
+         Atype : Iir;
+         Info : Iir;
+      begin
+         if Get_Expr_Staticness (Decl) = Locally then
+            --  Should be not necessary.
+            return True;
+         end if;
+
+         Expr := Get_Default_Value (Decl);
+         if Expr = Null_Iir then
+            --  Deferred constant.
+            return False;
+         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 : Natural;
+         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 : Natural;
+         V : O_Cnode;
+      begin
+         L_0 := Get_Ortho_Expr (Get_Bit_String_0 (Lit));
+         L_1 := Get_Ortho_Expr (Get_Bit_String_1 (Lit));
+         Ptr := Get_String_Fat_Acc (Lit);
+         Len := Get_String_Length (Lit);
+         for I in 1 .. Len loop
+            case Ptr (I) is
+               when '0' =>
+                  V := L_0;
+               when '1' =>
+                  V := L_1;
+               when others =>
+                  raise Internal_Error;
+            end case;
+            New_Array_Aggr_El (List, V);
+         end loop;
+      end Translate_Static_Bit_String_Literal_Inner;
+
+      procedure Translate_Static_Aggregate_1 (List : in out O_Array_Aggr_List;
+                                              Aggr : Iir;
+                                              Info : Iir;
+                                              El_Type : Iir)
+      is
+         Assoc : Iir;
+         N_Info : Iir;
+         Sub : Iir;
+      begin
+         N_Info := Get_Sub_Aggregate_Info (Info);
+
+         case Get_Kind (Aggr) is
+            when Iir_Kind_Aggregate =>
+               Assoc := Get_Association_Choices_Chain (Aggr);
+               while Assoc /= Null_Iir loop
+                  Sub := Get_Associated (Assoc);
+                  case Get_Kind (Assoc) is
+                     when Iir_Kind_Choice_By_None =>
+                        if N_Info = Null_Iir then
+                           New_Array_Aggr_El
+                             (List,
+                              Translate_Static_Expression (Sub, El_Type));
+                        else
+                           Translate_Static_Aggregate_1
+                             (List, Sub, N_Info, El_Type);
+                        end if;
+                     when others =>
+                        Error_Kind ("translate_static_aggregate_1(2)", Assoc);
+                  end case;
+                  Assoc := Get_Chain (Assoc);
+               end loop;
+            when Iir_Kind_String_Literal =>
+               if N_Info /= Null_Iir then
+                  raise Internal_Error;
+               end if;
+               Translate_Static_String_Literal_Inner (List, Aggr, El_Type);
+            when Iir_Kind_Bit_String_Literal =>
+               if N_Info /= Null_Iir then
+                  raise Internal_Error;
+               end if;
+               Translate_Static_Bit_String_Literal_Inner (List, Aggr, El_Type);
+            when others =>
+               Error_Kind ("translate_static_aggregate_1", Aggr);
+         end case;
+      end Translate_Static_Aggregate_1;
+
+      function Translate_Static_Aggregate (Aggr : Iir)
+                                          return O_Cnode
+      is
+         Aggr_Type : Iir;
+         El_Type : Iir;
+         List : O_Array_Aggr_List;
+         Res : O_Cnode;
+      begin
+         Aggr_Type := Get_Type (Aggr);
+         Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, True);
+         El_Type := Get_Element_Subtype (Aggr_Type);
+         Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value));
+
+         Translate_Static_Aggregate_1
+           (List, Aggr, Get_Aggregate_Info (Aggr), El_Type);
+         Finish_Array_Aggr (List, Res);
+         return Res;
+      end Translate_Static_Aggregate;
+
+      function Translate_Static_Simple_Aggregate (Aggr : Iir)
+        return O_Cnode
+      is
+         Aggr_Type : Iir;
+         El_List : Iir_List;
+         El : Iir;
+         El_Type : Iir;
+         List : O_Array_Aggr_List;
+         Res : O_Cnode;
+      begin
+         Aggr_Type := Get_Type (Aggr);
+         Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, True);
+         El_Type := Get_Element_Subtype (Aggr_Type);
+         El_List := Get_Simple_Aggregate_List (Aggr);
+         Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value));
+
+         for I in Natural loop
+            El := Get_Nth_Element (El_List, I);
+            exit when El = Null_Iir;
+            New_Array_Aggr_El
+              (List, Translate_Static_Expression (El, El_Type));
+         end loop;
+
+         Finish_Array_Aggr (List, Res);
+         return Res;
+      end Translate_Static_Simple_Aggregate;
+
+      function Translate_Static_String_Literal (Str : Iir)
+        return O_Cnode
+      is
+         use Name_Table;
+
+         Lit_Type : Iir;
+         Element_Type : Iir;
+         List : O_Array_Aggr_List;
+         Res : O_Cnode;
+      begin
+         Lit_Type := Get_Type (Str);
+         Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True);
+
+         Start_Array_Aggr (List, Get_Ortho_Type (Lit_Type, Mode_Value));
+
+         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;
+
+      --  Only for Strings of STD.Character.
+      function Translate_Static_String (Str_Type : Iir; Str_Ident : Name_Id)
+        return O_Cnode
+      is
+         use Name_Table;
+
+         Literal_List : Iir_List;
+         Lit : Iir;
+         List : O_Array_Aggr_List;
+         Res : O_Cnode;
+      begin
+         Chap3.Translate_Anonymous_Type_Definition (Str_Type, True);
+
+         Start_Array_Aggr (List, Get_Ortho_Type (Str_Type, Mode_Value));
+
+         Literal_List :=
+           Get_Enumeration_Literal_List (Character_Type_Definition);
+         Image (Str_Ident);
+         for I in 1 .. Name_Length loop
+            Lit := Get_Nth_Element (Literal_List,
+                                    Character'Pos (Name_Buffer (I)));
+            New_Array_Aggr_El (List, Get_Ortho_Expr (Lit));
+         end loop;
+
+         Finish_Array_Aggr (List, Res);
+         return Res;
+      end Translate_Static_String;
+
+      function Translate_Static_Bit_String_Literal
+        (Lit : Iir_Bit_String_Literal)
+        return O_Cnode
+      is
+         Lit_Type : Iir;
+         Res : O_Cnode;
+         List : O_Array_Aggr_List;
+      begin
+         Lit_Type := Get_Type (Lit);
+         Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True);
+         Start_Array_Aggr (List, Get_Ortho_Type (Lit_Type, Mode_Value));
+         Translate_Static_Bit_String_Literal_Inner (List, Lit, Lit_Type);
+         Finish_Array_Aggr (List, Res);
+         return Res;
+      end Translate_Static_Bit_String_Literal;
+
+      function Translate_String_Literal (Str : Iir) return O_Enode
+      is
+         Var : Var_Acc;
+         Info : Type_Info_Acc;
+         Str_Type : Iir;
+         Res : O_Cnode;
+         R : O_Enode;
+      begin
+         case Get_Kind (Str) is
+            when Iir_Kind_String_Literal =>
+               Res := Translate_Static_String_Literal (Str);
+            when Iir_Kind_Bit_String_Literal =>
+               Res := Translate_Static_Bit_String_Literal (Str);
+            when Iir_Kind_Simple_Aggregate =>
+               Res := Translate_Static_Simple_Aggregate (Str);
+            when Iir_Kind_Simple_Name_Attribute =>
+               Res := Translate_Static_String
+                 (Get_Type (Str), Get_Simple_Name_Identifier (Str));
+            when others =>
+               raise Internal_Error;
+         end case;
+         Str_Type := Get_Type (Str);
+         Info := Get_Info (Str_Type);
+         Var := Create_Global_Const
+           (Create_Uniq_Identifier, Info.Ortho_Type (Mode_Value),
+            O_Storage_Private, Res);
+         R := New_Address (Get_Var (Var), Info.Ortho_Ptr_Type (Mode_Value));
+         Free_Var (Var);
+         return R;
+      end Translate_String_Literal;
+
+      function Translate_Static_Implicit_Conv
+        (Expr : O_Cnode; Expr_Type : Iir; Res_Type : Iir) return O_Cnode
+      is
+         Expr_Info : Type_Info_Acc;
+         Res_Info : Type_Info_Acc;
+         Val : Var_Acc;
+         Res : O_Cnode;
+         List : O_Record_Aggr_List;
+         Bound : Var_Acc;
+      begin
+         if Res_Type = Expr_Type then
+            return Expr;
+         end if;
+         if Get_Kind (Expr_Type) /= Iir_Kind_Array_Subtype_Definition then
+            raise Internal_Error;
+         end if;
+         if Get_Kind (Res_Type) = Iir_Kind_Array_Subtype_Definition then
+            return Expr;
+         end if;
+         if Get_Kind (Res_Type) /= Iir_Kind_Array_Type_Definition then
+            raise Internal_Error;
+         end if;
+         Expr_Info := Get_Info (Expr_Type);
+         Res_Info := Get_Info (Res_Type);
+         Val := Create_Global_Const
+           (Create_Uniq_Identifier, Expr_Info.Ortho_Type (Mode_Value),
+            O_Storage_Private, Expr);
+         Bound := Expr_Info.T.Array_Bounds;
+         if Bound = null then
+            Bound := Create_Global_Const
+              (Create_Uniq_Identifier, Expr_Info.T.Bounds_Type,
+               O_Storage_Private,
+               Chap3.Create_Static_Array_Subtype_Bounds (Expr_Type));
+            Expr_Info.T.Array_Bounds := Bound;
+         end if;
+
+         Start_Record_Aggr (List, Res_Info.Ortho_Type (Mode_Value));
+         New_Record_Aggr_El
+           (List, New_Global_Address (Get_Var_Label (Val),
+                                      Res_Info.T.Base_Ptr_Type (Mode_Value)));
+         New_Record_Aggr_El
+           (List, New_Global_Address (Get_Var_Label (Bound),
+                                      Expr_Info.T.Bounds_Ptr_Type));
+         Finish_Record_Aggr (List, Res);
+         return Res;
+      end Translate_Static_Implicit_Conv;
+
+      function Translate_Numeric_Literal (Expr : Iir; Res_Type : O_Tnode)
+        return O_Cnode
+      is
+      begin
+         case Get_Kind (Expr) is
+            when Iir_Kind_Integer_Literal =>
+               return New_Signed_Literal
+                 (Res_Type, Integer_64 (Get_Value (Expr)));
+
+            when Iir_Kind_Enumeration_Literal =>
+               return Get_Ortho_Expr (Get_Enumeration_Decl (Expr));
+
+            when Iir_Kind_Floating_Point_Literal =>
+               return New_Float_Literal
+                 (Res_Type, IEEE_Float_64 (Get_Fp_Value (Expr)));
+
+            when Iir_Kind_Physical_Int_Literal =>
+               return New_Signed_Literal
+                 (Res_Type, Integer_64 (Get_Physical_Value (Expr)));
+            when Iir_Kind_Unit_Declaration =>
+               return New_Signed_Literal
+                 (Res_Type,
+                  Integer_64 (Get_Value (Get_Physical_Unit_Value (Expr))));
+            when Iir_Kind_Physical_Fp_Literal =>
+               return New_Signed_Literal
+                 (Res_Type,
+                  Integer_64
+                  (Get_Fp_Value (Expr)
+                   * Iir_Fp64 (Get_Value (Get_Physical_Unit_Value
+                                          (Get_Unit_Name (Expr))))));
+            when others =>
+               Error_Kind ("tranlate_numeric_literal", Expr);
+         end case;
+      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 : Iir;
+      begin
+         Expr_Type := Get_Type (Expr);
+         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 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 (New_Unsigned_Literal (Ghdl_Index_Type, 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
+         Actual, Formal : Iir;
+         Formal_Base : Iir;
+      begin
+         Formal := Get_Formal (Assoc);
+         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;
+
+         Formal_Base := Get_Base_Name (Formal);
+         case Get_Kind (Formal_Base) is
+            when Iir_Kind_Constant_Interface_Declaration =>
+               return Translate_Expression (Actual, Get_Type (Formal_Base));
+            when Iir_Kind_Signal_Interface_Declaration =>
+               return Translate_Implicit_Conv
+                 (M2E (Chap6.Translate_Name (Actual)),
+                  Get_Type (Actual),
+                  Get_Type (Formal_Base),
+                  Mode_Signal);
+            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
+         Constr : O_Assoc_List;
+         Assoc : Iir;
+         Info : Subprg_Info_Acc;
+         Res : Mnode;
+      begin
+         Info := Get_Info (Imp);
+
+         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
+            declare
+               Prot_Info : Type_Info_Acc;
+            begin
+               Prot_Info := Get_Info (Get_Method_Type (Imp));
+               Chap2.Add_Subprg_Instance_Assoc
+                 (Constr, Info.Subprg_Instance,
+                  Prot_Info.Ortho_Type (Mode_Value),
+                  M2E (Chap6.Translate_Name (Obj)));
+            end;
+         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);
+      end Translate_Operator_Function_Call;
+
+      function Convert_Constrained_To_Unconstrained
+        (Expr : O_Enode; Expr_Type : Iir; Atype : Iir; Kind : Object_Kind_Type)
+        return O_Enode
+      is
+         Res : O_Dnode;
+         Type_Info : Type_Info_Acc;
+         Expr_Type_Info : Type_Info_Acc;
+      begin
+         -- FIXME: to do.
+         --  Be sure the bounds variable was created.
+         --  This may be necessary for on-the-fly types, such as strings.
+         Chap3.Create_Array_Subtype (Expr_Type, True);
+
+         Expr_Type_Info := Get_Info (Expr_Type);
+         Type_Info := Get_Info (Atype);
+         Res := Create_Temp (Type_Info.Ortho_Type (Kind));
+         New_Assign_Stmt
+           (New_Selected_Element (New_Obj (Res),
+                                  Type_Info.T.Base_Field (Kind)),
+            New_Convert_Ov (Expr, Type_Info.T.Base_Ptr_Type (Kind)));
+
+         New_Assign_Stmt
+           (New_Selected_Element (New_Obj (Res),
+                                  Type_Info.T.Bounds_Field (Kind)),
+            Chap3.Get_Array_Ptr_Bounds_Ptr (O_Lnode_Null, Expr_Type, Kind));
+         return L2e_Node (New_Obj (Res), Type_Info, Kind);
+      end Convert_Constrained_To_Unconstrained;
+
+      function Convert_Array_To_Thin_Array
+        (Expr : O_Enode;
+         Expr_Type : Iir;
+         Atype : Iir;
+         Is_Sig : Object_Kind_Type)
+        return O_Enode
+      is
+         Ptr : O_Dnode;
+         Expr_Type_Info : Type_Info_Acc;
+         Expr_Indexes: Iir_List;
+         Success_Label, Failure_Label : O_Snode;
+      begin
+         Expr_Type_Info := Get_Info (Expr_Type);
+         Ptr := Create_Temp_Init
+           (Expr_Type_Info.Ortho_Ptr_Type (Is_Sig), Expr);
+
+         Open_Temp;
+         --  Check each dimension.
+         Expr_Indexes := Get_Index_Subtype_List (Expr_Type);
+         Start_Loop_Stmt (Success_Label);
+         Start_Loop_Stmt (Failure_Label);
+         for I in 1 .. Get_Nbr_Elements (Expr_Indexes) loop
+            Gen_Exit_When
+              (Failure_Label,
+               New_Compare_Op
+               (ON_Neq,
+                Chap6.Get_Array_Ptr_Bound_Length (New_Obj (Ptr),
+                                                  Expr_Type, I, Is_Sig),
+                Chap6.Get_Array_Bound_Length (O_Lnode_Null, Atype, I, Is_Sig),
+                Ghdl_Bool_Type));
+         end loop;
+         New_Exit_Stmt (Success_Label);
+         Finish_Loop_Stmt (Failure_Label);
+         Chap6.Gen_Bound_Error (Expr_Type);   --  FIXME: location.
+         Finish_Loop_Stmt (Success_Label);
+         Close_Temp;
+
+         return New_Value
+           (Chap3.Get_Array_Ptr_Base_Ptr (New_Obj (Ptr), Expr_Type, Is_Sig));
+      end Convert_Array_To_Thin_Array;
+
+      --  Convert (if necessary) EXPR translated from EXPR_ORIG to type ATYPE.
+      function Translate_Implicit_Conv (Expr : O_Enode;
+                                        Expr_Type : Iir;
+                                        Atype : Iir;
+                                        Is_Sig : Object_Kind_Type)
+        return O_Enode
+      is
+         Ainfo : Type_Info_Acc;
+         Einfo : Type_Info_Acc;
+      begin
+         if Atype = Expr_Type then
+            return Expr;
+         end if;
+         if Expr_Type = Universal_Integer_Type_Definition then
+            return New_Convert_Ov (Expr, Get_Ortho_Type (Atype, Mode_Value));
+         elsif Expr_Type = Universal_Real_Type_Definition then
+            return New_Convert_Ov (Expr, Get_Ortho_Type (Atype, Mode_Value));
+         elsif Get_Kind (Expr_Type) in Iir_Kinds_Array_Type_Definition then
+            Ainfo := Get_Info (Atype);
+            Einfo := Get_Info (Expr_Type);
+            case Ainfo.Type_Mode is
+               when Type_Mode_Fat_Array =>
+                  --  X to unconstrained.
+                  case Einfo.Type_Mode is
+                     when Type_Mode_Fat_Array =>
+                        --  unconstrained to unconstrained.
+                        return Expr;
+                     when Type_Mode_Array
+                       | Type_Mode_Ptr_Array =>
+                        --  constrained to unconstrained.
+                        return Convert_Constrained_To_Unconstrained
+                          (Expr, Expr_Type, Atype, Is_Sig);
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               when Type_Mode_Array =>
+                  --  X to constrained.
+                  case Einfo.Type_Mode is
+                     when Type_Mode_Fat_Array
+                       | Type_Mode_Ptr_Array =>
+                        --  unconstrained to constrained.
+                        return Convert_Array_To_Thin_Array (Expr, Expr_Type,
+                                                            Atype, Is_Sig);
+                     when Type_Mode_Array =>
+                        --  constrained to constrained.
+                        declare
+                           E_List, A_List : Iir_List;
+                           E_El, A_El : Iir;
+                        begin
+                           E_List := Get_Index_Subtype_List (Expr_Type);
+                           A_List := Get_Index_Subtype_List (Atype);
+                           for I in Natural loop
+                              E_El := Get_Nth_Element (E_List, I);
+                              A_El := Get_Nth_Element (A_List, I);
+                              exit when E_El = Null_Iir
+                                and then A_El = Null_Iir;
+                              if Eval_Discrete_Type_Length (E_El)
+                                /= Eval_Discrete_Type_Length (A_El)
+                              then
+                                 --  FIXME: generate a bound error ?
+                                 --  Even if this is caught at compile-time,
+                                 --  the code is not required to run.
+                                 raise Internal_Error;
+                              end if;
+                           end loop;
+                        end;
+                        return Expr;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               when Type_Mode_Ptr_Array =>
+                  case Einfo.Type_Mode is
+                     when Type_Mode_Fat_Array
+                       | Type_Mode_Array
+                       | Type_Mode_Ptr_Array =>
+                        return Convert_Array_To_Thin_Array
+                          (Expr, Expr_Type, Atype, Is_Sig);
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               when others =>
+                  raise Internal_Error;
+            end case;
+         else
+            return Expr;
+         end if;
+      end Translate_Implicit_Conv;
+
+      type Predefined_To_Onop_Type is array (Iir_Predefined_Functions)
+        of ON_Op_Kind;
+      Predefined_To_Onop : constant Predefined_To_Onop_Type :=
+        (Iir_Predefined_Boolean_Or => ON_Or,
+         Iir_Predefined_Boolean_Not => ON_Not,
+         Iir_Predefined_Boolean_And => ON_And,
+         Iir_Predefined_Boolean_Xor => ON_Xor,
+
+         Iir_Predefined_Bit_Not => ON_Not,
+         Iir_Predefined_Bit_And => ON_And,
+         Iir_Predefined_Bit_Or => ON_Or,
+         Iir_Predefined_Bit_Xor => ON_Xor,
+
+         Iir_Predefined_Integer_Equality => ON_Eq,
+         Iir_Predefined_Integer_Inequality => ON_Neq,
+         Iir_Predefined_Integer_Less_Equal => ON_Le,
+         Iir_Predefined_Integer_Less => ON_Lt,
+         Iir_Predefined_Integer_Greater => ON_Gt,
+         Iir_Predefined_Integer_Greater_Equal => ON_Ge,
+         Iir_Predefined_Integer_Plus => ON_Add_Ov,
+         Iir_Predefined_Integer_Minus => ON_Sub_Ov,
+         Iir_Predefined_Integer_Mul => ON_Mul_Ov,
+         Iir_Predefined_Integer_Rem => ON_Rem_Ov,
+         Iir_Predefined_Integer_Mod => ON_Mod_Ov,
+         Iir_Predefined_Integer_Div => ON_Div_Ov,
+         Iir_Predefined_Integer_Absolute => ON_Abs_Ov,
+         Iir_Predefined_Integer_Negation => ON_Neg_Ov,
+
+         Iir_Predefined_Enum_Equality => ON_Eq,
+         Iir_Predefined_Enum_Inequality => ON_Neq,
+         Iir_Predefined_Enum_Greater_Equal => ON_Ge,
+         Iir_Predefined_Enum_Greater => ON_Gt,
+         Iir_Predefined_Enum_Less => ON_Lt,
+         Iir_Predefined_Enum_Less_Equal => ON_Le,
+
+         Iir_Predefined_Physical_Equality => ON_Eq,
+         Iir_Predefined_Physical_Inequality => ON_Neq,
+         Iir_Predefined_Physical_Less => ON_Lt,
+         Iir_Predefined_Physical_Less_Equal => ON_Le,
+         Iir_Predefined_Physical_Greater => ON_Gt,
+         Iir_Predefined_Physical_Greater_Equal => ON_Ge,
+         Iir_Predefined_Physical_Negation => ON_Neg_Ov,
+         Iir_Predefined_Physical_Absolute => ON_Abs_Ov,
+         Iir_Predefined_Physical_Minus => ON_Sub_Ov,
+         Iir_Predefined_Physical_Plus => ON_Add_Ov,
+
+         Iir_Predefined_Floating_Greater => ON_Gt,
+         Iir_Predefined_Floating_Greater_Equal => ON_Ge,
+         Iir_Predefined_Floating_Less => ON_Lt,
+         Iir_Predefined_Floating_Less_Equal => ON_Le,
+         Iir_Predefined_Floating_Equality => ON_Eq,
+         Iir_Predefined_Floating_Inequality => ON_Neq,
+         Iir_Predefined_Floating_Minus => ON_Sub_Ov,
+         Iir_Predefined_Floating_Plus => ON_Add_Ov,
+         Iir_Predefined_Floating_Mul => ON_Mul_Ov,
+         Iir_Predefined_Floating_Div => ON_Div_Ov,
+         Iir_Predefined_Floating_Negation => ON_Neg_Ov,
+         Iir_Predefined_Floating_Absolute => ON_Abs_Ov,
+
+         others => ON_Nil);
+
+      function Translate_Shortcut_Operator
+        (Imp : Iir_Implicit_Function_Declaration; Left, Right : Iir)
+        return O_Enode
+      is
+         Rtype : Iir;
+         Res : O_Dnode;
+         Res_Type : O_Tnode;
+         If_Blk : O_If_Block;
+         Op : ON_Op_Kind;
+         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 =>
+               Op := ON_And;
+               Invert := False;
+               Val := 1;
+            when Iir_Predefined_Bit_Nand
+              | Iir_Predefined_Boolean_Nand =>
+               Op := ON_And;
+               Invert := True;
+               Val := 1;
+            when Iir_Predefined_Bit_Or
+              | Iir_Predefined_Boolean_Or =>
+               Op := ON_Or;
+               Invert := False;
+               Val := 0;
+            when Iir_Predefined_Bit_Nor
+              | Iir_Predefined_Boolean_Nor =>
+               Op := ON_Or;
+               Invert := True;
+               Val := 0;
+            when others =>
+               Ada.Text_IO.Put_Line
+                 ("translate_shortcut_operator: cannot handle "
+                  & Iir_Predefined_Functions'Image (Kind));
+               raise Internal_Error;
+         end case;
+
+         V := Get_Ortho_Expr
+           (Get_Nth_Element (Get_Enumeration_Literal_List (Rtype), Val));
+         Start_If_Stmt (If_Blk,
+                        New_Compare_Op (ON_Eq,
+                                        New_Obj_Value (Res), New_Lit (V),
+                                        Ghdl_Bool_Type));
+         Open_Temp;
+         New_Assign_Stmt (New_Obj (Res), Chap7.Translate_Expression (Right));
+         Close_Temp;
+         Finish_If_Stmt (If_Blk);
+         if Invert then
+            return New_Monadic_Op (ON_Not, New_Obj_Value (Res));
+         else
+            return New_Obj_Value (Res);
+         end if;
+      end Translate_Shortcut_Operator;
+
+      function Translate_Lib_Operator (Left, Right : O_Enode; Func : O_Dnode)
+        return O_Enode
+      is
+         Constr : O_Assoc_List;
+      begin
+         Start_Association (Constr, Func);
+         New_Association (Constr, Left);
+         if Right /= O_Enode_Null then
+            New_Association (Constr, Right);
+         end if;
+         return New_Function_Call (Constr);
+      end Translate_Lib_Operator;
+
+      function Translate_Predefined_Lib_Operator
+        (Left, Right : O_Enode; Func : Iir_Implicit_Function_Declaration)
+        return O_Enode
+      is
+         Info : Subprg_Info_Acc;
+         Constr : O_Assoc_List;
+      begin
+         Info := Get_Info (Func);
+         Start_Association (Constr, Info.Ortho_Func);
+         Chap2.Add_Subprg_Instance_Assoc (Constr, Info.Subprg_Instance);
+         New_Association (Constr, Left);
+         if Right /= O_Enode_Null then
+            New_Association (Constr, Right);
+         end if;
+         return New_Function_Call (Constr);
+      end Translate_Predefined_Lib_Operator;
+
+      function Translate_Predefined_Array_Operator
+        (Left, Right : O_Enode; Func : Iir)
+        return O_Enode
+      is
+         Res : O_Dnode;
+         Constr : O_Assoc_List;
+         Info : Type_Info_Acc;
+         Func_Info : Subprg_Info_Acc;
+      begin
+         Create_Temp_Stack2_Mark;
+         Info := Get_Info (Get_Return_Type (Func));
+         Res := Create_Temp (Info.Ortho_Type (Mode_Value));
+         Func_Info := Get_Info (Func);
+         Start_Association (Constr, Func_Info.Ortho_Func);
+         Chap2.Add_Subprg_Instance_Assoc (Constr, Func_Info.Subprg_Instance);
+         New_Association (Constr,
+                          New_Address (New_Obj (Res),
+                                       Info.Ortho_Ptr_Type (Mode_Value)));
+         New_Association (Constr, Left);
+         if Right /= O_Enode_Null then
+            New_Association (Constr, Right);
+         end if;
+         New_Procedure_Call (Constr);
+         return New_Address (New_Obj (Res), Info.Ortho_Ptr_Type (Mode_Value));
+      end Translate_Predefined_Array_Operator;
+
+      function Translate_Predefined_Array_Operator_Convert
+        (Left, Right : O_Enode; Func : Iir; Res_Type : Iir)
+        return O_Enode
+      is
+         Res : O_Enode;
+         Ret_Type : Iir;
+      begin
+         Ret_Type := Get_Return_Type (Func);
+         Res := Translate_Predefined_Array_Operator (Left, Right, Func);
+         return Translate_Implicit_Conv (Res, Ret_Type, Res_Type, Mode_Value);
+      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)
+        return O_Enode
+      is
+         Arr_El1 : O_Enode;
+         Arr_El2 : O_Enode;
+         Ret_Type : Iir;
+         Res : O_Enode;
+         Kind : Iir_Predefined_Functions;
+      begin
+         Ret_Type := Get_Return_Type (Imp);
+         Kind := Get_Implicit_Definition (Imp);
+         case Kind is
+            when Iir_Predefined_Element_Array_Concat
+              | Iir_Predefined_Element_Element_Concat =>
+               Arr_El1 := Translate_Element_To_Array (Left_Tree, Ret_Type);
+            when others =>
+               Arr_El1 := Left_Tree;
+         end case;
+         case Kind is
+            when Iir_Predefined_Array_Element_Concat
+              | Iir_Predefined_Element_Element_Concat =>
+               Arr_El2 := Translate_Element_To_Array (Right_Tree, Ret_Type);
+            when others =>
+               Arr_El2 := Right_Tree;
+         end case;
+         Res := Translate_Predefined_Array_Operator (Arr_El1, Arr_El2, Imp);
+         return Translate_Implicit_Conv (Res, Ret_Type, Res_Type, Mode_Value);
+      end Translate_Concat_Operator;
+
+      function Translate_Predefined_Operator
+        (Imp : Iir_Implicit_Function_Declaration;
+         Left, Right : Iir;
+         Res_Type : Iir)
+        return O_Enode
+      is
+         Left_Tree : O_Enode;
+         Right_Tree : O_Enode;
+         Kind : Iir_Predefined_Functions;
+         Left_Type : Iir;
+         Right_Type : Iir;
+         Res_Otype : O_Tnode;
+         Op : ON_Op_Kind;
+         Interface : Iir;
+         Res : O_Enode;
+      begin
+         Kind := Get_Implicit_Definition (Imp);
+         if Iir_Predefined_Shortcut_P (Kind) then
+            return Translate_Shortcut_Operator (Imp, Left, Right);
+         end if;
+
+         Res_Otype := Get_Ortho_Type (Res_Type, Mode_Value);
+         Interface := Get_Interface_Declaration_Chain (Imp);
+         if Left = Null_Iir then
+            Left_Tree := O_Enode_Null;
+         else
+            Left_Type := Get_Type (Interface);
+            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 (Interface));
+            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);
+            return Res;
+         end if;
+
+         case Kind is
+            when Iir_Predefined_Bit_Xnor
+              | Iir_Predefined_Boolean_Xnor =>
+               return New_Monadic_Op
+                 (ON_Not, New_Dyadic_Op (ON_Xor, Left_Tree, Right_Tree));
+
+            when Iir_Predefined_Integer_Identity
+              | Iir_Predefined_Floating_Identity
+              | Iir_Predefined_Physical_Identity =>
+               return Translate_Implicit_Conv
+                 (Left_Tree, Left_Type, Res_Type, Mode_Value);
+
+            when Iir_Predefined_Access_Equality
+              | Iir_Predefined_Access_Inequality =>
+               if Is_Composite (Get_Info (Left_Type)) then
+                  --  a fat pointer.
+                  declare
+                     T : Type_Info_Acc;
+                     B : Type_Info_Acc;
+                     L, R : O_Dnode;
+                     V1, V2 : O_Enode;
+                     Op1, Op2 : ON_Op_Kind;
+                  begin
+                     if Kind = Iir_Predefined_Access_Equality then
+                        Op1 := ON_Eq;
+                        Op2 := ON_And;
+                     else
+                        Op1 := ON_Neq;
+                        Op2 := ON_Or;
+                     end if;
+                     T := Get_Info (Left_Type);
+                     B := Get_Info (Get_Designated_Type (Left_Type));
+                     L := Create_Temp (T.Ortho_Ptr_Type (Mode_Value));
+                     R := Create_Temp (T.Ortho_Ptr_Type (Mode_Value));
+                     New_Assign_Stmt (New_Obj (L), Left_Tree);
+                     New_Assign_Stmt (New_Obj (R), Right_Tree);
+                     V1 := New_Compare_Op
+                       (Op1,
+                        New_Value_Selected_Acc_Value
+                        (New_Obj (L), B.T.Base_Field (Mode_Value)),
+                        New_Value_Selected_Acc_Value
+                        (New_Obj (R), B.T.Base_Field (Mode_Value)),
+                        Std_Boolean_Type_Node);
+                     V2 := New_Compare_Op
+                       (Op1,
+                        New_Value_Selected_Acc_Value
+                        (New_Obj (L), B.T.Bounds_Field (Mode_Value)),
+                        New_Value_Selected_Acc_Value
+                        (New_Obj (R), B.T.Bounds_Field (Mode_Value)),
+                        Std_Boolean_Type_Node);
+                     return New_Dyadic_Op (Op2, V1, V2);
+                  end;
+               else
+                  --  a thin pointer.
+                  if Kind = Iir_Predefined_Access_Equality then
+                     return New_Compare_Op
+                       (ON_Eq, Left_Tree, Right_Tree, Std_Boolean_Type_Node);
+                  else
+                     return New_Compare_Op
+                       (ON_Neq, Left_Tree, Right_Tree, Std_Boolean_Type_Node);
+                  end if;
+               end if;
+
+            when Iir_Predefined_Physical_Integer_Div =>
+               return New_Dyadic_Op (ON_Div_Ov, Left_Tree,
+                                     New_Convert_Ov (Right_Tree, Res_Otype));
+            when Iir_Predefined_Physical_Physical_Div =>
+               return New_Convert_Ov
+                 (New_Dyadic_Op (ON_Div_Ov, Left_Tree, Right_Tree), Res_Otype);
+
+            --  LRM 7.2.6
+            --  Multiplication of a value P of a physical type Tp by a
+            --  value I of type INTEGER is equivalent to the following
+            --  computation: Tp'Val (Tp'Pos (P) * I)
+            --  FIXME: this is not what is really done...
+            when Iir_Predefined_Integer_Physical_Mul =>
+               return New_Dyadic_Op (ON_Mul_Ov,
+                                     New_Convert_Ov (Left_Tree, Res_Otype),
+                                     Right_Tree);
+            when Iir_Predefined_Physical_Integer_Mul =>
+               return New_Dyadic_Op (ON_Mul_Ov, Left_Tree,
+                                     New_Convert_Ov (Right_Tree, Res_Otype));
+
+            --  LRM 7.2.6
+            --  Multiplication of a value P of a physical type Tp by a
+            --  value F of type REAL is equivalten to the following
+            --  computation: Tp'Val (INTEGER (REAL (Tp'Pos (P)) * F))
+            --  FIXME: we do not restrict with INTEGER.
+            when Iir_Predefined_Physical_Real_Mul =>
+               declare
+                  Right_Otype : O_Tnode;
+               begin
+                  Right_Otype := Get_Ortho_Type (Right_Type, Mode_Value);
+                  return New_Convert_Ov
+                    (New_Dyadic_Op (ON_Mul_Ov,
+                                    New_Convert_Ov (Left_Tree, Right_Otype),
+                                    Right_Tree),
+                     Res_Otype);
+               end;
+            when Iir_Predefined_Physical_Real_Div =>
+               declare
+                  Right_Otype : O_Tnode;
+               begin
+                  Right_Otype := Get_Ortho_Type (Right_Type, Mode_Value);
+                  return New_Convert_Ov
+                    (New_Dyadic_Op (ON_Div_Ov,
+                                    New_Convert_Ov (Left_Tree, Right_Otype),
+                                    Right_Tree),
+                     Res_Otype);
+               end;
+            when Iir_Predefined_Real_Physical_Mul =>
+               declare
+                  Left_Otype : O_Tnode;
+               begin
+                  Left_Otype := Get_Ortho_Type (Left_Type, Mode_Value);
+                  return New_Convert_Ov
+                    (New_Dyadic_Op (ON_Mul_Ov,
+                                    Left_Tree,
+                                    New_Convert_Ov (Right_Tree, Left_Otype)),
+                     Res_Otype);
+               end;
+
+            when Iir_Predefined_Universal_R_I_Mul =>
+               return New_Dyadic_Op (ON_Mul_Ov,
+                                     Left_Tree,
+                                     New_Convert_Ov (Right_Tree, Res_Otype));
+
+            when Iir_Predefined_Floating_Exp =>
+               Res := Translate_Lib_Operator
+                 (New_Convert_Ov (Left_Tree, Std_Real_Type_Node),
+                  Right_Tree, Ghdl_Real_Exp);
+               return New_Convert_Ov (Res, Res_Otype);
+            when Iir_Predefined_Integer_Exp =>
+               Res := Translate_Lib_Operator
+                 (New_Convert_Ov (Left_Tree, Std_Integer_Type_Node),
+                  Right_Tree,
+                  Ghdl_Integer_Exp);
+               return New_Convert_Ov (Res, Res_Otype);
+
+            when Iir_Predefined_Array_Inequality
+              | Iir_Predefined_Record_Inequality =>
+               return New_Monadic_Op
+                 (ON_Not, Translate_Predefined_Lib_Operator
+                  (Left_Tree, Right_Tree, Imp));
+            when Iir_Predefined_Array_Equality
+              | Iir_Predefined_Record_Equality =>
+               return Translate_Predefined_Lib_Operator
+                 (Left_Tree, Right_Tree, Imp);
+
+            when Iir_Predefined_Array_Greater =>
+               return New_Compare_Op
+                 (ON_Eq,
+                  Translate_Predefined_Lib_Operator (Left_Tree, Right_Tree,
+                                                     Imp),
+                  New_Lit (Ghdl_Compare_Gt),
+                  Std_Boolean_Type_Node);
+            when Iir_Predefined_Array_Greater_Equal =>
+               return New_Compare_Op
+                 (ON_Ge,
+                  Translate_Predefined_Lib_Operator (Left_Tree, Right_Tree,
+                                                     Imp),
+                  New_Lit (Ghdl_Compare_Eq),
+                  Std_Boolean_Type_Node);
+            when Iir_Predefined_Array_Less =>
+               return New_Compare_Op
+                 (ON_Eq,
+                  Translate_Predefined_Lib_Operator (Left_Tree, Right_Tree,
+                                                     Imp),
+                  New_Lit (Ghdl_Compare_Lt),
+                  Std_Boolean_Type_Node);
+            when Iir_Predefined_Array_Less_Equal =>
+               return New_Compare_Op
+                 (ON_Le,
+                  Translate_Predefined_Lib_Operator (Left_Tree, Right_Tree,
+                                                     Imp),
+                  New_Lit (Ghdl_Compare_Eq),
+                  Std_Boolean_Type_Node);
+
+            when Iir_Predefined_Bit_Array_And
+              | Iir_Predefined_Bit_Array_Or
+              | Iir_Predefined_Bit_Array_Nand
+              | Iir_Predefined_Bit_Array_Nor
+              | Iir_Predefined_Bit_Array_Xor
+              | Iir_Predefined_Bit_Array_Xnor
+              | Iir_Predefined_Bit_Array_Not
+              | Iir_Predefined_Boolean_Array_And
+              | Iir_Predefined_Boolean_Array_Or
+              | Iir_Predefined_Boolean_Array_Nand
+              | Iir_Predefined_Boolean_Array_Nor
+              | Iir_Predefined_Boolean_Array_Xor
+              | Iir_Predefined_Boolean_Array_Xnor
+              | Iir_Predefined_Boolean_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);
+
+            when Iir_Predefined_Endfile =>
+               return Translate_Lib_Operator
+                 (Left_Tree, O_Enode_Null, Ghdl_File_Endfile);
+
+            when Iir_Predefined_Now_Function =>
+               return New_Obj_Value (Ghdl_Now);
+
+            when others =>
+               Ada.Text_IO.Put_Line
+                 ("translate_predefined_operator(2): cannot handle "
+                  & Iir_Predefined_Functions'Image (Kind));
+               raise Internal_Error;
+               return O_Enode_Null;
+         end case;
+      end Translate_Predefined_Operator;
+
+      --  Assign EXPR to TARGET.
+      procedure Translate_Assign
+        (Target : Mnode; Val : O_Enode; Expr : Iir; Target_Type : Iir)
+      is
+         T_Info : Type_Info_Acc;
+      begin
+         T_Info := Get_Info (Target_Type);
+         case T_Info.Type_Mode is
+            when Type_Mode_Scalar =>
+               if not Chap3.Need_Range_Check (Target_Type) then
+                  New_Assign_Stmt (M2Lv (Target), Val);
+               else
+                  declare
+                     V : O_Dnode;
+                  begin
+                     Open_Temp;
+                     V := Create_Temp_Init (T_Info.Ortho_Type (Mode_Value),
+                                            Val);
+                     Chap3.Check_Range (V, Expr, Target_Type);
+                     New_Assign_Stmt (M2Lv (Target), New_Obj_Value (V));
+                     Close_Temp;
+                  end;
+               end if;
+            when Type_Mode_Acc
+              | Type_Mode_File =>
+               New_Assign_Stmt (M2Lv (Target), Val);
+            when Type_Mode_Fat_Acc =>
+               declare
+                  T, E : O_Dnode;
+               begin
+                  T := Create_Temp_Ptr
+                    (Target_Type, M2Lv (Target), Mode_Value);
+                  E := Create_Temp_Init
+                    (T_Info.Ortho_Ptr_Type (Mode_Value), Val);
+                  Copy_Fat_Access (T, E, Target_Type);
+               end;
+            when Type_Mode_Fat_Array =>
+               declare
+                  T : Mnode;
+                  E : O_Dnode;
+               begin
+                  T := Stabilize (Target);
+                  E := Create_Temp_Init
+                    (T_Info.Ortho_Ptr_Type (Mode_Value), Val);
+                  Chap3.Check_Array_Match
+                    (Target_Type, M2Lp (T), Mode_Value,
+                     Get_Type (Expr), New_Obj (E), Mode_Value,
+                     Null_Iir);
+                  Chap3.Translate_Object_Copy
+                    (T, New_Obj_Value (E), Target_Type);
+               end;
+            when Type_Mode_Array
+              | Type_Mode_Ptr_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);
+            Close_Temp;
+         end if;
+      end Translate_Assign;
+
+      --  If AGGR is of the form (others => (others => EXPR)) (where the
+      --   number of (others => ) sub-aggregate is at least 1, return EXPR
+      --   otherwise return NULL_IIR.
+      function Is_Aggregate_Others (Aggr : Iir_Aggregate) return Iir
+      is
+         Chain : Iir;
+         Aggr1 : Iir;
+         --Type_Info : Type_Info_Acc;
+      begin
+         Aggr1 := Aggr;
+         --  Do not use translate_aggregate_others for a complex type.
+         --Type_Info := Get_Info (Get_Type (Aggr));
+         --if Type_Info.C /= null and then Type_Info.C.Builder_Need_Func then
+         --   return Null_Iir;
+         --end if;
+         loop
+            Chain := Get_Association_Choices_Chain (Aggr1);
+            if not Is_Chain_Length_One (Chain) then
+               return Null_Iir;
+            end if;
+            if Get_Kind (Chain) /= Iir_Kind_Choice_By_Others then
+               return Null_Iir;
+            end if;
+            Aggr1 := Get_Associated (Chain);
+            case Get_Kind (Aggr1) is
+               when Iir_Kind_Aggregate =>
+                  if Get_Type (Aggr1) /= Null_Iir then
+                     --  Stop when a sub-aggregate is in fact an aggregate.
+                     return Aggr1;
+                  end if;
+               when Iir_Kind_String_Literal
+                 | Iir_Kind_Bit_String_Literal =>
+                  return Null_Iir;
+                  --Error_Kind ("is_aggregate_others", Aggr1);
+               when others =>
+                  return Aggr1;
+            end case;
+         end loop;
+      end Is_Aggregate_Others;
+
+      --  Generate code for (others => EL).
+      procedure Translate_Aggregate_Others
+        (Target : Mnode; Target_Type : Iir; El : Iir)
+      is
+         Base_Ptr : Mnode;
+         Info : Type_Info_Acc;
+         It : O_Dnode;
+         Len : O_Dnode;
+         Len_Val : O_Enode;
+         Label : O_Snode;
+         Arr_Var : Mnode;
+         El_Node : Mnode;
+      begin
+         Open_Temp;
+
+         Info := Get_Info (Target_Type);
+         case Info.Type_Mode is
+            when Type_Mode_Fat_Array =>
+               Arr_Var := Stabilize (Target);
+               Base_Ptr := Stabilize (Chap3.Get_Array_Base (Arr_Var));
+               Len_Val := Chap3.Get_Array_Length (Arr_Var, Target_Type);
+            when Type_Mode_Ptr_Array
+              | 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
+         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;
+
+         case Get_Kind (Aggr) is
+            when Iir_Kind_Aggregate =>
+               --  Continue below.
+               null;
+            when Iir_Kind_String_Literal =>
+               declare
+                  Literal_List : Iir_List;
+                  Lit : Iir;
+                  Pos : O_Enode;
+                  Ptr : String_Fat_Acc;
+                  Len : Natural;
+               begin
+                  Ptr := Get_String_Fat_Acc (Aggr);
+                  Len := Get_String_Length (Aggr);
+                  Literal_List := Get_Enumeration_Literal_List
+                    (Get_Base_Type (Expr_Type));
+                  for I in 1 .. Len loop
+                     Lit := Find_Name_In_List
+                       (Literal_List, Name_Table.Get_Identifier (Ptr (I)));
+                     if I = 1 then
+                        Pos := New_Obj_Value (Var_Index);
+                     else
+                        Pos := New_Dyadic_Op
+                          (ON_Add_Ov,
+                           New_Obj_Value (Var_Index),
+                           New_Lit (New_Unsigned_Literal
+                                    (Ghdl_Index_Type, Natural'Pos (I - 1))));
+                     end if;
+                     New_Assign_Stmt
+                       (M2Lv (Chap3.Index_Base (Base_Ptr, Aggr_Type, Pos)),
+                        New_Lit (Get_Ortho_Expr (Lit)));
+                  end loop;
+                  New_Assign_Stmt
+                    (New_Obj (Var_Index),
+                     New_Dyadic_Op
+                     (ON_Add_Ov,
+                      New_Obj_Value (Var_Index),
+                      New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                     Natural'Pos (Len)))));
+               end;
+               return;
+            when Iir_Kind_Bit_String_Literal =>
+               raise Internal_Error;
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         El := Get_Association_Choices_Chain (Aggr);
+
+         --  First, assign positionnal association.
+         --  FIXME: count the number of positionnal association and generate
+         --   an error if there is more positionnal association than elements
+         --   in the array.
+         P := 0;
+         loop
+            if El = Null_Iir then
+               --  There is only positionnal associations.
+               return;
+            end if;
+            exit when Get_Kind (El) /= Iir_Kind_Choice_By_None;
+            Do_Assign (Get_Associated (El));
+            P := P + 1;
+            El := Get_Chain (El);
+         end loop;
+
+         --  Then, assign named or others association.
+         if Get_Chain (El) = Null_Iir then
+            --  There is only one choice
+            case Get_Kind (El) is
+               when Iir_Kind_Choice_By_Others =>
+                  --  falltrough...
+                  null;
+               when Iir_Kind_Choice_By_Expression =>
+                  Do_Assign (Get_Associated (El));
+                  return;
+               when Iir_Kind_Choice_By_Range =>
+                  declare
+                     Var_Length : O_Dnode;
+                     Var_I : O_Dnode;
+                     Label : O_Snode;
+                  begin
+                     Open_Temp;
+                     Var_Length := Create_Temp_Init
+                       (Ghdl_Index_Type,
+                        Chap7.Translate_Range_Length (Get_Expression (El)));
+                     Var_I := Create_Temp (Ghdl_Index_Type);
+                     Init_Var (Var_I);
+                     Start_Loop_Stmt (Label);
+                     Gen_Exit_When (Label,
+                                    New_Compare_Op (ON_Eq,
+                                                    New_Obj_Value (Var_I),
+                                                    New_Obj_Value (Var_Length),
+                                                    Ghdl_Bool_Type));
+                     Do_Assign (Get_Associated (El));
+                     Inc_Var (Var_I);
+                     Finish_Loop_Stmt (Label);
+                     Close_Temp;
+                  end;
+                  return;
+               when others =>
+                  Error_Kind ("translate_array_aggregate_gen", El);
+            end case;
+         end if;
+
+         --  Several choices..
+         declare
+            Range_Type : Iir;
+            Var_Pos : O_Dnode;
+            Var_Len : O_Dnode;
+            Range_Ptr : Mnode;
+            Rtinfo : Type_Info_Acc;
+            If_Blk : O_If_Block;
+            Case_Blk : O_Case_Block;
+            Label : O_Snode;
+            El_Assoc : Iir;
+            Len_Tmp : O_Enode;
+         begin
+            Open_Temp;
+            --  Create a loop from left +- number of positionnals associations
+            --   to/downto right.
+            Range_Type :=
+              Get_Base_Type (Get_Nth_Element (Index_List, Dim - 1));
+            Rtinfo := Get_Info (Range_Type);
+            Var_Pos := Create_Temp (Rtinfo.Ortho_Type (Mode_Value));
+            Range_Ptr := Stabilize
+              (Chap3.Bounds_To_Range (Bounds_Ptr, Aggr_Type, Dim));
+            New_Assign_Stmt (New_Obj (Var_Pos),
+                             M2E (Chap3.Range_To_Left (Range_Ptr)));
+            Var_Len := Create_Temp (Ghdl_Index_Type);
+            if P /= 0 then
+               Start_If_Stmt
+                 (If_Blk,
+                  New_Compare_Op (ON_Eq,
+                                  M2E (Chap3.Range_To_Dir (Range_Ptr)),
+                                  New_Lit (Ghdl_Dir_To_Node),
+                                  Ghdl_Bool_Type));
+               Chap8.Gen_Update_Iterator (Var_Pos, Iir_To, Unsigned_64 (P),
+                                          Range_Type);
+               New_Else_Stmt (If_Blk);
+               Chap8.Gen_Update_Iterator (Var_Pos, Iir_Downto, Unsigned_64 (P),
+                                          Range_Type);
+               Finish_If_Stmt (If_Blk);
+            end if;
+
+            Len_Tmp := M2E (Chap3.Range_To_Length (Range_Ptr));
+            if P /= 0 then
+               Len_Tmp := New_Dyadic_Op
+                 (ON_Sub_Ov,
+                  Len_Tmp,
+                  New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                 Unsigned_64 (P))));
+            end if;
+            New_Assign_Stmt (New_Obj (Var_Len), Len_Tmp);
+
+            --  Start loop.
+            Start_Loop_Stmt (Label);
+            --  Check if end of loop.
+            Gen_Exit_When
+              (Label,
+               New_Compare_Op (ON_Eq,
+                               New_Obj_Value (Var_Len),
+                               New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                              0)),
+                               Ghdl_Bool_Type));
+
+            --  convert aggr into a case statement.
+            Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Pos));
+            El_Assoc := Null_Iir;
+            while El /= Null_Iir loop
+               Start_Choice (Case_Blk);
+               Chap8.Translate_Case_Choice (El, Range_Type, Case_Blk);
+               if Get_Associated (El) /= Null_Iir then
+                  El_Assoc := Get_Associated (El);
+               end if;
+               Finish_Choice (Case_Blk);
+               Do_Assign (El_Assoc);
+               P := P + 1;
+               El := Get_Chain (El);
+            end loop;
+            Finish_Case_Stmt (Case_Blk);
+            --  Update var_pos
+            Start_If_Stmt
+              (If_Blk,
+               New_Compare_Op (ON_Eq,
+                               M2E (Chap3.Range_To_Dir (Range_Ptr)),
+                               New_Lit (Ghdl_Dir_To_Node),
+                               Ghdl_Bool_Type));
+            Chap8.Gen_Update_Iterator (Var_Pos, Iir_To, Unsigned_64 (1),
+                                       Range_Type);
+            New_Else_Stmt (If_Blk);
+            Chap8.Gen_Update_Iterator (Var_Pos, Iir_Downto, Unsigned_64 (1),
+                                       Range_Type);
+            Finish_If_Stmt (If_Blk);
+            New_Assign_Stmt
+              (New_Obj (Var_Len),
+               New_Dyadic_Op (ON_Sub_Ov,
+                              New_Obj_Value (Var_Len),
+                              New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                             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 : Iir := Get_Type (Aggr);
+         Aggr_Base_Type : Iir_Record_Type_Definition :=
+           Get_Base_Type (Aggr_Type);
+         Nbr_El : Iir_Index32 :=
+           Get_Number_Element_Declaration (Aggr_Base_Type);
+
+         --  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 (Get_Element_Position (El)) := True;
+         end Set_El;
+
+         Assoc : Iir;
+         El : Iir;
+         N_El_Expr : Iir;
+      begin
+         Open_Temp;
+         Targ := Stabilize (Target);
+         El := Get_Element_Declaration_Chain (Aggr_Base_Type);
+         Assoc := Get_Association_Choices_Chain (Aggr);
+         while Assoc /= Null_Iir loop
+            N_El_Expr := Get_Associated (Assoc);
+            if N_El_Expr /= Null_Iir then
+               El_Expr := N_El_Expr;
+            end if;
+            case Get_Kind (Assoc) is
+               when Iir_Kind_Choice_By_None =>
+                  Set_El (El);
+                  El := Get_Chain (El);
+               when Iir_Kind_Choice_By_Name =>
+                  Set_El (Get_Name (Assoc));
+                  El := Null_Iir;
+               when Iir_Kind_Choice_By_Others =>
+                  El := Get_Element_Declaration_Chain (Aggr_Base_Type);
+                  for J in Set_Array'Range loop
+                     if not Set_Array (J) then
+                        Set_El (El);
+                     end if;
+                     El := Get_Chain (El);
+                  end loop;
+                  pragma Assert (El = Null_Iir);
+               when others =>
+                  Error_Kind ("translate_record_aggregate", Assoc);
+            end case;
+            Assoc := Get_Chain (Assoc);
+         end loop;
+         Close_Temp;
+      end Translate_Record_Aggregate;
+
+      procedure Translate_Array_Aggregate
+        (Target : Mnode; Target_Type : Iir; Aggr : Iir)
+      is
+         Aggr_Type : Iir;
+         Base : Mnode;
+         Bounds : Mnode;
+         Var_Index : O_Dnode;
+         Targ : Mnode;
+         Tinfo : Type_Info_Acc;
+
+         Range_Ptr : Mnode;
+         Rinfo : Type_Info_Acc;
+         Bt : Iir;
+
+         function Check_Value
+           (Lval : Iir; Lop : ON_Op_Kind; Rval : Iir; Rop : ON_Op_Kind)
+            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 (Range_Ptr)),
+               Ghdl_Bool_Type);
+            R := New_Compare_Op
+              (Rop,
+               New_Lit (Translate_Static_Expression (Rval, Bt)),
+               M2E (Chap3.Range_To_Right (Range_Ptr)),
+               Ghdl_Bool_Type);
+            return New_Dyadic_Op (ON_Or, L, R);
+         end Check_Value;
+
+         Index_List : Iir_List;
+         Targ_Index_List : Iir_List;
+         Subtarg_Type : Iir;
+         Subaggr_Type : Iir;
+         L, H : Iir;
+         Max : Iir_Int32;
+         Has_Others : Boolean;
+
+         Aggr_Info : Iir_Aggregate_Info;
+
+         Var_Err : O_Dnode;
+         E : O_Enode;
+         If_Blk : O_If_Block;
+         Op : ON_Op_Kind;
+      begin
+         Tinfo := Get_Info (Target_Type);
+         Open_Temp;
+         --  FIXME: to be removed ?
+         --Chap3.Translate_Type_Definition (Aggr_Type);
+         Targ := Stabilize (Target);
+         Base := Stabilize (Chap3.Get_Array_Base (Targ));
+         Bounds := Stabilize (Chap3.Get_Array_Bounds (Targ));
+
+         --  Check type
+         Aggr_Type := Get_Type (Aggr);
+         Index_List := Get_Index_Subtype_List (Aggr_Type);
+         Targ_Index_List := Get_Index_Subtype_List (Target_Type);
+         Aggr_Info := Get_Aggregate_Info (Aggr);
+         for I in Natural loop
+            Subaggr_Type := Get_Nth_Element (Index_List, I);
+            exit when Subaggr_Type = Null_Iir;
+            Subtarg_Type := Get_Nth_Element (Targ_Index_List, I);
+
+            Bt := Get_Base_Type (Subaggr_Type);
+            Rinfo := Get_Info (Bt);
+
+            if Get_Type_Staticness (Subaggr_Type) /= Locally then
+               --  Aggregate has dynamic bounds.
+               if Subaggr_Type /= Subtarg_Type then
+                  --  And it is not the same as the target.
+                  --  Must be checked.
+
+                  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;
+               end if;
+            else
+               --  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);
+               Max := Get_Aggr_Max_Length (Aggr_Info);
+               L := Get_Aggr_Low_Limit (Aggr_Info);
+
+               if Max > 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
+                     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);
+                     else
+                        E := Check_Value (L, ON_Neq, H, ON_Neq);
+                     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);
+                     else
+                        E := Check_Value (H, ON_Neq, L, ON_Neq);
+                     end if;
+                     New_Assign_Stmt (New_Obj (Var_Err), E);
+                     Finish_If_Stmt (If_Blk);
+                     -- If L and H are greather than the maximum length,
+                     -- then there is no need to check with max.
+                     if Iir_Int32 (Eval_Pos (H) - Eval_Pos (L) + 1) >= Max then
+                        Max := 0;
+                     end if;
+                  end if;
+                  if Max > 0 then
+                     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 (Max))),
+                        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 (New_Unsigned_Literal (Ghdl_Index_Type, 0)));
+         Translate_Array_Aggregate_Gen
+           (Base, Bounds, Aggr, Aggr_Type, 1, Var_Index);
+         Close_Temp;
+      end Translate_Array_Aggregate;
+
+      procedure Translate_Aggregate
+        (Target : Mnode; Target_Type : Iir; Aggr : Iir)
+      is
+         Aggr_Type : Iir;
+         El : Iir;
+      begin
+         Aggr_Type := Get_Type (Aggr);
+         case Get_Kind (Aggr_Type) is
+            when Iir_Kind_Array_Subtype_Definition
+              | Iir_Kind_Array_Type_Definition =>
+               El := Is_Aggregate_Others (Aggr);
+               if El /= Null_Iir then
+                  Translate_Aggregate_Others (Target, Target_Type, El);
+               else
+                  Translate_Array_Aggregate (Target, Target_Type, Aggr);
+               end if;
+            when Iir_Kind_Record_Type_Definition
+              | Iir_Kind_Record_Subtype_Definition =>
+               Translate_Record_Aggregate (Target, Aggr);
+            when others =>
+               Error_Kind ("translate_aggregate", Aggr_Type);
+         end case;
+      end Translate_Aggregate;
+
+      function Translate_Allocator_By_Expression (Expr : Iir)
+        return O_Enode
+      is
+         Val : O_Enode;
+         Val_M : Mnode;
+         P_Type : Iir;
+         P_Info : Type_Info_Acc;
+         D_Type : Iir;
+         D_Info : Type_Info_Acc;
+         R : Mnode;
+         Rtype : O_Tnode;
+      begin
+         P_Type := Get_Type (Expr);
+         P_Info := Get_Info (P_Type);
+         D_Type := Get_Designated_Type (P_Type);
+         D_Info := Get_Info (D_Type);
+         --  Compute the expression.
+         Val := Translate_Expression (Get_Expression (Expr), D_Type);
+         --  Allocate memory for the object.
+         case P_Info.Type_Mode is
+            when Type_Mode_Fat_Acc =>
+               R := Dv2M (Create_Temp (D_Info.Ortho_Type (Mode_Value)),
+                          D_Info, Mode_Value);
+               Val_M := Stabilize (E2M (Val, D_Info, Mode_Value));
+               Chap3.Translate_Object_Allocation
+                 (R, Alloc_Heap, D_Type,
+                  M2Addr (Chap3.Get_Array_Bounds (Val_M)));
+               Val := M2E (Val_M);
+               Rtype := P_Info.Ortho_Ptr_Type (Mode_Value);
+            when Type_Mode_Acc =>
+               R := Dp2M (Create_Temp (D_Info.Ortho_Ptr_Type (Mode_Value)),
+                          D_Info, Mode_Value);
+               Chap3.Translate_Object_Allocation
+                 (R, Alloc_Heap, D_Type, O_Enode_Null);
+               Rtype := P_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
+         Sub_Type : Iir;
+         Bounds : O_Enode;
+         Res : Mnode;
+         Rtype : O_Tnode;
+         P_Type : Iir;
+         P_Info : Type_Info_Acc;
+         D_Type : Iir;
+         D_Info : Type_Info_Acc;
+      begin
+         P_Type := Get_Type (Expr);
+         P_Info := Get_Info (P_Type);
+         D_Type := Get_Designated_Type (P_Type);
+         D_Info := Get_Info (D_Type);
+         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_Expression (Expr);
+               Chap3.Create_Array_Subtype (Sub_Type, True);
+               Bounds := M2E (Chap3.Get_Array_Type_Bounds (Sub_Type));
+               Rtype := P_Info.Ortho_Ptr_Type (Mode_Value);
+            when Type_Mode_Acc =>
+               Res := Dp2M (Create_Temp (D_Info.Ortho_Ptr_Type (Mode_Value)),
+                            D_Info, Mode_Value);
+               Bounds := O_Enode_Null;
+               Rtype := P_Info.Ortho_Type (Mode_Value);
+            when others =>
+               raise Internal_Error;
+         end case;
+         Chap3.Translate_Object_Allocation (Res, Alloc_Heap, D_Type, Bounds);
+         Chap4.Init_Object (Res, D_Type);
+         return New_Convert_Ov (M2Addr (Res), Rtype);
+      end Translate_Allocator_By_Subtype;
+
+      function Translate_Fat_Array_Type_Conversion
+        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
+        return O_Enode;
+
+      function Translate_Array_Subtype_Conversion
+        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
+        return O_Enode
+      is
+         Res_Info : Type_Info_Acc;
+         Expr_Info : Type_Info_Acc;
+      begin
+         Res_Info := Get_Info (Res_Type);
+         Expr_Info := Get_Info (Expr_Type);
+         case Res_Info.Type_Mode is
+            when Type_Mode_Array =>
+               declare
+                  E : O_Dnode;
+               begin
+                  E := Create_Temp_Init (Expr_Info.Ortho_Ptr_Type (Mode_Value),
+                                         Expr);
+                  Chap3.Check_Array_Match (Res_Type, O_Lnode_Null, Mode_Value,
+                                           Expr_Type, New_Obj (E), Mode_Value,
+                                           Loc);
+                  return New_Convert_Ov
+                    (New_Value (Chap3.Get_Array_Ptr_Base_Ptr
+                                (New_Obj (E), Expr_Type, Mode_Value)),
+                     Res_Info.Ortho_Ptr_Type (Mode_Value));
+               end;
+            when Type_Mode_Fat_Array =>
+               declare
+                  Res : O_Dnode;
+                  E : O_Dnode;
+               begin
+                  Res := Create_Temp (Res_Info.Ortho_Type (Mode_Value));
+                  Open_Temp;
+                  E := Create_Temp_Init (Expr_Info.Ortho_Ptr_Type (Mode_Value),
+                                         Expr);
+                  --  Convert base.
+                  New_Assign_Stmt
+                    (New_Selected_Element
+                     (New_Obj (Res), Res_Info.T.Base_Field (Mode_Value)),
+                     New_Value (Chap3.Get_Array_Ptr_Base_Ptr
+                                (New_Obj (E), Expr_Type, Mode_Value)));
+                  --  Copy subtype bounds.
+                  New_Assign_Stmt
+                    (New_Selected_Element
+                     (New_Obj (Res), Res_Info.T.Bounds_Field (Mode_Value)),
+                     Chap3.Get_Array_Bounds_Ptr (O_Lnode_Null, Expr_Type,
+                                                 Mode_Value));
+                  --  Check array match.
+                  Chap3.Check_Array_Match (Res_Type, New_Obj (Res), Mode_Value,
+                                           Expr_Type, New_Obj (E), Mode_Value,
+                                           Loc);
+                  Close_Temp;
+                  return New_Address
+                    (New_Obj (Res), Res_Info.Ortho_Ptr_Type (Mode_Value));
+               end;
+            when others =>
+               Error_Kind ("translate_array_subtype_conversion", Res_Type);
+         end case;
+      end Translate_Array_Subtype_Conversion;
+
+      function Translate_Type_Conversion
+        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
+        return O_Enode
+      is
+         Res_Info : Type_Info_Acc;
+      begin
+         Res_Info := Get_Info (Res_Type);
+         case Get_Kind (Res_Type) is
+            when Iir_Kinds_Scalar_Type_Definition =>
+               --  If res_type = expr_type, do not convert.
+               --  FIXME: range check ?
+               return New_Convert_Ov (Expr, Res_Info.Ortho_Type (Mode_Value));
+            when Iir_Kind_Array_Subtype_Definition =>
+               return Translate_Array_Subtype_Conversion
+                 (Expr, Expr_Type, Res_Type, Loc);
+            when Iir_Kind_Array_Type_Definition
+              | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+               return Translate_Fat_Array_Type_Conversion
+                 (Expr, Expr_Type, Res_Type, Loc);
+            when others =>
+               Error_Kind ("translate_type_conversion", Res_Type);
+         end case;
+      end Translate_Type_Conversion;
+
+      function Translate_Fat_Array_Type_Conversion
+        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
+        return O_Enode
+      is
+         Res : O_Dnode;
+         Res_Ptr : O_Dnode;
+         E : O_Dnode;
+         Bounds : O_Dnode;
+         Res_Indexes : Iir_List;
+         Expr_Indexes : Iir_List;
+         R_El : Iir;
+         E_El : Iir;
+         Res_Info : Type_Info_Acc;
+         Expr_Info : Type_Info_Acc;
+      begin
+         Res_Info := Get_Info (Res_Type);
+         Expr_Info := Get_Info (Expr_Type);
+         Res := Create_Temp (Res_Info.Ortho_Type (Mode_Value));
+         Bounds := Create_Temp (Res_Info.T.Bounds_Type);
+         Open_Temp;
+         Res_Ptr := Create_Temp_Ptr
+           (Res_Info.Ortho_Ptr_Type (Mode_Value), New_Obj (Res));
+         E := Create_Temp_Init (Expr_Info.Ortho_Ptr_Type (Mode_Value), Expr);
+         --  Set base.
+         New_Assign_Stmt
+           (New_Selected_Element (New_Obj (Res),
+                                  Res_Info.T.Base_Field (Mode_Value)),
+            New_Convert_Ov (New_Value (Chap3.Get_Array_Ptr_Base_Ptr
+                                       (New_Obj (E), Expr_Type, Mode_Value)),
+                            Res_Info.T.Base_Ptr_Type (Mode_Value)));
+         --  Set bounds.
+         New_Assign_Stmt
+           (New_Selected_Element (New_Obj (Res),
+                                  Res_Info.T.Bounds_Field (Mode_Value)),
+            New_Address (New_Obj (Bounds), Res_Info.T.Bounds_Ptr_Type));
+         --  Convert bounds.
+         Res_Indexes := Get_Index_Subtype_List (Res_Type);
+         Expr_Indexes := Get_Index_Subtype_List (Expr_Type);
+         for I in Natural loop
+            R_El := Get_Nth_Element (Res_Indexes, I);
+            E_El := Get_Nth_Element (Expr_Indexes, I);
+            exit when R_El = Null_Iir;
+            declare
+               Rb_Ptr : O_Dnode;
+               Eb_Ptr : O_Dnode;
+               Rr_Info : Type_Info_Acc;
+               Er_Info : Type_Info_Acc;
+            begin
+               Open_Temp;
+               Rr_Info := Get_Info (R_El);
+               Rb_Ptr := Create_Temp_Init
+                 (Rr_Info.T.Range_Ptr_Type,
+                  Chap3.Get_Array_Ptr_Range_Ptr (New_Obj (Res_Ptr),
+                                                 Res_Type, I + 1,
+                                                 Mode_Value));
+               Er_Info := Get_Info (Get_Base_Type (E_El));
+               Eb_Ptr := Create_Temp_Init
+                 (Er_Info.T.Range_Ptr_Type,
+                  Chap3.Get_Array_Ptr_Range_Ptr (New_Obj (E), Expr_Type, I + 1,
+                                                 Mode_Value));
+               --  Convert left and right.
+               New_Assign_Stmt
+                 (New_Selected_Acc_Value (New_Obj (Rb_Ptr),
+                                          Rr_Info.T.Range_Left),
+                  Translate_Type_Conversion
+                  (New_Value_Selected_Acc_Value (New_Obj (Eb_Ptr),
+                                                 Er_Info.T.Range_Left),
+                   E_El, R_El, Loc));
+               New_Assign_Stmt
+                 (New_Selected_Acc_Value (New_Obj (Rb_Ptr),
+                                          Rr_Info.T.Range_Right),
+                  Translate_Type_Conversion
+                  (New_Value_Selected_Acc_Value (New_Obj (Eb_Ptr),
+                                                 Er_Info.T.Range_Right),
+                   E_El, R_El, Loc));
+               --  Copy Dir and Length.
+               New_Assign_Stmt
+                 (New_Selected_Acc_Value (New_Obj (Rb_Ptr),
+                                          Rr_Info.T.Range_Dir),
+                  New_Value_Selected_Acc_Value (New_Obj (Eb_Ptr),
+                                                Er_Info.T.Range_Dir));
+               New_Assign_Stmt
+                 (New_Selected_Acc_Value (New_Obj (Rb_Ptr),
+                                          Rr_Info.T.Range_Length),
+                  New_Value_Selected_Acc_Value (New_Obj (Eb_Ptr),
+                                                Er_Info.T.Range_Length));
+               Close_Temp;
+            end;
+         end loop;
+         Close_Temp;
+         return New_Address (New_Obj (Res),
+                             Res_Info.Ortho_Ptr_Type (Mode_Value));
+      end Translate_Fat_Array_Type_Conversion;
+
+      function Sig2val_Prepare_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Mnode)
+        return Mnode
+      is
+         pragma Unreferenced (Targ, Targ_Type);
+      begin
+         if Get_Type_Info (Data).Type_Mode = Type_Mode_Fat_Array then
+            return Stabilize (Chap3.Get_Array_Base (Data));
+         else
+            return Stabilize (Data);
+         end if;
+      end Sig2val_Prepare_Composite;
+
+      function Sig2val_Update_Data_Array
+        (Val : Mnode; Targ_Type : Iir; Index : O_Dnode) return Mnode
+      is
+      begin
+         return Chap3.Index_Base (Val, Targ_Type, New_Obj_Value (Index));
+      end Sig2val_Update_Data_Array;
+
+      function Sig2val_Update_Data_Record
+        (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
+        return Mnode
+      is
+         pragma Unreferenced (Targ_Type);
+      begin
+         return Chap6.Translate_Selected_Element (Val, El);
+      end Sig2val_Update_Data_Record;
+
+      procedure Sig2val_Finish_Data_Composite (Data : in out Mnode)
+      is
+         pragma Unreferenced (Data);
+      begin
+         null;
+      end Sig2val_Finish_Data_Composite;
+
+      procedure Translate_Signal_Assign_Effective_Non_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Mnode)
+      is
+         pragma Unreferenced (Targ_Type);
+      begin
+         New_Assign_Stmt (New_Access_Element (M2E (Targ)), M2E (Data));
+      end Translate_Signal_Assign_Effective_Non_Composite;
+
+      procedure Translate_Signal_Assign_Effective is new Foreach_Non_Composite
+        (Data_Type => Mnode,
+         Composite_Data_Type => Mnode,
+         Do_Non_Composite => Translate_Signal_Assign_Effective_Non_Composite,
+         Prepare_Data_Array => Sig2val_Prepare_Composite,
+         Update_Data_Array => Sig2val_Update_Data_Array,
+         Finish_Data_Array => Sig2val_Finish_Data_Composite,
+         Prepare_Data_Record => Sig2val_Prepare_Composite,
+         Update_Data_Record => Sig2val_Update_Data_Record,
+         Finish_Data_Record => Sig2val_Finish_Data_Composite);
+
+      procedure Translate_Signal_Assign_Driving_Non_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data: Mnode)
+      is
+      begin
+         New_Assign_Stmt
+           (Chap14.Get_Signal_Value_Field (M2E (Targ), Targ_Type,
+                                           Ghdl_Signal_Driving_Value_Node),
+            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 Tinfo.C /= null 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_Node));
+      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;
+                  Unit_Type : Type_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.
+                     Unit_Type := Get_Info (Expr_Type);
+                     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;
+                  Unit_Type : Type_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.
+                     Unit_Type := Get_Info (Expr_Type);
+                     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);
+               Res := Translate_Implicit_Conv
+                 (Res, Expr_Type, Res_Type, Mode_Value);
+               return Res;
+
+            when Iir_Kind_Aggregate =>
+               declare
+                  Aggr_Type : Iir;
+                  Tinfo : Type_Info_Acc;
+                  Mres : Mnode;
+               begin
+                  if Rtype = Null_Iir then
+                     raise Internal_Error;
+                  end if;
+
+                  --  Extract the type of the aggregate.
+                  if Get_Kind (Rtype) /= Iir_Kind_Array_Type_Definition then
+                     Aggr_Type := Rtype;
+                  else
+                     Aggr_Type := Expr_Type;
+                     if Get_Kind (Expr_Type)
+                       = Iir_Kind_Array_Subtype_Definition
+                     then
+                        Chap3.Create_Array_Subtype (Expr_Type, True);
+                     end if;
+                  end if;
+
+                  --  FIXME: this may be not necessary
+                  Tinfo := Get_Info (Aggr_Type);
+
+                  --  The result area has to be created
+                  if Tinfo.C /= null 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);
+                  end if;
+                  return Res;
+               end;
+
+            when Iir_Kind_Null_Literal =>
+               declare
+                  L : O_Dnode;
+                  Otype : O_Tnode;
+                  B : Type_Info_Acc;
+                  Tinfo : Type_Info_Acc;
+               begin
+                  Tinfo := Get_Info (Expr_Type);
+                  Otype := Tinfo.Ortho_Type (Mode_Value);
+                  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_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);
+               return Translate_Implicit_Conv
+                 (Res, Expr_Type, Rtype, Mode_Value);
+
+            when Iir_Kind_Constant_Declaration
+              | Iir_Kind_Variable_Declaration
+              | Iir_Kind_Signal_Declaration
+              | Iir_Kind_File_Declaration
+              | Iir_Kind_Object_Alias_Declaration
+              | Iir_Kind_Constant_Interface_Declaration
+              | Iir_Kind_Variable_Interface_Declaration
+              | Iir_Kind_Signal_Interface_Declaration
+              | Iir_Kind_File_Interface_Declaration
+              | Iir_Kind_Indexed_Name
+              | Iir_Kind_Slice_Name
+              | Iir_Kind_Selected_Element
+              | Iir_Kind_Dereference
+              | Iir_Kind_Implicit_Dereference
+              | Iir_Kind_Stable_Attribute
+              | Iir_Kind_Quiet_Attribute
+              | Iir_Kind_Delayed_Attribute
+              | Iir_Kind_Transaction_Attribute
+              | Iir_Kind_Guard_Signal_Declaration
+              | Iir_Kind_Attribute_Value =>
+               declare
+                  L : Mnode;
+                  Expr_Type_Info : Type_Info_Acc;
+               begin
+                  L := Chap6.Translate_Name (Expr);
+
+                  Expr_Type_Info := Get_Info (Expr_Type);
+                  Res := M2E (L);
+                  if Get_Object_Kind (L) = Mode_Signal then
+                     Res := Translate_Signal (Res, Expr_Type);
+                  end if;
+               end;
+               if Rtype /= Null_Iir then
+                  Res := Translate_Implicit_Conv
+                    (Res, Expr_Type, Rtype, Mode_Value);
+               end if;
+               return Res;
+
+            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);
+               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);
+               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);
+                     end;
+                  else
+                     Assoc_Chain := Canon.Canon_Subprogram_Call (Expr);
+                     Res := Translate_Function_Call
+                       (Imp, Assoc_Chain, Get_Method_Object (Expr));
+                     return Translate_Implicit_Conv
+                       (Res, Get_Return_Type (Imp), Res_Type, Mode_Value);
+                  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);
+                  return Translate_Implicit_Conv
+                    (Res, Expr_Type, Res_Type, Mode_Value);
+               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 =>
+               return Translate_Implicit_Conv
+                 (Chap14.Translate_Image_Attribute (Expr),
+                  String_Type_Definition, Res_Type, Mode_Value);
+            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 =>
+               return Chap14.Translate_Last_Value_Attribute (Expr);
+
+            when Iir_Kind_High_Type_Attribute =>
+               return Chap14.Translate_High_Type_Attribute (Get_Type (Expr));
+            when Iir_Kind_Low_Type_Attribute =>
+               return Chap14.Translate_Low_Type_Attribute (Get_Type (Expr));
+            when Iir_Kind_Left_Type_Attribute =>
+               return Chap14.Translate_Left_Type_Attribute (Get_Type (Expr));
+            when Iir_Kind_Right_Type_Attribute =>
+               return Chap14.Translate_Right_Type_Attribute (Get_Type (Expr));
+
+            when Iir_Kind_Last_Event_Attribute =>
+               return Chap14.Translate_Last_Time_Attribute
+                 (Get_Prefix (Expr), Ghdl_Signal_Last_Event_Node);
+            when Iir_Kind_Last_Active_Attribute =>
+               return Chap14.Translate_Last_Time_Attribute
+                 (Get_Prefix (Expr), Ghdl_Signal_Last_Active_Node);
+
+            when Iir_Kind_Driving_Value_Attribute =>
+               return Chap14.Translate_Driving_Value_Attribute (Expr);
+            when Iir_Kind_Driving_Attribute =>
+               return Chap14.Translate_Driving_Attribute (Expr);
+
+            when Iir_Kind_Path_Name_Attribute
+              | Iir_Kind_Instance_Name_Attribute =>
+               return Chap14.Translate_Path_Instance_Name_Attribute (Expr);
+
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Selected_Name =>
+               return Translate_Expression (Get_Named_Entity (Expr), Rtype);
+
+            when others =>
+               Error_Kind ("translate_expression", Expr);
+         end case;
+      end Translate_Expression;
+
+--       procedure Translate_Range_Expression
+--         (Res : O_Lnode; Expr : Iir; Range_Type : Iir)
+--       is
+--          T_Info : Type_Info_Acc;
+--       begin
+--          T_Info := Get_Info (Range_Type);
+--          Open_Temp;
+--          New_Assign_Stmt
+--            (New_Selected_Element (Res, T_Info.T.Range_Left),
+--             Chap7.Translate_Range_Expression_Left (Expr, Range_Type));
+--          New_Assign_Stmt
+--            (New_Selected_Element (Res, T_Info.T.Range_Right),
+--             Chap7.Translate_Range_Expression_Right (Expr, Range_Type));
+--          New_Assign_Stmt (New_Selected_Element (Res, T_Info.T.Range_Dir),
+--                           Chap7.Translate_Static_Range_Dir (Expr));
+--          if T_Info.T.Range_Length /= O_Fnode_Null then
+--             Open_Temp;
+--          New_Assign_Stmt (New_Selected_Element (Res, T_Info.T.Range_Length),
+--                            Chap7.Translate_Range_Expression_Length (Expr));
+--             Close_Temp;
+--          end if;
+--          Close_Temp;
+--       end Translate_Range_Expression;
+
+      procedure Translate_Range_Expression_Ptr
+        (Res_Ptr : O_Dnode; Expr : Iir; Range_Type : Iir)
+      is
+         T_Info : Type_Info_Acc;
+      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
+               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;
+            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_Kind_Range_Array_Attribute =>
+               return Chap14.Translate_Range_Array_Attribute (Arange);
+            when Iir_Kind_Reverse_Range_Array_Attribute =>
+               declare
+                  Res : O_Dnode;
+                  Res_Ptr : O_Dnode;
+                  Rinfo : Type_Info_Acc;
+               begin
+                  Rinfo := Get_Info (Range_Type);
+                  Res := Create_Temp (Rinfo.T.Range_Type);
+                  Open_Temp;
+                  Res_Ptr := Create_Temp_Ptr (Rinfo.T.Range_Ptr_Type,
+                                              New_Obj (Res));
+                  Translate_Reverse_Range_Ptr
+                    (Res_Ptr,
+                     Chap14.Translate_Range_Array_Attribute (Arange),
+                     Range_Type);
+                  Close_Temp;
+                  return New_Obj (Res);
+               end;
+            when Iir_Kind_Range_Expression =>
+               declare
+                  Res : O_Dnode;
+                  Ptr : O_Dnode;
+                  T_Info : Type_Info_Acc;
+               begin
+                  T_Info := Get_Info (Range_Type);
+                  Res := Create_Temp (T_Info.T.Range_Type);
+                  Open_Temp;
+                  Ptr := Create_Temp_Ptr (T_Info.T.Range_Ptr_Type,
+                                          New_Obj (Res));
+                  Translate_Range_Expression_Ptr (Ptr, Arange, Range_Type);
+                  Close_Temp;
+                  return New_Obj (Res);
+               end;
+            when others =>
+               Error_Kind ("translate_range", Arange);
+         end case;
+         return O_Lnode_Null;
+      end Translate_Range;
+
+      function Translate_Static_Range (Arange : Iir; Range_Type : Iir)
+        return O_Cnode
+      is
+         Constr : O_Record_Aggr_List;
+         Res : O_Cnode;
+         T_Info : Type_Info_Acc;
+      begin
+         T_Info := Get_Info (Range_Type);
+         Start_Record_Aggr (Constr, T_Info.T.Range_Type);
+         New_Record_Aggr_El
+           (Constr, Chap7.Translate_Static_Range_Left (Arange, Range_Type));
+         New_Record_Aggr_El
+           (Constr, Chap7.Translate_Static_Range_Right (Arange, Range_Type));
+         New_Record_Aggr_El
+           (Constr, Chap7.Translate_Static_Range_Dir (Arange));
+         if T_Info.T.Range_Length /= O_Fnode_Null then
+            New_Record_Aggr_El
+              (Constr, Chap7.Translate_Static_Range_Length (Arange));
+         end if;
+         Finish_Record_Aggr (Constr, Res);
+         return Res;
+      end Translate_Static_Range;
+
+      procedure Translate_Predefined_Array_Compare (Subprg : Iir)
+      is
+         procedure Gen_Compare (L, R : O_Dnode)
+         is
+            If_Blk1, If_Blk2 : O_If_Block;
+         begin
+            Start_If_Stmt
+              (If_Blk1,
+               New_Compare_Op (ON_Neq, New_Obj_Value (L), New_Obj_Value (R),
+                               Ghdl_Bool_Type));
+            Start_If_Stmt
+              (If_Blk2,
+               New_Compare_Op (ON_Gt, New_Obj_Value (L), New_Obj_Value (R),
+                               Ghdl_Bool_Type));
+            New_Return_Stmt (New_Lit (Ghdl_Compare_Gt));
+            New_Else_Stmt (If_Blk2);
+            New_Return_Stmt (New_Lit (Ghdl_Compare_Lt));
+            Finish_If_Stmt (If_Blk2);
+            Finish_If_Stmt (If_Blk1);
+         end Gen_Compare;
+
+         F_Info : Subprg_Info_Acc;
+         Arr_Type : Iir_Array_Type_Definition;
+         Arr_Ptr_Type : O_Tnode;
+         Info : Type_Info_Acc;
+         Id : Name_Id;
+         L, R : O_Dnode;
+         Interface_List : O_Inter_List;
+         If_Blk : O_If_Block;
+         Var_L_Len, Var_R_Len : O_Dnode;
+         Var_L_El, Var_R_El : O_Dnode;
+         Var_I, Var_Len : O_Dnode;
+         Label : O_Snode;
+         El_Otype : O_Tnode;
+      begin
+         Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Subprg));
+         Info := Get_Info (Arr_Type);
+         Id := Get_Identifier (Get_Type_Declarator (Arr_Type));
+         Arr_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);
+
+         F_Info := Add_Info (Subprg, Kind_Subprg);
+         --Chap2.Clear_Instance_Data (F_Info.Subprg_Instance);
+
+         --  Create function.
+         Start_Function_Decl (Interface_List, Create_Identifier (Id, "_CMP"),
+                              Global_Storage, Ghdl_Compare_Type);
+         New_Interface_Decl (Interface_List, L, Wki_Left, Arr_Ptr_Type);
+         New_Interface_Decl (Interface_List, R, Wki_Right, Arr_Ptr_Type);
+         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         El_Otype := Get_Ortho_Type
+           (Get_Element_Subtype (Arr_Type), Mode_Value);
+         Start_Subprogram_Body (F_Info.Ortho_Func);
+         --  Compute length of L and R.
+         New_Var_Decl (Var_L_Len, Get_Identifier ("l_len"),
+                       O_Storage_Local, Ghdl_Index_Type);
+         New_Var_Decl (Var_R_Len, Get_Identifier ("r_len"),
+                       O_Storage_Local, Ghdl_Index_Type);
+         New_Var_Decl (Var_Len, Wki_Length, O_Storage_Local, Ghdl_Index_Type);
+         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
+         New_Assign_Stmt
+           (New_Obj (Var_L_Len),
+            Chap6.Get_Array_Ptr_Bound_Length
+            (New_Obj (L), Arr_Type, 1, Mode_Value));
+         New_Assign_Stmt
+           (New_Obj (Var_R_Len),
+            Chap6.Get_Array_Ptr_Bound_Length
+            (New_Obj (R), Arr_Type, 1, Mode_Value));
+         --  Find the minimum length.
+         Start_If_Stmt (If_Blk,
+                        New_Compare_Op (ON_Ge,
+                                        New_Obj_Value (Var_L_Len),
+                                        New_Obj_Value (Var_R_Len),
+                                        Ghdl_Bool_Type));
+         New_Assign_Stmt (New_Obj (Var_Len), New_Obj_Value (Var_R_Len));
+         New_Else_Stmt (If_Blk);
+         New_Assign_Stmt (New_Obj (Var_Len), New_Obj_Value (Var_L_Len));
+         Finish_If_Stmt (If_Blk);
+
+         --  for each element, compare elements; if not equal return the
+         --       comparaison result.
+         Init_Var (Var_I);
+         Start_Loop_Stmt (Label);
+         Start_If_Stmt (If_Blk, New_Compare_Op (ON_Ge,
+                                                New_Obj_Value (Var_I),
+                                                New_Obj_Value (Var_Len),
+                                                Ghdl_Bool_Type));
+         --  Compare the length and return the result.
+         Gen_Compare (Var_L_Len, Var_R_Len);
+         New_Return_Stmt (New_Lit (Ghdl_Compare_Eq));
+         Finish_If_Stmt (If_Blk);
+         Start_Declare_Stmt;
+         New_Var_Decl (Var_L_El, Get_Identifier ("l_el"), O_Storage_Local,
+                       El_Otype);
+         New_Var_Decl (Var_R_El, Get_Identifier ("r_el"), O_Storage_Local,
+                       El_Otype);
+         New_Assign_Stmt
+           (New_Obj (Var_L_El),
+            New_Value
+            (New_Indexed_Element
+             (New_Acc_Value (Chap3.Get_Array_Ptr_Base_Ptr
+                             (New_Obj (L), Arr_Type, Mode_Value)),
+              New_Obj_Value (Var_I))));
+         New_Assign_Stmt
+           (New_Obj (Var_R_El),
+            New_Value
+            (New_Indexed_Element
+             (New_Acc_Value (Chap3.Get_Array_Ptr_Base_Ptr
+                             (New_Obj (R), Arr_Type, Mode_Value)),
+              New_Obj_Value (Var_I))));
+         Gen_Compare (Var_L_El, Var_R_El);
+         Finish_Declare_Stmt;
+         Inc_Var (Var_I);
+         Finish_Loop_Stmt (Label);
+         Finish_Subprogram_Body;
+      end Translate_Predefined_Array_Compare;
+
+      --  Find the declaration of the predefined function IMP in type
+      --  definition BASE_TYPE.
+      function Find_Predefined_Function
+        (Base_Type : Iir; Imp : Iir_Predefined_Functions)
+        return Iir
+      is
+         El : Iir;
+      begin
+         El := Get_Chain (Get_Type_Declarator (Base_Type));
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Implicit_Function_Declaration
+                 | Iir_Kind_Implicit_Procedure_Declaration =>
+                  if Get_Implicit_Definition (El) = Imp then
+                     return El;
+                  else
+                     El := Get_Chain (El);
+                  end if;
+               when others =>
+                  raise Internal_Error;
+            end case;
+         end loop;
+         raise Internal_Error;
+      end Find_Predefined_Function;
+
+      function Translate_Equality (L, R : Mnode; Etype : Iir)
+        return O_Enode
+      is
+         Tinfo : Type_Info_Acc;
+      begin
+         Tinfo := Get_Type_Info (L);
+         case Tinfo.Type_Mode is
+            when Type_Mode_Scalar
+              | Type_Mode_Acc =>
+               return New_Compare_Op (ON_Eq, M2E (L), M2E (R),
+                                      Ghdl_Bool_Type);
+            when Type_Mode_Fat_Acc =>
+               --  a fat pointer.
+               declare
+                  B : Type_Info_Acc;
+                  Ln, Rn : Mnode;
+                  V1, V2 : O_Enode;
+               begin
+                  B := Get_Info (Get_Designated_Type (Etype));
+                  Ln := Stabilize (L);
+                  Rn := Stabilize (R);
+                  V1 := New_Compare_Op
+                    (ON_Eq,
+                     New_Value (New_Selected_Element
+                                (M2Lv (Ln), B.T.Base_Field (Mode_Value))),
+                     New_Value (New_Selected_Element
+                                (M2Lv (Rn), B.T.Base_Field (Mode_Value))),
+                     Std_Boolean_Type_Node);
+                  V2 := New_Compare_Op
+                    (ON_Eq,
+                     New_Value (New_Selected_Element
+                                (M2Lv (Ln), B.T.Bounds_Field (Mode_Value))),
+                     New_Value (New_Selected_Element
+                                (M2Lv (Rn), B.T.Bounds_Field (Mode_Value))),
+                     Std_Boolean_Type_Node);
+                  return New_Dyadic_Op (ON_And, V1, V2);
+               end;
+
+            when Type_Mode_Array
+              | Type_Mode_Ptr_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);
+                  Rc := Translate_Implicit_Conv
+                    (M2E (R), Etype, Base_Type, Mode_Value);
+                  Func := Find_Predefined_Function
+                    (Base_Type, Iir_Predefined_Array_Equality);
+                  return Translate_Predefined_Lib_Operator (Lc, Rc, Func);
+               end;
+
+            when Type_Mode_Record =>
+               declare
+                  Func : Iir;
+               begin
+                  Func := Find_Predefined_Function
+                    (Get_Base_Type (Etype), Iir_Predefined_Record_Equality);
+                  return Translate_Predefined_Lib_Operator
+                    (M2E (L), M2E (R), Func);
+               end;
+
+            when Type_Mode_Unknown
+              | Type_Mode_File
+              | Type_Mode_Fat_Array
+              | Type_Mode_Protected =>
+               raise Internal_Error;
+         end case;
+      end Translate_Equality;
+
+      procedure Translate_Predefined_Array_Equality (Subprg : Iir)
+      is
+         F_Info : Subprg_Info_Acc;
+         Arr_Type : Iir_Array_Type_Definition;
+         Arr_Ptr_Type : O_Tnode;
+         Info : Type_Info_Acc;
+         Id : Name_Id;
+         Var_L, Var_R : O_Dnode;
+         L, R : Mnode;
+         Interface_List : O_Inter_List;
+         Indexes : Iir_List;
+         Nbr_Indexes : Natural;
+         If_Blk : O_If_Block;
+         Var_I : O_Dnode;
+         Var_Len : O_Dnode;
+         Label : O_Snode;
+         Le, Re : Mnode;
+         El_Type : Iir;
+      begin
+         Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Subprg));
+         El_Type := Get_Element_Subtype (Arr_Type);
+         Info := Get_Info (Arr_Type);
+         Id := Get_Identifier (Get_Type_Declarator (Arr_Type));
+         Arr_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);
+
+         F_Info := Add_Info (Subprg, Kind_Subprg);
+
+         --  Create function.
+         Start_Function_Decl (Interface_List, Create_Identifier (Id, "_EQ"),
+                              Global_Storage, Std_Boolean_Type_Node);
+         Chap2.Create_Subprg_Instance (Interface_List, Subprg);
+         New_Interface_Decl (Interface_List, Var_L, Wki_Left, Arr_Ptr_Type);
+         New_Interface_Decl (Interface_List, Var_R, Wki_Right, Arr_Ptr_Type);
+         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         L := Dp2M (Var_L, Info, Mode_Value);
+         R := Dp2M (Var_R, Info, Mode_Value);
+
+         Indexes := Get_Index_Subtype_List (Arr_Type);
+         Nbr_Indexes := Get_Nbr_Elements (Indexes);
+
+         Start_Subprogram_Body (F_Info.Ortho_Func);
+         Chap2.Start_Subprg_Instance_Use (Subprg);
+         --  for each dimension:  if length mismatch: return false
+         for I in 1 .. Nbr_Indexes loop
+            Start_If_Stmt
+              (If_Blk,
+               New_Compare_Op
+               (ON_Neq,
+                M2E (Chap3.Range_To_Length
+                     (Chap3.Get_Array_Range (L, Arr_Type, I))),
+                M2E (Chap3.Range_To_Length
+                     (Chap3.Get_Array_Range (R, Arr_Type, I))),
+                Std_Boolean_Type_Node));
+            New_Return_Stmt (New_Lit (Std_Boolean_False_Node));
+            Finish_If_Stmt (If_Blk);
+         end loop;
+
+         --  for each element: if element is not equal, return false
+         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
+         New_Var_Decl (Var_Len, Wki_Length, O_Storage_Local, Ghdl_Index_Type);
+         New_Assign_Stmt (New_Obj (Var_Len),
+                          Chap3.Get_Array_Length (L, Arr_Type));
+         Init_Var (Var_I);
+         Start_Loop_Stmt (Label);
+         --  If the end of the array is reached, return TRUE.
+         Start_If_Stmt (If_Blk,
+                        New_Compare_Op (ON_Ge,
+                                        New_Obj_Value (Var_I),
+                                        New_Obj_Value (Var_Len),
+                                        Ghdl_Bool_Type));
+         New_Return_Stmt (New_Lit (Std_Boolean_True_Node));
+         Finish_If_Stmt (If_Blk);
+         Open_Temp;
+         Le := Chap3.Index_Base (Chap3.Get_Array_Base (L), Arr_Type,
+                                 New_Obj_Value (Var_I));
+         Re := Chap3.Index_Base (Chap3.Get_Array_Base (R), Arr_Type,
+                                 New_Obj_Value (Var_I));
+         Start_If_Stmt
+           (If_Blk,
+            New_Monadic_Op (ON_Not, Translate_Equality (Le, Re, El_Type)));
+         New_Return_Stmt (New_Lit (Std_Boolean_False_Node));
+         Finish_If_Stmt (If_Blk);
+         Close_Temp;
+         Inc_Var (Var_I);
+         Finish_Loop_Stmt (Label);
+         Chap2.Finish_Subprg_Instance_Use (Subprg);
+         Finish_Subprogram_Body;
+      end Translate_Predefined_Array_Equality;
+
+      procedure Translate_Predefined_Record_Equality (Subprg : Iir)
+      is
+         F_Info : Subprg_Info_Acc;
+         Rec_Type : Iir_Record_Type_Definition;
+         Rec_Ptr_Type : O_Tnode;
+         Info : Type_Info_Acc;
+         Id : Name_Id;
+         Var_L, Var_R : O_Dnode;
+         L, R : Mnode;
+         Interface_List : O_Inter_List;
+         If_Blk : O_If_Block;
+         Le, Re : Mnode;
+
+         El : 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 := Get_Element_Declaration_Chain (Rec_Type);
+         while El /= Null_Iir loop
+            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;
+            El := Get_Chain (El);
+         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_First_Element (Get_Index_Subtype_List (Arr_Type));
+         Iinfo := Get_Info (Index_Type);
+         Index_Otype := Iinfo.Ortho_Type (Mode_Value);
+
+         Start_Subprogram_Body (F_Info.Ortho_Func);
+         Chap2.Start_Subprg_Instance_Use (Subprg);
+         New_Var_Decl (Var_Length, Wki_Length, O_Storage_Local,
+                       Ghdl_Index_Type);
+         New_Var_Decl (Var_L_Len, Get_Identifier ("l_len"), O_Storage_Local,
+                       Ghdl_Index_Type);
+         New_Var_Decl (Var_R_Len, Get_Identifier ("r_len"), O_Storage_Local,
+                       Ghdl_Index_Type);
+         New_Var_Decl (Var_Bounds, Get_Identifier ("bounds"), O_Storage_Local,
+                       Info.T.Bounds_Ptr_Type);
+
+         L := Dp2M (Var_L, Info, Mode_Value);
+         R := Dp2M (Var_R, Info, Mode_Value);
+         Res := Dp2M (Var_Res, Info, Mode_Value);
+         V_Bounds := Dp2M (Var_Bounds, Info, Mode_Value,
+                           Info.T.Bounds_Type, Info.T.Bounds_Ptr_Type);
+
+         --  Compute length.
+         New_Assign_Stmt
+           (New_Obj (Var_L_Len), Chap3.Get_Array_Length (L, Arr_Type));
+         New_Assign_Stmt
+           (New_Obj (Var_R_Len), Chap3.Get_Array_Length (R, Arr_Type));
+         New_Assign_Stmt
+           (New_Obj (Var_Length), New_Dyadic_Op (ON_Add_Ov,
+                                                 New_Obj_Value (Var_L_Len),
+                                                 New_Obj_Value (Var_R_Len)));
+
+         --  Check case where the result is the right operand.
+         declare
+            Len : O_Enode;
+         begin
+            if Flags.Vhdl_Std = Vhdl_87 then
+               --  LRM87 7.2.4
+               --  [...], unless the left operand is a null array, in which
+               --  case the result of the concatenation is the right operand.
+               Len := New_Obj_Value (Var_L_Len);
+
+            else
+               --  LRM93 7.2.4
+               --  If both operands are null arrays, then the result of the
+               --  concatenation is the right operand.
+               --  GHDL: since the length type is unsigned, then both operands
+               --   are null arrays iff the result is a null array.
+               Len := New_Obj_Value (Var_Length);
+            end if;
+
+            Start_If_Stmt
+              (If_Blk,
+               New_Compare_Op (ON_Eq,
+                               Len,
+                               New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
+                                                              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 (New_Unsigned_Literal
+                                          (Ghdl_Index_Type, 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);
+               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);
+               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)),
+               New_Address (New_Slice (M2Lv (Chap3.Get_Array_Base (Res)),
+                                       Info.T.Base_Type (Mode_Value),
+                                       New_Obj_Value (Var_L_Len)),
+                            Info.T.Base_Ptr_Type (Mode_Value)));
+            Chap3.Translate_Object_Copy
+              (Var_Arr, New_Obj_Value (Var_R), Arr_Type);
+            Close_Temp;
+         end;
+         Chap2.Finish_Subprg_Instance_Use (Subprg);
+         Finish_Subprogram_Body;
+      end Translate_Predefined_Array_Array_Concat;
+
+      procedure Translate_Predefined_Array_Logical (Subprg : Iir)
+      is
+         F_Info : Subprg_Info_Acc;
+         Arr_Type : Iir_Array_Type_Definition;
+         Arr_Ptr_Type : O_Tnode;
+         --  Info for the array type.
+         Info : Type_Info_Acc;
+         Id : Name_Id;
+         Interface_List : O_Inter_List;
+         Var_Res : O_Dnode;
+         Res : Mnode;
+         L, R : O_Dnode;
+         Var_Length, Var_I : O_Dnode;
+         Var_Base, Var_L_Base, Var_R_Base : O_Dnode;
+         If_Blk : O_If_Block;
+         Label : O_Snode;
+         Name : O_Ident;
+         Is_Monadic : Boolean;
+         El, L_El : O_Enode;
+         Op : ON_Op_Kind;
+         Do_Invert : Boolean;
+      begin
+         Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Subprg));
+         Info := Get_Info (Arr_Type);
+         Id := Get_Identifier (Get_Type_Declarator (Arr_Type));
+         Arr_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);
+
+         F_Info := Add_Info (Subprg, Kind_Subprg);
+         --Chap2.Clear_Instance_Data (F_Info.Subprg_Instance);
+         F_Info.Use_Stack2 := True;
+
+         Is_Monadic := False;
+         case Get_Implicit_Definition (Subprg) is
+            when Iir_Predefined_Bit_Array_And
+              | Iir_Predefined_Boolean_Array_And =>
+               Name := Create_Identifier (Id, "_AND");
+               Op := ON_And;
+               Do_Invert := False;
+            when Iir_Predefined_Bit_Array_Or
+              | Iir_Predefined_Boolean_Array_Or =>
+               Name := Create_Identifier (Id, "_OR");
+               Op := ON_Or;
+               Do_Invert := False;
+            when Iir_Predefined_Bit_Array_Nand
+              | Iir_Predefined_Boolean_Array_Nand =>
+               Name := Create_Identifier (Id, "_NAND");
+               Op := ON_And;
+               Do_Invert := True;
+            when Iir_Predefined_Bit_Array_Nor
+              | Iir_Predefined_Boolean_Array_Nor =>
+               Name := Create_Identifier (Id, "_NOR");
+               Op := ON_Or;
+               Do_Invert := True;
+            when Iir_Predefined_Bit_Array_Xor
+              | Iir_Predefined_Boolean_Array_Xor =>
+               Name := Create_Identifier (Id, "_XOR");
+               Op := ON_Xor;
+               Do_Invert := False;
+            when Iir_Predefined_Bit_Array_Xnor
+              | Iir_Predefined_Boolean_Array_Xnor =>
+               Name := Create_Identifier (Id, "_XNOR");
+               Op := ON_Xor;
+               Do_Invert := True;
+            when Iir_Predefined_Bit_Array_Not
+              | Iir_Predefined_Boolean_Array_Not =>
+               Name := Create_Identifier (Id, "_NOT");
+               Is_Monadic := True;
+               Op := ON_Not;
+               Do_Invert := False;
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         --  Create function.
+         Start_Procedure_Decl (Interface_List, Name, Global_Storage);
+         --  Note: contrary to user function which returns composite value
+         --  via a result record, a concatenation returns its value without
+         --  the use of the record.
+         New_Interface_Decl (Interface_List, Var_Res, Wki_Res, Arr_Ptr_Type);
+         New_Interface_Decl (Interface_List, L, Wki_Left, Arr_Ptr_Type);
+         if not Is_Monadic then
+            New_Interface_Decl (Interface_List, R, Wki_Right, Arr_Ptr_Type);
+         end if;
+         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         Start_Subprogram_Body (F_Info.Ortho_Func);
+         New_Var_Decl (Var_Length, Wki_Length, O_Storage_Local,
+                       Ghdl_Index_Type);
+         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
+         New_Var_Decl (Var_Base, Get_Identifier ("base"), O_Storage_Local,
+                       Info.T.Base_Ptr_Type (Mode_Value));
+         New_Var_Decl (Var_L_Base, Get_Identifier ("l_base"), O_Storage_Local,
+                       Info.T.Base_Ptr_Type (Mode_Value));
+         if not Is_Monadic then
+            New_Var_Decl
+              (Var_R_Base, Get_Identifier ("r_base"), O_Storage_Local,
+               Info.T.Base_Ptr_Type (Mode_Value));
+         end if;
+         Open_Temp;
+         --  Get length of LEFT.
+         New_Assign_Stmt (New_Obj (Var_Length),
+                          Chap6.Get_Array_Ptr_Bound_Length
+                          (New_Obj (L), Arr_Type, 1, Mode_Value));
+         --  If dyadic, check RIGHT has the same length.
+         if not Is_Monadic then
+            Chap6.Check_Bound_Error
+              (New_Compare_Op (ON_Neq,
+                               New_Obj_Value (Var_Length),
+                               Chap6.Get_Array_Ptr_Bound_Length
+                               (New_Obj (R), Arr_Type, 1, Mode_Value),
+                               Ghdl_Bool_Type),
+               Subprg, 0);
+         end if;
+
+         --  Create the result from LEFT bound.
+         Res := Dp2M (Var_Res, Info, Mode_Value);
+         Chap3.Translate_Object_Allocation
+           (Res, Alloc_Return, Arr_Type,
+            Chap3.Get_Array_Ptr_Bounds_Ptr
+            (New_Obj (L), Arr_Type, Mode_Value));
+         New_Assign_Stmt
+           (New_Obj (Var_Base), M2Addr (Chap3.Get_Array_Base (Res)));
+         New_Assign_Stmt
+           (New_Obj (Var_L_Base),
+            New_Value (Chap3.Get_Array_Ptr_Base_Ptr
+                       (New_Obj (L), Arr_Type, Mode_Value)));
+         if not Is_Monadic then
+            New_Assign_Stmt
+              (New_Obj (Var_R_Base),
+               New_Value (Chap3.Get_Array_Ptr_Base_Ptr
+                          (New_Obj (R), Arr_Type, Mode_Value)));
+         end if;
+
+         --  Do the logical operation on each element.
+         Init_Var (Var_I);
+         Start_Loop_Stmt (Label);
+         Start_If_Stmt (If_Blk,
+                        New_Compare_Op (ON_Ge,
+                                        New_Obj_Value (Var_I),
+                                        New_Obj_Value (Var_Length),
+                                        Ghdl_Bool_Type));
+         New_Return_Stmt;
+         Finish_If_Stmt (If_Blk);
+         L_El := New_Value (New_Indexed_Element
+                            (New_Acc_Value (New_Obj (Var_L_Base)),
+                             New_Obj_Value (Var_I)));
+         if Is_Monadic then
+            El := New_Monadic_Op (Op, L_El);
+         else
+            El := New_Dyadic_Op
+              (Op, L_El,
+               New_Value (New_Indexed_Element
+                          (New_Acc_Value (New_Obj (Var_R_Base)),
+                           New_Obj_Value (Var_I))));
+         end if;
+         if Do_Invert then
+            El := New_Monadic_Op (ON_Not, El);
+         end if;
+
+         New_Assign_Stmt (New_Indexed_Element
+                          (New_Acc_Value (New_Obj (Var_Base)),
+                           New_Obj_Value (Var_I)),
+                          El);
+         Inc_Var (Var_I);
+         Finish_Loop_Stmt (Label);
+         Close_Temp;
+         Finish_Subprogram_Body;
+      end Translate_Predefined_Array_Logical;
+
+      procedure Translate_Predefined_Array_Shift (Subprg : Iir)
+      is
+         F_Info : Subprg_Info_Acc;
+         Inter : Iir;
+         Arr_Type : Iir_Array_Type_Definition;
+         Arr_Ptr_Type : O_Tnode;
+         Int_Type : O_Tnode;
+         --  Info for the array type.
+         Info : Type_Info_Acc;
+         Id : Name_Id;
+         Interface_List : O_Inter_List;
+         Var_Res : O_Dnode;
+         Var_L, Var_R : O_Dnode;
+         Name : O_Ident;
+
+         type Shift_Kind is (Sh_Logical, Sh_Arith, Rotation);
+         Shift : Shift_Kind;
+
+         --  Body;
+         Var_Length, Var_I, Var_I1 : O_Dnode;
+         Var_Res_Base, Var_L_Base : O_Dnode;
+         Var_Rl : O_Dnode;
+         Var_E : O_Dnode;
+         L : Mnode;
+         If_Blk, If_Blk1 : O_If_Block;
+         Label : O_Snode;
+         Res : Mnode;
+
+         procedure Do_Shift (To_Right : Boolean)
+         is
+            Tmp : O_Enode;
+         begin
+            --  * If R < LENGTH then
+            Start_If_Stmt (If_Blk1,
+                           New_Compare_Op (ON_Lt,
+                                           New_Obj_Value (Var_Rl),
+                                           New_Obj_Value (Var_Length),
+                                           Ghdl_Bool_Type));
+            --  RIGHT:
+            --  *   for I = R to LENGTH - 1 loop
+            --  *     RES[I] := L[I - R]
+            --  LEFT:
+            --  *   for I = 0 to LENGTH - R loop
+            --  *     RES[I] := L[R + I]
+            if To_Right then
+               New_Assign_Stmt (New_Obj (Var_I), New_Obj_Value (Var_Rl));
+               Init_Var (Var_I1);
+            else
+               Init_Var (Var_I);
+               New_Assign_Stmt (New_Obj (Var_I1), New_Obj_Value (Var_Rl));
+            end if;
+            Start_Loop_Stmt (Label);
+            if To_Right then
+               Tmp := New_Obj_Value (Var_I);
+            else
+               Tmp := New_Obj_Value (Var_I1);
+            end if;
+            Gen_Exit_When (Label, New_Compare_Op (ON_Ge,
+                                                  Tmp,
+                                                  New_Obj_Value (Var_Length),
+                                                  Ghdl_Bool_Type));
+            New_Assign_Stmt
+              (New_Indexed_Acc_Value (New_Obj (Var_Res_Base),
+                                      New_Obj_Value (Var_I)),
+               New_Value
+               (New_Indexed_Acc_Value (New_Obj (Var_L_Base),
+                                       New_Obj_Value (Var_I1))));
+            Inc_Var (Var_I);
+            Inc_Var (Var_I1);
+            Finish_Loop_Stmt (Label);
+            New_Else_Stmt (If_Blk1);
+            --  * else
+            --  *   R := LENGTH
+            New_Assign_Stmt (New_Obj (Var_Rl), New_Obj_Value (Var_Length));
+            Finish_If_Stmt (If_Blk1);
+
+            --  RIGHT:
+            --  * For I = 0 to R - 1
+            --  *   RES[I] := 0/L[0/LENGTH-1]
+            --  LEFT:
+            --  * For I = LENGTH - R to LENGTH - 1
+            --  *   RES[I] := 0/L[0/LENGTH-1]
+            if To_Right then
+               Init_Var (Var_I);
+            else
+               --  I is yet correctly set.
+               null;
+            end if;
+            if Shift = Sh_Arith then
+               if To_Right then
+                  Tmp := New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, 0));
+               else
+                  Tmp := New_Dyadic_Op
+                    (ON_Sub_Ov,
+                     New_Obj_Value (Var_Length),
+                     New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, 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 (New_Unsigned_Literal
+                                      (Ghdl_Index_Type, 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
+            --  *   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 : Iir;
+                     Val1 : Mnode;
+                  begin
+                     Open_Temp;
+                     Val1 := Stabilize (Val);
+                     El := Get_Element_Declaration_Chain
+                       (Get_Base_Type (Val_Type));
+                     while El /= Null_Iir loop
+                        Translate_Rw
+                          (Chap6.Translate_Selected_Element (Val1, El),
+                           Get_Type (El), Proc);
+                        El := Get_Chain (El);
+                     end loop;
+                     Close_Temp;
+                  end;
+               when Type_Mode_Array
+                 | Type_Mode_Ptr_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_Mark (File_Type);
+         Tinfo := Get_Info (Etype);
+         if Tinfo.Type_Mode in Type_Mode_Scalar then
+            --  Intrinsic.
+            return;
+         end if;
+
+         F_Info := Add_Info (Subprg, Kind_Subprg);
+         --Chap2.Clear_Instance_Data (F_Info.Subprg_Instance);
+         F_Info.Use_Stack2 := False;
+
+         Id := Get_Identifier (Get_Type_Declarator (File_Type));
+         Kind := Get_Implicit_Definition (Subprg);
+         case Kind is
+            when Iir_Predefined_Write =>
+               Name := Create_Identifier (Id, "_WRITE");
+            when Iir_Predefined_Read
+              | Iir_Predefined_Read_Length =>
+               Name := Create_Identifier (Id, "_READ");
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         --  Create function.
+         if Kind = Iir_Predefined_Read_Length then
+            Start_Function_Decl
+              (Inter_List, Name, Global_Storage, Std_Integer_Type_Node);
+         else
+            Start_Procedure_Decl (Inter_List, Name, Global_Storage);
+         end if;
+         Chap2.Create_Subprg_Instance (Inter_List, Subprg);
+
+         New_Interface_Decl
+           (Inter_List, Var_File, Get_Identifier ("FILE"),
+            Ghdl_File_Index_Type);
+         New_Interface_Decl
+           (Inter_List, Var_Val, Get_Identifier ("VAL"),
+            Tinfo.Ortho_Ptr_Type (Mode_Value));
+         Finish_Subprogram_Decl (Inter_List, F_Info.Ortho_Func);
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         Start_Subprogram_Body (F_Info.Ortho_Func);
+         Chap2.Start_Subprg_Instance_Use (Subprg);
+         Push_Local_Factory;
+
+         Var := Dp2M (Var_Val, Tinfo, Mode_Value);
+
+         case Kind is
+            when Iir_Predefined_Write =>
+               if Tinfo.Type_Mode = Type_Mode_Fat_Array then
+                  declare
+                     Var_Max : O_Dnode;
+                  begin
+                     Open_Temp;
+                     Var_Max := Create_Temp_Init
+                       (Ghdl_Index_Type,
+                        Chap3.Get_Array_Length (Var, Etype));
+                     Translate_Rw_Length (Var_Max, Ghdl_Write_Scalar);
+                     Translate_Rw_Array (Chap3.Get_Array_Base (Var), Etype,
+                                         Var_Max, Ghdl_Write_Scalar);
+                     Close_Temp;
+                  end;
+               else
+                  Translate_Rw (Var, Etype, Ghdl_Write_Scalar);
+               end if;
+            when Iir_Predefined_Read =>
+               Translate_Rw (Var, Etype, Ghdl_Read_Scalar);
+
+            when Iir_Predefined_Read_Length =>
+               declare
+                  Var_Len : O_Dnode;
+               begin
+                  Open_Temp;
+                  Var_Len := Create_Temp (Ghdl_Index_Type);
+                  Translate_Rw_Length (Var_Len, Ghdl_Read_Scalar);
+
+                  Chap6.Check_Bound_Error
+                    (New_Compare_Op (ON_Gt,
+                                     New_Obj_Value (Var_Len),
+                                     Chap3.Get_Array_Length (Var, Etype),
+                                     Ghdl_Bool_Type),
+                     Subprg, 1);
+                  Translate_Rw_Array (Chap3.Get_Array_Base (Var), Etype,
+                                      Var_Len, Ghdl_Read_Scalar);
+                  New_Return_Stmt (New_Convert_Ov (New_Obj_Value (Var_Len),
+                                                   Std_Integer_Type_Node));
+                  Close_Temp;
+               end;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Chap2.Finish_Subprg_Instance_Use (Subprg);
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+      end Translate_File_Subprogram;
+
+      procedure Init_Implicit_Subprogram_Infos
+        (Infos : out Implicit_Subprogram_Infos) is
+      begin
+         --  Be independant of declaration order since the same subprogram
+         --  may be used for several implicit operators (eg. array comparaison)
+         Infos.Arr_Eq_Info := null;
+         Infos.Arr_Cmp_Info := null;
+         Infos.Arr_Concat_Info := null;
+         Infos.Rec_Eq_Info := null;
+         Infos.Arr_Shl_Info := null;
+         Infos.Arr_Sha_Info := null;
+         Infos.Arr_Rot_Info := null;
+      end Init_Implicit_Subprogram_Infos;
+
+      procedure Translate_Implicit_Subprogram
+        (Subprg : Iir; Infos : in out Implicit_Subprogram_Infos)
+      is
+         Kind : Iir_Predefined_Functions;
+      begin
+         Kind := Get_Implicit_Definition (Subprg);
+         if Predefined_To_Onop (Kind) /= ON_Nil then
+            --  Intrinsic.
+            return;
+         end if;
+
+         case Kind is
+            when Iir_Predefined_Access_Equality
+              | Iir_Predefined_Access_Inequality =>
+               --  Intrinsic.
+               null;
+            when Iir_Predefined_Deallocate =>
+               --  Intrinsic.
+               null;
+            when Iir_Predefined_Integer_Identity
+              | Iir_Predefined_Integer_Exp =>
+               --  Intrinsic.
+               null;
+
+            when Iir_Predefined_Record_Equality
+              | Iir_Predefined_Record_Inequality =>
+               if Infos.Rec_Eq_Info = null then
+                  Translate_Predefined_Record_Equality (Subprg);
+                  Infos.Rec_Eq_Info := Get_Info (Subprg);
+               else
+                  Set_Info (Subprg, Infos.Rec_Eq_Info);
+               end if;
+
+            when Iir_Predefined_Array_Equality
+              | Iir_Predefined_Array_Inequality =>
+               if Infos.Arr_Eq_Info = null then
+                  Translate_Predefined_Array_Equality (Subprg);
+                  Infos.Arr_Eq_Info := Get_Info (Subprg);
+               else
+                  Set_Info (Subprg, Infos.Arr_Eq_Info);
+               end if;
+
+            when Iir_Predefined_Array_Greater
+              | Iir_Predefined_Array_Greater_Equal
+              | Iir_Predefined_Array_Less
+              | Iir_Predefined_Array_Less_Equal =>
+               if Infos.Arr_Cmp_Info = null then
+                  Translate_Predefined_Array_Compare (Subprg);
+                  Infos.Arr_Cmp_Info := Get_Info (Subprg);
+               else
+                  Set_Info (Subprg, Infos.Arr_Cmp_Info);
+               end if;
+
+            when Iir_Predefined_Array_Array_Concat
+              | Iir_Predefined_Array_Element_Concat
+              | Iir_Predefined_Element_Array_Concat
+              | Iir_Predefined_Element_Element_Concat =>
+               if Infos.Arr_Concat_Info = null then
+                  Translate_Predefined_Array_Array_Concat (Subprg);
+                  Infos.Arr_Concat_Info := Get_Info (Subprg);
+               else
+                  Set_Info (Subprg, Infos.Arr_Concat_Info);
+               end if;
+
+            when Iir_Predefined_Bit_Array_And
+              | Iir_Predefined_Bit_Array_Or
+              | Iir_Predefined_Bit_Array_Nand
+              | Iir_Predefined_Bit_Array_Nor
+              | Iir_Predefined_Bit_Array_Xor
+              | Iir_Predefined_Bit_Array_Xnor
+              | Iir_Predefined_Bit_Array_Not
+              | Iir_Predefined_Boolean_Array_And
+              | Iir_Predefined_Boolean_Array_Or
+              | Iir_Predefined_Boolean_Array_Nand
+              | Iir_Predefined_Boolean_Array_Nor
+              | Iir_Predefined_Boolean_Array_Xor
+              | Iir_Predefined_Boolean_Array_Xnor
+              | Iir_Predefined_Boolean_Array_Not =>
+               Translate_Predefined_Array_Logical (Subprg);
+
+            when Iir_Predefined_Array_Sll
+              | Iir_Predefined_Array_Srl =>
+               if Infos.Arr_Shl_Info = null then
+                  Translate_Predefined_Array_Shift (Subprg);
+                  Infos.Arr_Shl_Info := Get_Info (Subprg);
+               else
+                  Set_Info (Subprg, Infos.Arr_Shl_Info);
+               end if;
+
+            when Iir_Predefined_Array_Sla
+              | Iir_Predefined_Array_Sra =>
+               if Infos.Arr_Sha_Info = null then
+                  Translate_Predefined_Array_Shift (Subprg);
+                  Infos.Arr_Sha_Info := Get_Info (Subprg);
+               else
+                  Set_Info (Subprg, Infos.Arr_Sha_Info);
+               end if;
+
+            when Iir_Predefined_Array_Rol
+              | Iir_Predefined_Array_Ror =>
+               if Infos.Arr_Rot_Info = null then
+                  Translate_Predefined_Array_Shift (Subprg);
+                  Infos.Arr_Rot_Info := Get_Info (Subprg);
+               else
+                  Set_Info (Subprg, Infos.Arr_Rot_Info);
+               end if;
+
+            when Iir_Predefined_Physical_Identity =>
+               null;
+
+            when Iir_Predefined_Physical_Integer_Mul
+              | Iir_Predefined_Physical_Integer_Div
+              | Iir_Predefined_Integer_Physical_Mul
+              | Iir_Predefined_Physical_Real_Mul
+              | Iir_Predefined_Physical_Real_Div
+              | Iir_Predefined_Real_Physical_Mul
+              | Iir_Predefined_Physical_Physical_Div =>
+               null;
+
+            when Iir_Predefined_Floating_Exp
+              | Iir_Predefined_Floating_Identity =>
+               null;
+
+            when Iir_Predefined_File_Open
+              | Iir_Predefined_File_Open_Status
+              | Iir_Predefined_File_Close
+              | Iir_Predefined_Endfile =>
+               --  All of them have predefined definitions.
+               null;
+
+            when Iir_Predefined_Write
+              | Iir_Predefined_Read_Length
+              | Iir_Predefined_Read =>
+               declare
+                  Param : Iir;
+                  File_Type : Iir;
+               begin
+                  Param := Get_Interface_Declaration_Chain (Subprg);
+                  File_Type := Get_Type (Param);
+                  if not Get_Text_File_Flag (File_Type) then
+                     Translate_File_Subprogram (Subprg, File_Type);
+                  end if;
+               end;
+
+            when Iir_Predefined_Now_Function =>
+               null;
+
+            when others =>
+               Error_Kind ("translate_implicit_subprogram ("
+                           & Iir_Predefined_Functions'Image (Kind) & ")",
+                           Subprg);
+         end case;
+      end Translate_Implicit_Subprogram;
+   end Chap7;
+
+   package body Chap8 is
+      procedure Translate_Return_Statement (Stmt : Iir_Return_Statement)
+      is
+         Expr : Iir;
+         Ret_Type : Iir;
+         Ret_Info : Type_Info_Acc;
+         Val : O_Dnode;
+         Area : Mnode;
+         Subprg_Info : Ortho_Info_Acc;
+
+         procedure Gen_Return is
+         begin
+            if Subprg_Info.Subprg_Exit /= O_Snode_Null then
+               New_Exit_Stmt (Subprg_Info.Subprg_Exit);
+            else
+               New_Return_Stmt;
+            end if;
+         end Gen_Return;
+
+         procedure Gen_Return_Value (Val : O_Enode) is
+         begin
+            if Subprg_Info.Subprg_Exit /= O_Snode_Null then
+               New_Assign_Stmt (New_Obj (Subprg_Info.Subprg_Result), Val);
+               New_Exit_Stmt (Subprg_Info.Subprg_Exit);
+            else
+               New_Return_Stmt (Val);
+            end if;
+         end Gen_Return_Value;
+      begin
+         Subprg_Info := Get_Info (Chap2.Current_Subprogram);
+
+         Expr := Get_Expression (Stmt);
+         if Expr = Null_Iir then
+            --  Return in a procedure.
+            Gen_Return;
+            return;
+         end if;
+
+         --  Return in a function.
+         Ret_Type := Get_Return_Type (Chap2.Current_Subprogram);
+         Ret_Info := Get_Info (Ret_Type);
+         case Ret_Info.Type_Mode is
+            when Type_Mode_Scalar =>
+               --  * if the return type is scalar, simply returns.
+               declare
+                  V : O_Dnode;
+               begin
+                  V := Create_Temp (Ret_Info.Ortho_Type (Mode_Value));
+                  Open_Temp;
+                  New_Assign_Stmt
+                    (New_Obj (V), Chap7.Translate_Expression (Expr, Ret_Type));
+                  Close_Temp;
+                  Chap3.Check_Range (V, Expr, Ret_Type);
+                  Gen_Return_Value (New_Obj_Value (V));
+               end;
+            when Type_Mode_Acc =>
+               --  * access: thin and no range.
+               declare
+                  Res : O_Enode;
+               begin
+                  Res := Chap7.Translate_Expression (Expr, Ret_Type);
+                  Gen_Return_Value (Res);
+               end;
+            when Type_Mode_Fat_Array =>
+               --  * if the return type is unconstrained: allocate an area from
+               --    the secondary stack, copy it to the area, and fill the fat
+               --    pointer.
+               --  Evaluate the result.
+               Area := Dp2M (Subprg_Info.Res_Interface, Ret_Info, Mode_Value);
+               Val := Create_Temp_Init
+                 (Ret_Info.Ortho_Ptr_Type (Mode_Value),
+                  Chap7.Translate_Expression (Expr, Ret_Type));
+               Chap3.Translate_Object_Allocation
+                 (Area, Alloc_Return, Ret_Type,
+                  Chap3.Get_Array_Ptr_Bounds_Ptr
+                  (New_Obj (Val), Ret_Type, Mode_Value));
+               Chap3.Translate_Object_Copy
+                 (Area, New_Obj_Value (Val), Ret_Type);
+               Gen_Return;
+            when Type_Mode_Record
+              | Type_Mode_Array
+              | Type_Mode_Ptr_Array
+              | Type_Mode_Fat_Acc =>
+               --  * if the return type is a constrained composite type, copy
+               --    it to the result area.
+               --  Create a temporary area so that if the expression use
+               --  stack2, it will be freed before the return (otherwise,
+               --  the stack area will be lost).
+               declare
+                  V : Mnode;
+               begin
+                  Open_Temp;
+                  V := Dp2M (Subprg_Info.Res_Interface, Ret_Info, Mode_Value);
+                  Chap3.Translate_Object_Copy
+                    (V, Chap7.Translate_Expression (Expr, Ret_Type), Ret_Type);
+                  Close_Temp;
+                  Gen_Return;
+               end;
+            when Type_Mode_File =>
+               --  FIXME: Is it possible ?
+               Error_Kind ("translate_return_statement", Ret_Type);
+            when Type_Mode_Unknown
+              | Type_Mode_Protected =>
+               raise Internal_Error;
+         end case;
+      end Translate_Return_Statement;
+
+      procedure Translate_If_Statement (Stmt : Iir)
+      is
+         Blk : O_If_Block;
+         Else_Clause : Iir;
+      begin
+         Start_If_Stmt
+           (Blk, Chap7.Translate_Expression (Get_Condition (Stmt)));
+
+         Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
+
+         Else_Clause := Get_Else_Clause (Stmt);
+         if Else_Clause /= Null_Iir then
+            New_Else_Stmt (Blk);
+            if Get_Condition (Else_Clause) = Null_Iir then
+               Translate_Statements_Chain
+                 (Get_Sequential_Statement_Chain (Else_Clause));
+            else
+               Open_Temp;
+               Translate_If_Statement (Else_Clause);
+               Close_Temp;
+            end if;
+         end if;
+         Finish_If_Stmt (Blk);
+      end Translate_If_Statement;
+
+      function Get_Range_Ptr_Field_Value (O_Range : O_Lnode; Field : O_Fnode)
+        return O_Enode
+      is
+      begin
+         return New_Value (New_Selected_Element
+                           (New_Access_Element (New_Value (O_Range)), Field));
+      end Get_Range_Ptr_Field_Value;
+
+      --  Inc or dec ITERATOR according to DIR.
+      procedure Gen_Update_Iterator (Iterator : O_Dnode;
+                                     Dir : Iir_Direction;
+                                     Val : Unsigned_64;
+                                     Itype : Iir)
+      is
+         Op : ON_Op_Kind;
+         Base_Type : Iir;
+         V : O_Enode;
+      begin
+         case Dir is
+            when Iir_To =>
+               Op := ON_Add_Ov;
+            when Iir_Downto =>
+               Op := ON_Sub_Ov;
+         end case;
+         Base_Type := Get_Base_Type (Itype);
+         case Get_Kind (Base_Type) is
+            when Iir_Kind_Integer_Type_Definition =>
+               V := New_Lit
+                 (New_Signed_Literal
+                  (Get_Ortho_Type (Base_Type, Mode_Value), Integer_64 (Val)));
+            when Iir_Kind_Enumeration_Type_Definition =>
+               declare
+                  List : Iir_List;
+               begin
+                  List := Get_Enumeration_Literal_List (Base_Type);
+                  --  FIXME: what about type E is ('T') ??
+                  if Natural (Val) > Get_Nbr_Elements (List) then
+                     raise Internal_Error;
+                  end if;
+                  V := New_Lit
+                    (Get_Ortho_Expr (Get_Nth_Element (List, Natural (Val))));
+               end;
+
+            when others =>
+               Error_Kind ("gen_update_iterator", Base_Type);
+         end case;
+         New_Assign_Stmt (New_Obj (Iterator),
+                          New_Dyadic_Op (Op, New_Obj_Value (Iterator), V));
+      end Gen_Update_Iterator;
+
+      type For_Loop_Data is record
+         Iterator : Iir_Iterator_Declaration;
+         Stmt : Iir_For_Loop_Statement;
+         --  If around the loop, to check if the loop must be executed.
+         If_Blk : O_If_Block;
+         Label_Next, Label_Exit : O_Snode;
+         --  Right bound of the iterator, used only if the iterator is a
+         --  range expression.
+         O_Right : O_Dnode;
+         --  Range variable of the iterator, used only if the iterator is not
+         --  a range expression.
+         O_Range : O_Dnode;
+      end record;
+
+      procedure Start_For_Loop (Iterator : Iir_Iterator_Declaration;
+                                Stmt : Iir_For_Loop_Statement;
+                                Data : out For_Loop_Data)
+      is
+         Iter_Type : Iir;
+         Iter_Base_Type : Iir;
+         Var_Iter : Var_Acc;
+         Constraint : Iir;
+         Cond_To, Cond_Downto : O_Enode;
+         Cond_Dir : O_Enode;
+         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;
+            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);
+            Open_Temp;
+            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));
+            Close_Temp;
+            --  Before starting the loop, check wether there will be at least
+            --  one iteration.
+            Cond_To := New_Compare_Op
+              (ON_Le, New_Value (Get_Var (Var_Iter)),
+               Get_Range_Ptr_Field_Value (New_Obj (Data.O_Range),
+                                          Iter_Type_Info.T.Range_Right),
+               Ghdl_Bool_Type);
+            Cond_Dir := 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);
+            Cond_To := New_Dyadic_Op (ON_And, Cond_Dir, Cond_To);
+            Cond_Downto := New_Compare_Op
+              (ON_Ge, New_Value (Get_Var (Var_Iter)),
+               Get_Range_Ptr_Field_Value (New_Obj (Data.O_Range),
+                                          Iter_Type_Info.T.Range_Right),
+               Ghdl_Bool_Type);
+            Cond_Dir := 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_Downto_Node),
+               Ghdl_Bool_Type);
+            Cond_Downto := New_Dyadic_Op (ON_And, Cond_Dir, Cond_Downto);
+            Cond := New_Dyadic_Op (ON_Or, Cond_To, Cond_Downto);
+         end if;
+
+         Start_If_Stmt (Data.If_Blk, Cond);
+
+         --  Start loop.
+         --  There are two blocks: one for the exit, one for the next.
+         Start_Loop_Stmt (Data.Label_Exit);
+         Start_Loop_Stmt (Data.Label_Next);
+
+         if Stmt /= Null_Iir then
+            declare
+               Loop_Info : Loop_Info_Acc;
+            begin
+               Loop_Info := Add_Info (Stmt, Kind_Loop);
+               Loop_Info.Label_Exit := Data.Label_Exit;
+               Loop_Info.Label_Next := Data.Label_Next;
+            end;
+         end if;
+      end Start_For_Loop;
+
+      procedure Finish_For_Loop (Data : in out For_Loop_Data)
+      is
+         Cond : O_Enode;
+         If_Blk1 : O_If_Block;
+         Iter_Type : Iir;
+         Iter_Base_Type : Iir;
+         Iter_Type_Info : Type_Info_Acc;
+         Var_Iter : Var_Acc;
+         Constraint : Iir;
+      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.
+         if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
+            Gen_Update_Iterator
+              (Get_Var_Label (Var_Iter), Get_Direction (Constraint),
+               1, Iter_Base_Type);
+         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;
+
+      pragma Unreferenced (Start_For_Loop, Finish_For_Loop);
+
+      Current_Loop : Iir := Null_Iir;
+
+      procedure Translate_For_Loop_Statement (Stmt : Iir_For_Loop_Statement)
+      is
+         Iterator : Iir;
+         Iter_Type : Iir;
+         Iter_Base_Type : Iir;
+         Iter_Type_Info : Type_Info_Acc;
+         Loop_Info : Loop_Info_Acc;
+         It_Info : Ortho_Info_Acc;
+         O_Range : O_Dnode;
+         O_Right : O_Dnode;
+         Cond_To, Cond_Downto : O_Enode;
+         Cond_Dir : O_Enode;
+         Cond : O_Enode;
+         Dir : Iir_Direction;
+         Op : ON_Op_Kind;
+         If_Blk, If_Blk1 : O_If_Block;
+         Var_Iter : Var_Acc;
+         Constraint : Iir;
+         Prev_Loop : Iir;
+      begin
+         Prev_Loop := Current_Loop;
+         Current_Loop := Stmt;
+         Start_Declare_Stmt;
+         Iterator := Get_Iterator_Scheme (Stmt);
+         Iter_Type := Get_Type (Iterator);
+         Iter_Base_Type := Get_Base_Type (Iter_Type);
+         Iter_Type_Info := Get_Info (Iter_Base_Type);
+
+         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;
+
+         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);
+            O_Right := Create_Temp (Iter_Type_Info.Ortho_Type (Mode_Value));
+            New_Assign_Stmt
+              (New_Obj (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;
+            Cond := New_Compare_Op
+              (Op, New_Value (Get_Var (Var_Iter)), New_Obj_Value (O_Right),
+               Ghdl_Bool_Type);
+         else
+            O_Range := Create_Temp (Iter_Type_Info.T.Range_Ptr_Type);
+            New_Assign_Stmt (New_Obj (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 (O_Range), Iter_Type_Info.T.Range_Left));
+            --  Before starting the loop, check wether there will be at least
+            --  one iteration.
+            Cond_To := New_Compare_Op
+              (ON_Le, New_Value (Get_Var (Var_Iter)),
+               Get_Range_Ptr_Field_Value (New_Obj (O_Range),
+                                          Iter_Type_Info.T.Range_Right),
+               Ghdl_Bool_Type);
+            Cond_Dir := New_Compare_Op
+              (ON_Eq,
+               Get_Range_Ptr_Field_Value (New_Obj (O_Range),
+                                          Iter_Type_Info.T.Range_Dir),
+               New_Lit (Ghdl_Dir_To_Node),
+               Ghdl_Bool_Type);
+            Cond_To := New_Dyadic_Op (ON_And, Cond_Dir, Cond_To);
+            Cond_Downto := New_Compare_Op
+              (ON_Ge, New_Value (Get_Var (Var_Iter)),
+               Get_Range_Ptr_Field_Value (New_Obj (O_Range),
+                                          Iter_Type_Info.T.Range_Right),
+               Ghdl_Bool_Type);
+            Cond_Dir := New_Compare_Op
+              (ON_Eq,
+               Get_Range_Ptr_Field_Value (New_Obj (O_Range),
+                                          Iter_Type_Info.T.Range_Dir),
+               New_Lit (Ghdl_Dir_Downto_Node),
+               Ghdl_Bool_Type);
+            Cond_Downto := New_Dyadic_Op (ON_And, Cond_Dir, Cond_Downto);
+            Cond := New_Dyadic_Op (ON_Or, Cond_To, Cond_Downto);
+         end if;
+
+         Start_If_Stmt (If_Blk, Cond);
+
+         --  Start loop.
+         --  There are two blocks: one for the exit, one for the next.
+         Loop_Info := Add_Info (Stmt, Kind_Loop);
+         Start_Loop_Stmt (Loop_Info.Label_Exit);
+         Start_Loop_Stmt (Loop_Info.Label_Next);
+
+         Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
+
+         New_Exit_Stmt (Loop_Info.Label_Next);
+         Finish_Loop_Stmt (Loop_Info.Label_Next);
+
+         --  Check end of loop.
+         --  Equality is necessary and enough.
+         if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
+            Cond := New_Obj_Value (O_Right);
+         else
+            Cond := Get_Range_Ptr_Field_Value
+              (New_Obj (O_Range), Iter_Type_Info.T.Range_Right);
+         end if;
+         Gen_Exit_When (Loop_Info.Label_Exit,
+                        New_Compare_Op (ON_Eq, New_Value (Get_Var (Var_Iter)),
+                                        Cond, Ghdl_Bool_Type));
+
+         --  Update the iterator.
+         if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
+            Gen_Update_Iterator
+              (Get_Var_Label (Var_Iter), Dir, 1, Iter_Base_Type);
+         else
+            Start_If_Stmt
+              (If_Blk1, New_Compare_Op
+               (ON_Eq,
+                Get_Range_Ptr_Field_Value (New_Obj (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 (Loop_Info.Label_Exit);
+         Finish_If_Stmt (If_Blk);
+         Close_Temp;
+         Finish_Declare_Stmt;
+
+         Free_Info (Stmt);
+         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 : Iir;
+         If_Blk : O_If_Block;
+         Info : Loop_Info_Acc;
+         Loop_Stmt : Iir;
+      begin
+         Cond := Get_Condition (Stmt);
+         if Cond /= Null_Iir then
+            Start_If_Stmt (If_Blk, Chap7.Translate_Expression (Cond));
+         end if;
+         Loop_Stmt := Get_Loop (Stmt);
+         if Loop_Stmt = Null_Iir then
+            Loop_Stmt := Current_Loop;
+         end if;
+         Info := Get_Info (Loop_Stmt);
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Exit_Statement =>
+               New_Exit_Stmt (Info.Label_Exit);
+            when Iir_Kind_Next_Statement =>
+               if Info.Label_Next /= O_Snode_Null then
+                  --  For-loop.
+                  New_Exit_Stmt (Info.Label_Next);
+               else
+                  --  While-loop.
+                  New_Next_Stmt (Info.Label_Exit);
+               end if;
+            when others =>
+               raise Internal_Error;
+         end case;
+         if Cond /= Null_Iir then
+            Finish_If_Stmt (If_Blk);
+         end if;
+      end Translate_Exit_Next_Statement;
+
+      procedure Translate_Variable_Aggregate_Assignment
+        (Targ : Iir; Targ_Type : Iir; Val : Mnode);
+
+      procedure Translate_Variable_Array_Aggr
+        (Targ : Iir_Aggregate;
+         Targ_Type : Iir;
+         Val : Mnode;
+         Index : in out Unsigned_64;
+         Dim : Natural)
+      is
+         El : Iir;
+         Final : Boolean;
+         El_Type : Iir;
+      begin
+         Final := Dim = Get_Nbr_Elements (Get_Index_Subtype_List (Targ_Type));
+         if Final then
+            El_Type := Get_Element_Subtype (Targ_Type);
+         end if;
+         El := Get_Association_Choices_Chain (Targ);
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Choice_By_None =>
+                  if Final then
+                     Translate_Variable_Aggregate_Assignment
+                       (Get_Associated (El), El_Type,
+                        Chap3.Index_Base
+                        (Val, Targ_Type,
+                         New_Lit (New_Unsigned_Literal
+                                  (Ghdl_Index_Type, Index))));
+                     Index := Index + 1;
+                  else
+                     Translate_Variable_Array_Aggr
+                       (Get_Associated (El), Targ_Type, Val, Index, Dim + 1);
+                  end if;
+               when others =>
+                  Error_Kind ("translate_variable_array_aggr", El);
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end Translate_Variable_Array_Aggr;
+
+      procedure Translate_Variable_Rec_Aggr
+        (Targ : Iir_Aggregate; Targ_Type : Iir; Val : Mnode)
+      is
+         Aggr_El : Iir;
+         El : Iir_Element_Declaration;
+         Elem : Iir;
+      begin
+         El := Get_Element_Declaration_Chain (Get_Base_Type (Targ_Type));
+         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 := El;
+                  El := Get_Chain (El);
+               when Iir_Kind_Choice_By_Name =>
+                  Elem := Get_Name (Aggr_El);
+                  El := Null_Iir;
+               when others =>
+                  Error_Kind ("translate_variable_rec_aggr", Aggr_El);
+            end case;
+            Translate_Variable_Aggregate_Assignment
+              (Get_Associated (Aggr_El), Get_Type (Elem),
+               Chap6.Translate_Selected_Element (Val, Elem));
+            Aggr_El := Get_Chain (Aggr_El);
+         end loop;
+      end Translate_Variable_Rec_Aggr;
+
+      procedure Translate_Variable_Aggregate_Assignment
+        (Targ : Iir; Targ_Type : Iir; Val : Mnode)
+      is
+         Index : Unsigned_64;
+      begin
+         if Get_Kind (Targ) = Iir_Kind_Aggregate then
+            case Get_Kind (Targ_Type) is
+               when Iir_Kinds_Array_Type_Definition =>
+                  Index := 0;
+                  Translate_Variable_Array_Aggr
+                    (Targ, Targ_Type, Val, Index, 1);
+               when Iir_Kind_Record_Type_Definition
+                 | Iir_Kind_Record_Subtype_Definition =>
+                  Translate_Variable_Rec_Aggr (Targ, Targ_Type, Val);
+               when others =>
+                  Error_Kind
+                    ("translate_variable_aggregate_assignment", Targ_Type);
+            end case;
+         else
+            declare
+               Targ_Node : Mnode;
+            begin
+               Targ_Node := Chap6.Translate_Name (Targ);
+               Chap3.Translate_Object_Copy (Targ_Node, M2E (Val), Targ_Type);
+            end;
+         end if;
+      end Translate_Variable_Aggregate_Assignment;
+
+      procedure Translate_Variable_Assignment_Statement
+        (Stmt : Iir_Variable_Assignment_Statement)
+      is
+         Target : Iir;
+         Targ_Type : Iir;
+         Expr : Iir;
+         Targ_Node : Mnode;
+      begin
+         Target := Get_Target (Stmt);
+         Targ_Type := Get_Type (Target);
+         Expr := Get_Expression (Stmt);
+         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_Address (New_Obj (Ghdl_Assert_Default_Report),
+                                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;
+
+      procedure Translate_Assertion_Statement (Stmt : Iir_Assertion_Statement)
+      is
+         Expr : Iir;
+         If_Blk : O_If_Block;
+      begin
+         Expr := Get_Assertion_Condition (Stmt);
+         if Get_Expr_Staticness (Expr) = Locally then
+            if Eval_Pos (Expr) = 1 then
+               --  Assert TRUE is a noop.
+               --  FIXME: generate a noop.
+               return;
+            end if;
+            Translate_Report (Stmt, Ghdl_Assert_Failed, Severity_Level_Error);
+         else
+            --  An assertion is reported if the condition is false!
+            Start_If_Stmt (If_Blk,
+                           New_Monadic_Op (ON_Not,
+                                           Chap7.Translate_Expression (Expr)));
+            --  Note: it is necessary to create a declare block, to avoid bad
+            --  order with the if block.
+            Open_Temp;
+            Translate_Report (Stmt, Ghdl_Assert_Failed, Severity_Level_Error);
+            Close_Temp;
+            Finish_If_Stmt (If_Blk);
+         end if;
+      end Translate_Assertion_Statement;
+
+      procedure Translate_Report_Statement (Stmt : Iir_Report_Statement) is
+      begin
+         Translate_Report (Stmt, Ghdl_Report, Severity_Level_Note);
+      end Translate_Report_Statement;
+
+      function Translate_Simple_String_Choice
+        (Expr : O_Dnode;
+         Val : Iir;
+         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)),
+            Chap7.Translate_Expression (Val, Get_Type (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;
+
+      procedure Translate_String_Choice
+        (Expr : O_Dnode;
+         Val_Node : O_Dnode;
+         Tinfo : Type_Info_Acc;
+         Func : Iir;
+         Cond_Var : O_Dnode;
+         Choice : Iir)
+      is
+         Cond : O_Enode;
+         If_Blk : O_If_Block;
+         Stmt_Chain : Iir;
+         First : Boolean;
+         Ch : Iir;
+      begin
+         if Choice = Null_Iir then
+            return;
+         end if;
+
+         First := True;
+         Stmt_Chain := Get_Associated (Choice);
+         Ch := Choice;
+         loop
+            case Get_Kind (Ch) is
+               when Iir_Kind_Choice_By_Expression =>
+                  Cond := Translate_Simple_String_Choice
+                    (Expr, Get_Expression (Ch), Val_Node, Tinfo, Func);
+               when Iir_Kind_Choice_By_Others =>
+                  Translate_Statements_Chain (Stmt_Chain);
+                  return;
+               when others =>
+                  Error_Kind ("translate_string_choice", Ch);
+            end case;
+            if not First then
+               New_Assign_Stmt
+                 (New_Obj (Cond_Var),
+                  New_Dyadic_Op (ON_Or, New_Obj_Value (Cond_Var), Cond));
+            end if;
+            Ch := Get_Chain (Ch);
+            exit when Ch = Null_Iir;
+            exit when not Get_Same_Alternative_Flag (Ch);
+            exit when Get_Associated (Ch) /= Null_Iir;
+            if First then
+               New_Assign_Stmt (New_Obj (Cond_Var), Cond);
+               First := False;
+            end if;
+         end loop;
+         if not First then
+            Cond := New_Obj_Value (Cond_Var);
+         end if;
+         Start_If_Stmt (If_Blk, Cond);
+         Translate_Statements_Chain (Stmt_Chain);
+         New_Else_Stmt (If_Blk);
+         Translate_String_Choice
+           (Expr, Val_Node, Tinfo, Func, Cond_Var, Ch);
+         Finish_If_Stmt (If_Blk);
+      end Translate_String_Choice;
+
+      --  Case statement whose expression is an unidim array.
+      procedure Translate_String_Case_Statement (Stmt : Iir_Case_Statement)
+      is
+         Expr : Iir;
+         Expr_Type : Iir;
+         Base_Type : Iir;
+         --  Node containing the address of the selector.
+         Expr_Node : O_Dnode;
+         --  Node containing the current choice.
+         C_Node : O_Dnode;
+         Tinfo : Type_Info_Acc;
+
+         Choices_Chain : Iir;
+         Func : Iir;
+         Cond_Var : O_Dnode;
+      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);
+
+         Expr_Node := Create_Temp_Init
+           (Tinfo.Ortho_Ptr_Type (Mode_Value),
+            Chap7.Translate_Expression (Expr, Base_Type));
+         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)));
+
+         Cond_Var := Create_Temp (Std_Boolean_Type_Node);
+
+         Func := Chap7.Find_Predefined_Function
+           (Base_Type, Iir_Predefined_Array_Equality);
+
+         Choices_Chain := Get_Case_Statement_Alternative_Chain (Stmt);
+         Translate_String_Choice
+           (Expr_Node, C_Node,
+            Tinfo, Func, Cond_Var, Choices_Chain);
+      end Translate_String_Case_Statement;
+
+      procedure Translate_Case_Choice
+        (Choice : Iir; Choice_Type : Iir; Blk : in out O_Case_Block)
+      is
+         Expr : Iir;
+      begin
+         case Get_Kind (Choice) is
+            when Iir_Kind_Choice_By_Others =>
+               New_Default_Choice (Blk);
+            when Iir_Kind_Choice_By_Expression =>
+               Expr := Get_Expression (Choice);
+               New_Expr_Choice
+                 (Blk, Chap7.Translate_Static_Expression (Expr, Choice_Type));
+            when Iir_Kind_Choice_By_Range =>
+               declare
+                  H, L : Iir;
+               begin
+                  Expr := Get_Expression (Choice);
+                  Get_Low_High_Limit (Expr, L, H);
+                  New_Range_Choice
+                    (Blk,
+                     Chap7.Translate_Static_Expression (L, Choice_Type),
+                     Chap7.Translate_Static_Expression (H, Choice_Type));
+               end;
+            when others =>
+               Error_Kind ("translate_case_choice", Choice);
+         end case;
+      end Translate_Case_Choice;
+
+      procedure Translate_Case_Statement (Stmt : Iir_Case_Statement)
+      is
+         Expr : Iir;
+         Expr_Type : Iir;
+         Case_Blk : O_Case_Block;
+         Choice : Iir;
+         Stmt_Chain : Iir;
+      begin
+         Expr := Get_Expression (Stmt);
+         Expr_Type := Get_Type (Expr);
+         if Get_Kind (Expr_Type) = Iir_Kind_Array_Subtype_Definition then
+            Translate_String_Case_Statement (Stmt);
+            return;
+         end if;
+         Start_Case_Stmt (Case_Blk, Chap7.Translate_Expression (Expr));
+         Choice := Get_Case_Statement_Alternative_Chain (Stmt);
+         while Choice /= Null_Iir loop
+            Start_Choice (Case_Blk);
+            Stmt_Chain := Get_Associated (Choice);
+            loop
+               Translate_Case_Choice (Choice, Expr_Type, Case_Blk);
+               Choice := Get_Chain (Choice);
+               exit when Choice = Null_Iir;
+               exit when not Get_Same_Alternative_Flag (Choice);
+               if Get_Associated (Choice) /= Null_Iir then
+                  raise Internal_Error;
+               end if;
+            end loop;
+            Finish_Choice (Case_Blk);
+            Translate_Statements_Chain (Stmt_Chain);
+         end loop;
+         Finish_Case_Stmt (Case_Blk);
+      end Translate_Case_Statement;
+
+      procedure Translate_Write_Procedure_Call (Imp : Iir; Param_Chain : Iir)
+      is
+         F_Assoc : Iir;
+         Value_Assoc : Iir;
+         Value : O_Dnode;
+         Formal_Type : Iir;
+         Tinfo : Type_Info_Acc;
+         Assocs : O_Assoc_List;
+         Subprg_Info : Subprg_Info_Acc;
+      begin
+         F_Assoc := Param_Chain;
+         Value_Assoc := Get_Chain (Param_Chain);
+         Formal_Type := Get_Type (Get_Formal (Value_Assoc));
+         Tinfo := Get_Info (Formal_Type);
+         case Tinfo.Type_Mode is
+            when Type_Mode_Scalar =>
+               Open_Temp;
+               Start_Association (Assocs, Ghdl_Write_Scalar);
+               --    compute file parameter (get an index)
+               New_Association
+                 (Assocs, Chap7.Translate_Expression (Get_Actual (F_Assoc)));
+               --    compute the value.
+               Value := Create_Temp (Tinfo.Ortho_Type (Mode_Value));
+               New_Assign_Stmt
+                 (New_Obj (Value),
+                  Chap7.Translate_Expression (Get_Actual (Value_Assoc)));
+               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_Ptr_Array
+              | 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_Ptr_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
+         Kind : Iir_Predefined_Functions;
+         Imp : Iir;
+         Param_Chain : Iir;
+      begin
+         Imp := Get_Implementation (Call);
+         Kind := Get_Implicit_Definition (Imp);
+         Param_Chain := Get_Parameter_Association_Chain (Call);
+         case Kind is
+            when Iir_Predefined_Write =>
+               --  Check wether text or not.
+               declare
+                  File_Param : Iir;
+                  Assocs : O_Assoc_List;
+               begin
+                  File_Param := Param_Chain;
+                  -- FIXME: do the test.
+                  if Get_Text_File_Flag (Get_Type (Get_Formal (File_Param)))
+                  then
+                     --  If text:
+                     Start_Association (Assocs, Ghdl_Text_Write);
+                     --    compute file parameter (get an index)
+                     New_Association
+                       (Assocs,
+                        Chap7.Translate_Expression (Get_Actual (File_Param)));
+                     --    compute string parameter (get a fat array pointer)
+                     New_Association
+                       (Assocs, Chap7.Translate_Expression
+                        (Get_Actual (Get_Chain (Param_Chain)),
+                         String_Type_Definition));
+                     --    call a predefined procedure
+                     New_Procedure_Call (Assocs);
+                  else
+                     Translate_Write_Procedure_Call (Imp, Param_Chain);
+                  end if;
+               end;
+
+            when Iir_Predefined_Read_Length =>
+               --  FIXME: works only for text read length.
+               declare
+                  File_Param : Iir;
+                  N_Param : Iir;
+                  Assocs : O_Assoc_List;
+                  Str : O_Enode;
+                  Res : Mnode;
+               begin
+                  File_Param := Param_Chain;
+                  if Get_Text_File_Flag (Get_Type (Get_Formal (File_Param)))
+                  then
+                     N_Param := Get_Chain (File_Param);
+                     Str := Chap7.Translate_Expression
+                       (Get_Actual (N_Param), String_Type_Definition);
+                     N_Param := Get_Chain (N_Param);
+                     Res := Chap6.Translate_Name (Get_Actual (N_Param));
+                     Start_Association (Assocs, Ghdl_Text_Read_Length);
+                     --    compute file parameter (get an index)
+                     New_Association
+                       (Assocs,
+                        Chap7.Translate_Expression (Get_Actual (File_Param)));
+                     --    compute string parameter (get a fat array pointer)
+                     New_Association (Assocs, Str);
+                     --    call a predefined procedure
+                     New_Assign_Stmt
+                       (M2Lv (Res), New_Function_Call (Assocs));
+                  else
+                     Translate_Read_Procedure_Call (Imp, Param_Chain);
+                  end if;
+               end;
+
+            when Iir_Predefined_Read =>
+               Translate_Read_Procedure_Call (Imp, Param_Chain);
+
+            when Iir_Predefined_Deallocate =>
+               Chap3.Translate_Object_Deallocation (Get_Actual (Param_Chain));
+
+            when Iir_Predefined_File_Open =>
+               declare
+                  N_Param : Iir;
+                  File_Param : Iir;
+                  Name_Param : Iir;
+                  Kind_Param : Iir;
+                  Constr : O_Assoc_List;
+               begin
+                  File_Param := Get_Actual (Param_Chain);
+                  N_Param := Get_Chain (Param_Chain);
+                  Name_Param := Get_Actual (N_Param);
+                  N_Param := Get_Chain (N_Param);
+                  Kind_Param := Get_Actual (N_Param);
+                  if Get_Text_File_Flag (Get_Type (File_Param)) then
+                     Start_Association (Constr, Ghdl_Text_File_Open);
+                  else
+                     Start_Association (Constr, Ghdl_File_Open);
+                  end if;
+                  New_Association
+                    (Constr, Chap7.Translate_Expression (File_Param));
+                  New_Association
+                    (Constr, New_Convert_Ov
+                     (Chap7.Translate_Expression (Kind_Param), Ghdl_I32_Type));
+                  New_Association
+                    (Constr,
+                     Chap7.Translate_Expression (Name_Param,
+                                                 String_Type_Definition));
+                  New_Procedure_Call (Constr);
+               end;
+
+            when Iir_Predefined_File_Open_Status =>
+               declare
+                  N_Param : Iir;
+                  Status_Param : Iir;
+                  File_Param : Iir;
+                  Name_Param : Iir;
+                  Kind_Param : Iir;
+                  Constr : O_Assoc_List;
+                  Status : Mnode;
+               begin
+                  Status_Param := Get_Actual (Param_Chain);
+                  Status := Chap6.Translate_Name (Status_Param);
+                  N_Param := Get_Chain (Param_Chain);
+                  File_Param := Get_Actual (N_Param);
+                  N_Param := Get_Chain (N_Param);
+                  Name_Param := Get_Actual (N_Param);
+                  N_Param := Get_Chain (N_Param);
+                  Kind_Param := Get_Actual (N_Param);
+                  if Get_Text_File_Flag (Get_Type (File_Param)) then
+                     Start_Association (Constr, Ghdl_Text_File_Open_Status);
+                  else
+                     Start_Association (Constr, Ghdl_File_Open_Status);
+                  end if;
+                  New_Association
+                    (Constr, Chap7.Translate_Expression (File_Param));
+                  New_Association
+                    (Constr, New_Convert_Ov
+                     (Chap7.Translate_Expression (Kind_Param), Ghdl_I32_Type));
+                  New_Association
+                    (Constr,
+                     Chap7.Translate_Expression (Name_Param,
+                                                 String_Type_Definition));
+                  New_Assign_Stmt
+                    (M2Lv (Status),
+                     New_Convert_Ov (New_Function_Call (Constr),
+                                     Std_File_Open_Status_Type));
+               end;
+
+            when Iir_Predefined_File_Close =>
+               declare
+                  File_Param : Iir;
+                  Constr : O_Assoc_List;
+               begin
+                  File_Param := Get_Actual (Param_Chain);
+                  if Get_Text_File_Flag (Get_Type (File_Param)) then
+                     Start_Association (Constr, Ghdl_Text_File_Close);
+                  else
+                     Start_Association (Constr, Ghdl_File_Close);
+                  end if;
+                  New_Association
+                    (Constr, Chap7.Translate_Expression (File_Param));
+                  New_Procedure_Call (Constr);
+               end;
+
+            when others =>
+               Ada.Text_IO.Put_Line
+                 ("translate_implicit_procedure_call: cannot handle "
+                  & Iir_Predefined_Functions'Image (Kind));
+               raise Internal_Error;
+         end case;
+      end Translate_Implicit_Procedure_Call;
+
+      function Do_Conversion (Conv : Iir; Expr : Iir; Src : Mnode)
+        return O_Enode
+      is
+         Constr : O_Assoc_List;
+         Conv_Info : Subprg_Info_Acc;
+         Res_Info : Type_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));
+
+                  Res_Info := Get_Info (Get_Return_Type (Imp));
+                  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 : Iir := Get_Parameter_Association_Chain (Stmt);
+         Nbr_Assoc : 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 : Iir;
+         Info : Subprg_Info_Acc;
+         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;
+         Atype_Info : Type_Info_Acc;
+         Formal_Info : Ortho_Info_Acc;
+         Val : O_Enode;
+         Param : Mnode;
+         Last_Individual : Natural;
+         Ptr : O_Lnode;
+         In_Conv : Iir;
+         Out_Conv : Iir;
+         Formal_Object_Kind : Object_Kind_Type;
+         Bounds : O_Enode;
+         Obj : Iir;
+      begin
+         Imp := Get_Implementation (Stmt);
+         Info := Get_Info (Imp);
+
+         --  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);
+            Base_Formal := Get_Base_Name (Formal);
+            Formal_Type := Get_Type (Formal);
+            Formal_Info := Get_Info (Base_Formal);
+            if Get_Kind (Base_Formal) = Iir_Kind_Signal_Interface_Declaration
+            then
+               Formal_Object_Kind := Mode_Signal;
+            else
+               Formal_Object_Kind := Mode_Value;
+            end if;
+            Ftype_Info := Get_Info (Formal_Type);
+
+            case Get_Kind (El) is
+               when Iir_Kind_Association_Element_Open =>
+                  Act := Get_Default_Value (Formal);
+                  In_Conv := Null_Iir;
+                  Out_Conv := Null_Iir;
+               when Iir_Kind_Association_Element_By_Expression =>
+                  Act := Get_Actual (El);
+                  In_Conv := Get_In_Conversion (El);
+                  Out_Conv := Get_Out_Conversion (El);
+               when Iir_Kind_Association_Element_By_Individual =>
+                  Actual_Type := Get_Actual_Type (El);
+                  if Formal_Info.Interface_Field /= O_Fnode_Null then
+                     --  A non-composite type cannot be associated by element.
+                     raise Internal_Error;
+                  end if;
+                  if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
+                     Chap3.Create_Array_Subtype (Actual_Type, True);
+                     Bounds := M2E (Chap3.Get_Array_Type_Bounds (Actual_Type));
+                     Param := Create_Temp (Ftype_Info, Mode_Value);
+                     Chap3.Translate_Object_Allocation
+                       (Param, Alloc_Stack, Formal_Type, Bounds);
+                  else
+                     Param := Create_Temp (Ftype_Info, Mode_Value);
+                     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 Out_Conv = Null_Iir then
+                  --  Arguments may be assigned if there is an in conversion,
+                  --  or no out conversion.
+                  --  We try to assign even OUT argument, to avoid
+                  --  uninitialized values.
+                  Ptr := New_Selected_Element
+                    (New_Obj (Res), Formal_Info.Interface_Field);
+                  Param := Lv2M (Ptr, Ftype_Info, Mode_Value);
+                  Chap7.Translate_Assign
+                    (Param,
+                     Do_Conversion (In_Conv, Act, Params (Pos)),
+                     In_Conv, --FIXME: may be null.
+                     Formal_Type);
+               end if;
+            elsif Ftype_Info.Type_Mode not in Type_Mode_By_Value then
+               --  Passed by reference.
+               case Get_Kind (Base_Formal) is
+                  when Iir_Kind_Constant_Interface_Declaration
+                    | Iir_Kind_File_Interface_Declaration =>
+                     --  No conversion here.
+                     E_Params (Pos) := Chap7.Translate_Expression
+                       (Act, Formal_Type);
+                  when Iir_Kind_Variable_Interface_Declaration
+                    | Iir_Kind_Signal_Interface_Declaration =>
+                     Param := Chap6.Translate_Name (Act);
+                     --  Atype may not have been set (eg: slice).
+                     Atype_Info := Get_Info (Actual_Type);
+                     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));
+                     end if;
+                  when others =>
+                     Error_Kind ("translate_procedure_call(2)", Formal);
+               end case;
+            end if;
+            if Base_Formal /= Formal then
+               --  Individual association.
+               if Ftype_Info.Type_Mode not in Type_Mode_By_Value then
+                  --  Not by-value actual already translated.
+                  Val := E_Params (Pos);
+               else
+                  --  By value association.
+                  Act := Get_Actual (El);
+                  if Get_Kind (Base_Formal)
+                    = Iir_Kind_Constant_Interface_Declaration
+                  then
+                     Val := Chap7.Translate_Expression (Act, Formal_Type);
+                  else
+                     Params (Pos) := Chap6.Translate_Name (Act);
+                     --  Since signals are passed by reference, they are not
+                     --  copied back, so do not stabilize them (furthermore,
+                     --  it is not possible to stabilize them).
+                     if Formal_Object_Kind = Mode_Value then
+                        Params (Pos) := Stabilize (Params (Pos));
+                     end if;
+                     Val := M2E (Params (Pos));
+                  end if;
+               end if;
+               --  Assign formal.
+               --  Change the formal variable so that it is the local variable
+               --  that will be passed to the subprogram.
+               declare
+                  Prev_Node : O_Dnode;
+               begin
+                  Prev_Node := Formal_Info.Interface_Node;
+                  --  We need a pointer since the interface is by reference.
+                  Formal_Info.Interface_Node :=
+                    M2Dp (Params (Last_Individual));
+                  Param := Chap6.Translate_Name (Formal);
+                  Formal_Info.Interface_Node := Prev_Node;
+               end;
+               Chap7.Translate_Assign (Param, Val, Act, Formal_Type);
+            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
+            declare
+               Prot_Info : Type_Info_Acc;
+            begin
+               Prot_Info := Get_Info (Get_Method_Type (Imp));
+               Chap2.Add_Subprg_Instance_Assoc
+                 (Constr, Info.Subprg_Instance,
+                  Prot_Info.Ortho_Type (Mode_Value),
+                  M2E (Chap6.Translate_Name (Obj)));
+            end;
+         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);
+            Base_Formal := Get_Base_Name (Formal);
+            Formal_Info := Get_Info (Base_Formal);
+            Formal_Type := Get_Type (Formal);
+            Ftype_Info := Get_Info (Formal_Type);
+
+            if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then
+               Last_Individual := Pos;
+               New_Association (Constr, M2E (Params (Pos)));
+            elsif Base_Formal /= Formal then
+               --  Individual association.
+               null;
+            elsif Formal_Info.Interface_Field = O_Fnode_Null then
+               if Ftype_Info.Type_Mode in Type_Mode_By_Value then
+                  --  Parameter passed by value.
+                  if E_Params (Pos) /= O_Enode_Null then
+                     Val := E_Params (Pos);
+                     raise Internal_Error;
+                  else
+                     case Get_Kind (El) is
+                        when Iir_Kind_Association_Element_Open =>
+                           Act := Get_Default_Value (Formal);
+                           In_Conv := Null_Iir;
+                        when Iir_Kind_Association_Element_By_Expression =>
+                           Act := Get_Actual (El);
+                           In_Conv := Get_In_Conversion (El);
+                        when others =>
+                           Error_Kind ("translate_procedure_call(2)", El);
+                     end case;
+                     case Get_Kind (Formal) is
+                        when Iir_Kind_Signal_Interface_Declaration =>
+                           Param := Chap6.Translate_Name (Act);
+                           --  This is a scalar.
+                           Val := M2E (Param);
+                        when others =>
+                           if In_Conv = Null_Iir then
+                              Val := Chap7.Translate_Expression
+                                (Act, Formal_Type);
+                           else
+                              Actual_Type := Get_Type (Act);
+                              Val := Do_Conversion
+                                (In_Conv,
+                                 Act,
+                                 E2M (Chap7.Translate_Expression (Act,
+                                                                  Actual_Type),
+                                      Get_Info (Actual_Type),
+                                      Mode_Value));
+                           end if;
+                     end case;
+                  end if;
+                  New_Association (Constr, Val);
+               else
+                  --  Parameter passed by ref, which was already computed.
+                  New_Association (Constr, E_Params (Pos));
+               end if;
+            end if;
+            El := Get_Chain (El);
+            Pos := Pos + 1;
+         end loop;
+
+         New_Procedure_Call (Constr);
+
+         --  Copy-out non-composite parameters.
+         El := Assoc_Chain;
+         Pos := 0;
+         while El /= Null_Iir loop
+            Formal := Get_Formal (El);
+            Base_Formal := Get_Base_Name (Formal);
+            Formal_Type := Get_Type (Formal);
+            Ftype_Info := Get_Info (Formal_Type);
+            Formal_Info := Get_Info (Base_Formal);
+            if Get_Kind (Base_Formal) = Iir_Kind_Variable_Interface_Declaration
+              and then Get_Mode (Base_Formal) in Iir_Out_Modes
+              and then Params (Pos) /= Mnode_Null
+            then
+               if Formal_Info.Interface_Field /= O_Fnode_Null then
+                  --  OUT parameters.
+                  Out_Conv := Get_Out_Conversion (El);
+                  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_Conv, --FIXME: use real expr.
+                                          Get_Type (Get_Actual (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));
+               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.
+      procedure Gen_Simple_Signal_Assign_Non_Composite (Targ : Mnode;
+                                                        Targ_Type : Iir;
+                                                        Val : O_Enode)
+      is
+         Type_Info : Type_Info_Acc;
+         Subprg : O_Dnode;
+         Conv : O_Tnode;
+         Assoc : O_Assoc_List;
+      begin
+         Type_Info := Get_Info (Targ_Type);
+         case Type_Info.Type_Mode is
+            when Type_Mode_B2 =>
+               Subprg := Ghdl_Signal_Simple_Assign_B2;
+               Conv := Ghdl_Bool_Type;
+            when Type_Mode_E8 =>
+               Subprg := Ghdl_Signal_Simple_Assign_E8;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_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 (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));
+               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_Prepare_Data_Composite (Val : O_Enode;
+--                                                          Targ_Type : Iir) is
+--       begin
+--          null;
+--       end Gen_Simple_Signal_Prepare_Data_Composite;
+
+--       function Gen_Simple_Signal_Update_Data_Array (Val : O_Enode;
+--                                                     Targ_Type : Iir;
+--                                                     Index : O_Lnode)
+--         return O_Enode
+--       is
+--          Base : O_Lnode;
+--       begin
+--          Base := Chap3.Get_Array_Base
+--            (New_Access_Element (Val), Targ_Type, Mode_Value);
+--          return New_Value (New_Indexed_Element (Base, New_Value (Index)));
+--       end Gen_Simple_Signal_Update_Data_Array;
+
+--       function Gen_Simple_Signal_Update_Data_Record
+--         (Val : O_Enode; Targ_Type : Iir; El : Iir_Element_Declaration)
+--         return O_Enode
+--       is
+--       begin
+--          return New_Value (New_Selected_Element
+--                            (New_Access_Element (Val),
+--                             Get_Info (El).Field_Node (Mode_Value)));
+--       end Gen_Simple_Signal_Update_Data_Record;
+
+      procedure Gen_Simple_Signal_Assign is new Foreach_Non_Composite
+        (Data_Type => O_Enode,
+         Composite_Data_Type => Mnode,
+         Do_Non_Composite => Gen_Simple_Signal_Assign_Non_Composite,
+         Prepare_Data_Array => Gen_Oenode_Prepare_Data_Composite,
+         Update_Data_Array => Gen_Oenode_Update_Data_Array,
+         Finish_Data_Array => Gen_Oenode_Finish_Data_Composite,
+         Prepare_Data_Record => Gen_Oenode_Prepare_Data_Composite,
+         Update_Data_Record => Gen_Oenode_Update_Data_Record,
+         Finish_Data_Record => Gen_Oenode_Finish_Data_Composite);
+
+      type Signal_Assign_Data is record
+         Expr : Mnode;
+         Reject : O_Dnode;
+         After : O_Dnode;
+      end record;
+
+      procedure Gen_Start_Signal_Assign_Non_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Signal_Assign_Data)
+      is
+         Type_Info : Type_Info_Acc;
+         Subprg : O_Dnode;
+         Conv : O_Tnode;
+         Assoc : O_Assoc_List;
+      begin
+         if Data.Expr = Mnode_Null then
+            --  Null transaction.
+            Start_Association (Assoc, Ghdl_Signal_Start_Assign_Null);
+            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
+                                                    Ghdl_Signal_Ptr));
+            New_Association (Assoc, New_Obj_Value (Data.Reject));
+            New_Association (Assoc, New_Obj_Value (Data.After));
+            New_Procedure_Call (Assoc);
+            return;
+         end if;
+
+         Type_Info := Get_Info (Targ_Type);
+         case Type_Info.Type_Mode is
+            when Type_Mode_B2 =>
+               Subprg := Ghdl_Signal_Start_Assign_B2;
+               Conv := Ghdl_Bool_Type;
+            when Type_Mode_E8 =>
+               Subprg := Ghdl_Signal_Start_Assign_E8;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_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 (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));
+               New_Procedure_Call (Assoc);
+               New_Else_Stmt (If_Blk);
+               Start_Association (Assoc, Subprg);
+               New_Association (Assoc, New_Obj_Value (Starg));
+               New_Association (Assoc, New_Obj_Value (Data.Reject));
+               New_Association (Assoc, New_Convert_Ov (M2E (V), Conv));
+               New_Association (Assoc, New_Obj_Value (Data.After));
+               New_Procedure_Call (Assoc);
+               Finish_If_Stmt (If_Blk);
+               Close_Temp;
+            end;
+         else
+            Start_Association (Assoc, Subprg);
+            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
+                                                    Ghdl_Signal_Ptr));
+            New_Association (Assoc, New_Obj_Value (Data.Reject));
+            New_Association (Assoc, New_Convert_Ov (M2E (Data.Expr), Conv));
+            New_Association (Assoc, New_Obj_Value (Data.After));
+            New_Procedure_Call (Assoc);
+         end if;
+      end Gen_Start_Signal_Assign_Non_Composite;
+
+      function Gen_Signal_Prepare_Data_Composite
+        (Targ : Mnode; Targ_Type : Iir; Val : Signal_Assign_Data)
+        return Signal_Assign_Data
+      is
+         pragma Unreferenced (Targ, Targ_Type);
+      begin
+         return Val;
+      end Gen_Signal_Prepare_Data_Composite;
+
+      function Gen_Signal_Prepare_Data_Record
+        (Targ : Mnode; Targ_Type : Iir; Val : Signal_Assign_Data)
+        return Signal_Assign_Data
+      is
+         pragma Unreferenced (Targ, Targ_Type);
+      begin
+         if Val.Expr = Mnode_Null then
+            return Val;
+         else
+            return Signal_Assign_Data'
+              (Expr => Stabilize (Val.Expr),
+               Reject => Val.Reject,
+               After => Val.After);
+         end if;
+      end Gen_Signal_Prepare_Data_Record;
+
+      function Gen_Signal_Update_Data_Array
+        (Val : Signal_Assign_Data;
+         Targ_Type : Iir;
+         Index : O_Dnode)
+        return Signal_Assign_Data
+      is
+         Res : Signal_Assign_Data;
+      begin
+         if Val.Expr = Mnode_Null then
+            --  Handle null transaction.
+            return Val;
+         end if;
+         Res := Signal_Assign_Data'
+           (Expr => Chap3.Index_Base (Chap3.Get_Array_Base (Val.Expr),
+                                      Targ_Type, New_Obj_Value (Index)),
+            Reject => Val.Reject,
+            After => Val.After);
+         return Res;
+      end Gen_Signal_Update_Data_Array;
+
+      function Gen_Signal_Update_Data_Record
+        (Val : Signal_Assign_Data;
+         Targ_Type : Iir;
+         El : Iir_Element_Declaration)
+        return Signal_Assign_Data
+      is
+         pragma Unreferenced (Targ_Type);
+         Res : Signal_Assign_Data;
+      begin
+         if Val.Expr = Mnode_Null then
+            --  Handle null transaction.
+            return Val;
+         end if;
+         Res := Signal_Assign_Data'
+           (Expr => Chap6.Translate_Selected_Element (Val.Expr, El),
+            Reject => Val.Reject,
+            After => Val.After);
+         return Res;
+      end Gen_Signal_Update_Data_Record;
+
+      procedure Gen_Signal_Finish_Data_Composite
+        (Data : in out Signal_Assign_Data)
+      is
+         pragma Unreferenced (Data);
+      begin
+         null;
+      end Gen_Signal_Finish_Data_Composite;
+
+      procedure Gen_Start_Signal_Assign is new Foreach_Non_Composite
+        (Data_Type => Signal_Assign_Data,
+         Composite_Data_Type => Signal_Assign_Data,
+         Do_Non_Composite => Gen_Start_Signal_Assign_Non_Composite,
+         Prepare_Data_Array => Gen_Signal_Prepare_Data_Composite,
+         Update_Data_Array => Gen_Signal_Update_Data_Array,
+         Finish_Data_Array => Gen_Signal_Finish_Data_Composite,
+         Prepare_Data_Record => Gen_Signal_Prepare_Data_Record,
+         Update_Data_Record => Gen_Signal_Update_Data_Record,
+         Finish_Data_Record => Gen_Signal_Finish_Data_Composite);
+
+      procedure Gen_Next_Signal_Assign_Non_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Signal_Assign_Data)
+      is
+         Type_Info : Type_Info_Acc;
+         Subprg : O_Dnode;
+         Conv : O_Tnode;
+         Assoc : O_Assoc_List;
+      begin
+         if Data.Expr = Mnode_Null then
+            --  Null transaction.
+            Start_Association (Assoc, Ghdl_Signal_Next_Assign_Null);
+            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
+                                                    Ghdl_Signal_Ptr));
+            New_Association (Assoc, New_Obj_Value (Data.After));
+            New_Procedure_Call (Assoc);
+            return;
+         end if;
+
+         Type_Info := Get_Info (Targ_Type);
+         case Type_Info.Type_Mode is
+            when Type_Mode_B2 =>
+               Subprg := Ghdl_Signal_Next_Assign_B2;
+               Conv := Ghdl_Bool_Type;
+            when Type_Mode_E8 =>
+               Subprg := Ghdl_Signal_Next_Assign_E8;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_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;
+         -- FIXME: check in range.
+         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 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_Composite,
+         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
+         Sub_Aggr : Mnode;
+         El : Iir;
+         Index_List : Iir_List;
+         Nbr_Dim : Natural;
+         Expr : Iir;
+      begin
+         Index_List := Get_Index_Subtype_List (Target_Type);
+         Nbr_Dim := Get_Nbr_Elements (Index_List);
+         El := Get_Association_Choices_Chain (Target);
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Choice_By_None =>
+                  Sub_Aggr := Chap3.Index_Base
+                    (Aggr, Target_Type, New_Obj_Value (Idx));
+               when others =>
+                  Error_Kind ("translate_signal_target_array_aggr", El);
+            end case;
+            Expr := Get_Associated (El);
+            if Dim = Nbr_Dim then
+               Translate_Signal_Target_Aggr
+                 (Sub_Aggr, Expr, Get_Element_Subtype (Target_Type));
+               if Get_Kind (El) = Iir_Kind_Choice_By_None then
+                  Inc_Var (Idx);
+               else
+                  raise Internal_Error;
+               end if;
+            else
+               Translate_Signal_Target_Array_Aggr
+                 (Sub_Aggr, Expr, Target_Type, Idx, Dim + 1);
+            end if;
+            El := Get_Chain (El);
+         end loop;
+      end Translate_Signal_Target_Array_Aggr;
+
+      procedure Translate_Signal_Target_Record_Aggr
+        (Aggr : Mnode; Target : Iir; Target_Type : Iir)
+      is
+         Aggr_El : Iir;
+         El_Decl : Iir_Element_Declaration;
+         Element : Iir_Element_Declaration;
+      begin
+         El_Decl := Get_Element_Declaration_Chain
+           (Get_Base_Type (Target_Type));
+         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 := El_Decl;
+                  El_Decl := Get_Chain (El_Decl);
+               when Iir_Kind_Choice_By_Name =>
+                  Element := Get_Name (Aggr_El);
+                  El_Decl := Null_Iir;
+               when others =>
+                  Error_Kind ("translate_signal_target_record_aggr", Aggr_El);
+            end case;
+            Translate_Signal_Target_Aggr
+              (Chap6.Translate_Selected_Element (Aggr, Element),
+               Get_Associated (Aggr_El), Get_Type (Element));
+            Aggr_El := Get_Chain (Aggr_El);
+         end loop;
+      end Translate_Signal_Target_Record_Aggr;
+
+      procedure Translate_Signal_Target_Aggr
+        (Aggr : Mnode; Target : Iir; Target_Type : Iir)
+      is
+         Src : Mnode;
+      begin
+         if Get_Kind (Target) = Iir_Kind_Aggregate then
+            declare
+               Idx : O_Dnode;
+               St_Aggr : Mnode;
+            begin
+               Open_Temp;
+               St_Aggr := Stabilize (Aggr);
+               case Get_Kind (Target_Type) is
+                  when Iir_Kinds_Array_Type_Definition =>
+                     Idx := Create_Temp (Ghdl_Index_Type);
+                     Init_Var (Idx);
+                     Translate_Signal_Target_Array_Aggr
+                       (St_Aggr, Target, Target_Type, Idx, 1);
+                  when Iir_Kind_Record_Type_Definition
+                    | Iir_Kind_Record_Subtype_Definition =>
+                     Translate_Signal_Target_Record_Aggr
+                       (St_Aggr, Target, Target_Type);
+                  when others =>
+                     Error_Kind ("translate_signal_target_aggr", Target_Type);
+               end case;
+               Close_Temp;
+            end;
+         else
+            Src := Chap6.Translate_Name (Target);
+            Chap3.Translate_Object_Copy (Aggr, M2E (Src), Target_Type);
+         end if;
+      end Translate_Signal_Target_Aggr;
+
+      procedure Translate_Signal_Assignment_Statement (Stmt : Iir)
+      is
+         Target : Iir;
+         Target_Type : Iir;
+         We : Iir_Waveform_Element;
+         Targ : Mnode;
+         Val : O_Enode;
+         Value : Iir;
+      begin
+         Target := Get_Target (Stmt);
+         Target_Type := Get_Type (Target);
+         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
+            Targ := Chap6.Translate_Name (Target);
+            if Get_Object_Kind (Targ) /= Mode_Signal then
+               raise Internal_Error;
+            end if;
+         end if;
+
+         We := Get_Waveform_Chain (Stmt);
+         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);
+         if Get_Chain (We) = Null_Iir
+           and then Get_Time (We) = Null_Iir
+           and then Get_Delay_Mechanism (Stmt) = Iir_Inertial_Delay
+           and then Get_Reject_Time_Expression (Stmt) = Null_Iir
+           and then Get_Kind (Value) /= Iir_Kind_Null_Literal
+         then
+            Val := Chap7.Translate_Expression (Value, Target_Type);
+            Gen_Simple_Signal_Assign (Targ, Target_Type, Val);
+            return;
+         end if;
+
+         --  General case.
+         declare
+            Var_Targ : Mnode;
+            Targ_Tinfo : Type_Info_Acc;
+         begin
+            Open_Temp;
+            Targ_Tinfo := Get_Info (Target_Type);
+            Var_Targ := Stabilize (Targ, True);
+
+            --  Translate the first waveform element.
+            declare
+               Reject_Time : O_Dnode;
+               After_Time : O_Dnode;
+               Del : Iir;
+               Rej : Iir;
+               Val : Mnode;
+               Data : Signal_Assign_Data;
+            begin
+               Open_Temp;
+               Reject_Time := Create_Temp (Std_Time_Type);
+               After_Time := Create_Temp (Std_Time_Type);
+               Del := Get_Time (We);
+               if Del = Null_Iir then
+                  New_Assign_Stmt
+                    (New_Obj (After_Time),
+                     New_Lit (New_Signed_Literal (Std_Time_Type, 0)));
+               else
+                  New_Assign_Stmt
+                    (New_Obj (After_Time),
+                     Chap7.Translate_Expression (Del, Time_Type_Definition));
+               end if;
+               case Get_Delay_Mechanism (Stmt) is
+                  when Iir_Transport_Delay =>
+                     New_Assign_Stmt
+                       (New_Obj (Reject_Time),
+                        New_Lit (New_Signed_Literal (Std_Time_Type, 0)));
+                  when Iir_Inertial_Delay =>
+                     Rej := Get_Reject_Time_Expression (Stmt);
+                     if Rej = Null_Iir then
+                        New_Assign_Stmt (New_Obj (Reject_Time),
+                                         New_Obj_Value (After_Time));
+                     else
+                        New_Assign_Stmt
+                          (New_Obj (Reject_Time), Chap7.Translate_Expression
+                           (Rej, Time_Type_Definition));
+                     end if;
+               end case;
+               if Get_Kind (Value) = Iir_Kind_Null_Literal then
+                  Val := Mnode_Null;
+               else
+                  Val := E2M (Chap7.Translate_Expression (Value, Target_Type),
+                              Targ_Tinfo, Mode_Value);
+                  Val := Stabilize (Val);
+               end if;
+               Data := Signal_Assign_Data'(Expr => Val,
+                                           Reject => Reject_Time,
+                                           After => After_Time);
+               Gen_Start_Signal_Assign (Var_Targ, Target_Type, Data);
+               Close_Temp;
+            end;
+
+            --  Translate other waveform elements.
+            We := Get_Chain (We);
+            while We /= Null_Iir loop
+               declare
+                  After_Time : O_Dnode;
+                  Val : Mnode;
+                  Data : Signal_Assign_Data;
+               begin
+                  Open_Temp;
+                  After_Time := Create_Temp (Std_Time_Type);
+                  New_Assign_Stmt
+                    (New_Obj (After_Time),
+                     Chap7.Translate_Expression (Get_Time (We),
+                                                 Time_Type_Definition));
+                  Value := Get_We_Value (We);
+                  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
+                  Assocs : Iir;
+                  Call : Iir_Procedure_Call;
+                  Imp : Iir;
+               begin
+                  Call := Get_Procedure_Call (Stmt);
+                  Assocs := Canon.Canon_Subprogram_Call (Call);
+                  Imp := Get_Implementation (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;
+   end Chap8;
+
+   package body Chap9 is
+      procedure Translate_Process_Statement (Proc : Iir; Base : Block_Info_Acc)
+      is
+         Inter_List : O_Inter_List;
+         Instance : O_Dnode;
+         Info : Proc_Info_Acc;
+      begin
+         Info := Get_Info (Proc);
+         Start_Procedure_Decl (Inter_List, Create_Identifier ("PROC"),
+                               O_Storage_Private);
+         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
+                             Base.Block_Decls_Ptr_Type);
+         Finish_Subprogram_Decl (Inter_List, Info.Process_Subprg);
+
+         Start_Subprogram_Body (Info.Process_Subprg);
+         Push_Local_Factory;
+         --  Push scope for architecture declarations.
+         Push_Scope (Base.Block_Decls_Type, Instance);
+         Chap8.Translate_Statements_Chain
+           (Get_Sequential_Statement_Chain (Proc));
+         Pop_Scope (Base.Block_Decls_Type);
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+      end Translate_Process_Statement;
+
+      procedure Translate_Implicit_Guard_Signal
+        (Guard : Iir; Base : Block_Info_Acc)
+      is
+         Info : Object_Info_Acc;
+         Inter_List : O_Inter_List;
+         Instance : O_Dnode;
+         Guard_Expr : Iir;
+      begin
+         Guard_Expr := Get_Guard_Expression (Guard);
+         --  Create the subprogram to compute the value of GUARD.
+         Info := Get_Info (Guard);
+         Start_Function_Decl (Inter_List, Create_Identifier ("_GUARD_PROC"),
+                              O_Storage_Private, Std_Boolean_Type_Node);
+         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
+                             Base.Block_Decls_Ptr_Type);
+         Finish_Subprogram_Decl (Inter_List, Info.Object_Function);
+
+         Start_Subprogram_Body (Info.Object_Function);
+         Push_Local_Factory;
+         Push_Scope (Base.Block_Decls_Type, Instance);
+         Open_Temp;
+         New_Return_Stmt (Chap7.Translate_Expression (Guard_Expr));
+         Close_Temp;
+         Pop_Scope (Base.Block_Decls_Type);
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+      end Translate_Implicit_Guard_Signal;
+
+      procedure Translate_Component_Instantiation_Statement (Inst : Iir)
+      is
+         Comp : Iir;
+         Field : O_Fnode;
+         Info : Block_Info_Acc;
+         Comp_Info : Comp_Info_Acc;
+      begin
+         Comp := Get_Instantiated_Unit (Inst);
+         Info := Add_Info (Inst, Kind_Block);
+         if Get_Kind (Comp) = Iir_Kind_Component_Declaration then
+            --  Via a component declaration.
+            Comp_Info := Get_Info (Comp);
+            Field := Add_Instance_Factory_Field
+              (Create_Identifier_Without_Prefix (Inst),
+               Comp_Info.Comp_Type);
+            Info.Block_Decls_Type := Comp_Info.Comp_Type;
+            Info.Block_Decls_Ptr_Type := Comp_Info.Comp_Ptr_Type;
+            Info.Block_Parent_Field := Field;
+         else
+            --  Direct instantiation.
+            Info.Block_Parent_Field := Add_Instance_Factory_Field
+              (Create_Identifier_Without_Prefix (Inst),
+               Rtis.Ghdl_Component_Link_Type);
+            Info.Block_Decls_Type := O_Tnode_Null;
+         end if;
+      end Translate_Component_Instantiation_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 =>
+                  declare
+                     Mark : Id_Mark_Type;
+                     Info : Ortho_Info_Acc;
+                     Itype : O_Tnode;
+                     Field : O_Fnode;
+                  begin
+                     Push_Identifier_Prefix (Mark, Get_Identifier (El));
+                     --  Start child record.
+                     Push_Instance_Factory (O_Tnode_Null);
+                     Info := Add_Info (El, Kind_Process);
+                     Chap4.Translate_Declaration_Chain (El);
+                     Pop_Instance_Factory (Itype);
+                     New_Type_Decl (Create_Identifier ("INSTTYPE"), Itype);
+                     Pop_Identifier_Prefix (Mark);
+                     --  Create a field in the parent record.
+                     Field := Add_Instance_Factory_Field
+                       (Create_Identifier_Without_Prefix (El), Itype);
+                     --  Set info in child record.
+                     Info.Process_Decls_Type := Itype;
+                     Info.Process_Parent_Field := Field;
+                  end;
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  Translate_Component_Instantiation_Statement (El);
+               when Iir_Kind_Block_Statement =>
+                  declare
+                     Info : Block_Info_Acc;
+                     Hdr : Iir_Block_Header;
+                     Guard : Iir;
+                     Mark : Id_Mark_Type;
+                     Field : O_Fnode;
+                  begin
+                     Push_Identifier_Prefix (Mark, Get_Identifier (El));
+
+                     Info := Add_Info (El, Kind_Block);
+                     Chap1.Start_Block_Decl (El);
+                     Push_Instance_Factory (Info.Block_Decls_Type);
+
+                     Guard := Get_Guard_Decl (El);
+                     if Guard /= Null_Iir then
+                        Chap4.Translate_Declaration (Guard);
+                     end if;
+
+                     --  generics, ports.
+                     Hdr := Get_Block_Header (El);
+                     if Hdr /= Null_Iir then
+                        Chap4.Translate_Generic_Chain (Hdr);
+                        Chap4.Translate_Port_Chain (Hdr);
+                     end if;
+
+                     Chap9.Translate_Block_Declarations (El, Origin);
+
+                     Pop_Instance_Factory (Info.Block_Decls_Type);
+                     Pop_Identifier_Prefix (Mark);
+
+                     --  Create a field in the parent record.
+                     Field := Add_Instance_Factory_Field
+                       (Create_Identifier_Without_Prefix (El),
+                        Info.Block_Decls_Type);
+                     --  Set info in child record.
+                     Info.Block_Parent_Field := Field;
+                  end;
+               when Iir_Kind_Generate_Statement =>
+                  declare
+                     Info : Block_Info_Acc;
+                     Mark : Id_Mark_Type;
+                     Scheme : Iir;
+                     Iter_Type : Iir;
+                     It_Info : Ortho_Info_Acc;
+                  begin
+                     Scheme := Get_Generation_Scheme (El);
+
+                     Push_Identifier_Prefix (Mark, Get_Identifier (El));
+
+                     if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                        Iter_Type := Get_Type (Scheme);
+                        Chap3.Translate_Object_Subtype (Scheme, True);
+                     end if;
+
+                     Info := Add_Info (El, Kind_Block);
+                     Chap1.Start_Block_Decl (El);
+                     Push_Instance_Factory (Info.Block_Decls_Type);
+
+                     --  Add a parent field in the current instance.
+                     Info.Block_Origin_Field := Add_Instance_Factory_Field
+                       (Get_Identifier ("ORIGIN"),
+                        Get_Info (Origin).Block_Decls_Ptr_Type);
+
+                     --  Iterator.
+                     if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                        Info.Block_Configured_Field :=
+                          Add_Instance_Factory_Field
+                          (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type);
+                        It_Info := Add_Info (Scheme, Kind_Iterator);
+                        It_Info.Iterator_Var := Create_Var
+                          (Create_Var_Identifier (Scheme),
+                           Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type
+                           (Mode_Value));
+                     end if;
+
+                     Chap9.Translate_Block_Declarations (El, El);
+
+                     Pop_Instance_Factory (Info.Block_Decls_Type);
+
+                     if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                        --  Create array type of block_decls_type
+                        Info.Block_Decls_Array_Type := New_Array_Type
+                          (Info.Block_Decls_Type, Ghdl_Index_Type);
+                        New_Type_Decl (Create_Identifier ("INSTARRTYPE"),
+                                       Info.Block_Decls_Array_Type);
+                        --  Create access to the array type.
+                        Info.Block_Decls_Array_Ptr_Type := New_Access_Type
+                          (Info.Block_Decls_Array_Type);
+                        New_Type_Decl (Create_Identifier ("INSTARRPTR"),
+                                       Info.Block_Decls_Array_Ptr_Type);
+                        --  Add a field in parent record
+                        Info.Block_Parent_Field := Add_Instance_Factory_Field
+                          (Create_Identifier_Without_Prefix (El),
+                           Info.Block_Decls_Array_Ptr_Type);
+                     else
+                        --  Create an access field in the parent record.
+                        Info.Block_Parent_Field := Add_Instance_Factory_Field
+                          (Create_Identifier_Without_Prefix (El),
+                           Info.Block_Decls_Ptr_Type);
+                     end if;
+
+                     Pop_Identifier_Prefix (Mark);
+                  end;
+               when others =>
+                  Error_Kind ("translate_block_declarations", El);
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end Translate_Block_Declarations;
+
+      procedure Translate_Component_Instantiation_Subprogram
+        (Stmt : Iir; Base : Block_Info_Acc)
+      is
+         procedure Set_Component_Link (Ref_Type : O_Tnode;
+                                       Comp_Field : O_Fnode)
+         is
+         begin
+            New_Assign_Stmt
+              (New_Selected_Element
+               (New_Selected_Element (Get_Instance_Ref (Ref_Type), Comp_Field),
+                Rtis.Ghdl_Component_Link_Stmt),
+               New_Lit (Rtis.Get_Context_Rti (Stmt)));
+         end Set_Component_Link;
+
+         Info : Block_Info_Acc;
+
+         Comp : Iir;
+         Comp_Info : Comp_Info_Acc;
+         Parent_Info : Block_Info_Acc;
+         Inter_List : O_Inter_List;
+         Instance : O_Dnode;
+      begin
+         Info := Get_Info (Stmt);
+         Start_Procedure_Decl (Inter_List, Create_Identifier ("ELAB"),
+                               O_Storage_Private);
+         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
+                             Base.Block_Decls_Ptr_Type);
+         Finish_Subprogram_Decl (Inter_List, Info.Block_Elab_Subprg);
+
+         Start_Subprogram_Body (Info.Block_Elab_Subprg);
+         Push_Local_Factory;
+         Push_Scope (Base.Block_Decls_Type, Instance);
+
+         New_Debug_Line_Stmt (Get_Line_Number (Stmt));
+
+         Parent_Info := Get_Info (Get_Parent (Stmt));
+         Comp := Get_Instantiated_Unit (Stmt);
+         if Get_Kind (Comp) /= Iir_Kind_Component_Declaration then
+            --  This is a direct instantiation.
+            Set_Component_Link (Parent_Info.Block_Decls_Type,
+                                Info.Block_Parent_Field);
+            Translate_Entity_Instantiation (Comp, Stmt, Stmt, Null_Iir);
+         else
+            Comp_Info := Get_Info (Comp);
+            Push_Scope (Comp_Info.Comp_Type, Info.Block_Parent_Field,
+                        Parent_Info.Block_Decls_Type);
+
+            --  Set the link from component declaration to component
+            --  instantiation statement.
+            Set_Component_Link (Comp_Info.Comp_Type, Comp_Info.Comp_Link);
+
+            Chap5.Elab_Map_Aspect (Stmt, Comp);
+
+            Pop_Scope (Comp_Info.Comp_Type);
+         end if;
+         Pop_Scope (Base.Block_Decls_Type);
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+      end Translate_Component_Instantiation_Subprogram;
+
+      --  Translate concurrent statements into subprograms.
+      procedure Translate_Block_Subprograms (Block : Iir; Base_Block : Iir)
+      is
+         Stmt : Iir;
+         Mark : Id_Mark_Type;
+         Block_Info : Block_Info_Acc;
+         Base_Info : Block_Info_Acc;
+      begin
+         Base_Info := Get_Info (Base_Block);
+
+         Chap4.Translate_Declaration_Chain_Subprograms (Block, Base_Block);
+
+         Block_Info := Get_Info (Block);
+         Stmt := Get_Concurrent_Statement_Chain (Block);
+         while Stmt /= Null_Iir loop
+            Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+            case Get_Kind (Stmt) is
+               when Iir_Kind_Process_Statement
+                 | Iir_Kind_Sensitized_Process_Statement =>
+                  declare
+                     Info : Proc_Info_Acc;
+                  begin
+                     Info := Get_Info (Stmt);
+                     Push_Scope (Info.Process_Decls_Type,
+                                 Info.Process_Parent_Field,
+                                 Block_Info.Block_Decls_Type);
+                     Chap4.Translate_Declaration_Chain_Subprograms
+                       (Stmt, Base_Block);
+                     Translate_Process_Statement (Stmt, Base_Info);
+                     Pop_Scope (Info.Process_Decls_Type);
+                  end;
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  Chap4.Translate_Association_Subprograms
+                    (Get_Port_Map_Aspect_Chain (Stmt),
+                     Base_Block,
+                     Get_Entity_From_Entity_Aspect
+                     (Get_Instantiated_Unit (Stmt)));
+                  Translate_Component_Instantiation_Subprogram
+                    (Stmt, Base_Info);
+               when Iir_Kind_Block_Statement =>
+                  declare
+                     Info : Block_Info_Acc;
+                     Guard : Iir;
+                     Hdr : Iir;
+                  begin
+                     Info := Get_Info (Stmt);
+                     Push_Scope (Info.Block_Decls_Type,
+                                 Info.Block_Parent_Field,
+                                 Block_Info.Block_Decls_Type);
+                     Guard := Get_Guard_Decl (Stmt);
+                     if Guard /= Null_Iir then
+                        Translate_Implicit_Guard_Signal (Guard, Base_Info);
+                     end if;
+                     Hdr := Get_Block_Header (Stmt);
+                     if Hdr /= Null_Iir then
+                        Chap4.Translate_Association_Subprograms
+                          (Get_Port_Map_Aspect_Chain (Hdr),
+                           Base_Block, Null_Iir);
+                     end if;
+                     Translate_Block_Subprograms (Stmt, Base_Block);
+                     Pop_Scope (Info.Block_Decls_Type);
+                  end;
+               when Iir_Kind_Generate_Statement =>
+                  declare
+                     Info : Block_Info_Acc;
+                     Prev_Instance : Chap2.Subprg_Instance_Stack;
+                  begin
+                     Info := Get_Info (Stmt);
+                     Chap2.Save_Subprg_Instance (Prev_Instance);
+                     Chap2.Push_Subprg_Instance (Info.Block_Decls_Type,
+                                                 Info.Block_Decls_Ptr_Type,
+                                                 Wki_Instance);
+                     Push_Scope_Via_Field_Ptr (Base_Info.Block_Decls_Type,
+                                               Info.Block_Origin_Field,
+                                               Info.Block_Decls_Type);
+                     Translate_Block_Subprograms (Stmt, Stmt);
+                     Pop_Scope (Base_Info.Block_Decls_Type);
+                     Chap2.Pop_Subprg_Instance (Wki_Instance);
+                     Chap2.Restore_Subprg_Instance (Prev_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_List (List : Iir_List)
+      is
+         El : Iir;
+         Atype : Iir;
+         Info : Type_Info_Acc;
+      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;
+            loop
+               Atype := Null_Iir;
+               case Get_Kind (El) is
+                  when Iir_Kind_Selected_Element
+                    | Iir_Kind_Indexed_Name =>
+                     El := Get_Prefix (El);
+                  when Iir_Kind_Slice_Name =>
+                     Atype := Get_Type (El);
+                     El := Get_Prefix (El);
+                  when Iir_Kind_Object_Alias_Declaration =>
+                     El := Get_Name (El);
+                  when Iir_Kind_Stable_Attribute
+                    | Iir_Kind_Quiet_Attribute
+                    | Iir_Kind_Delayed_Attribute
+                    | Iir_Kind_Transaction_Attribute =>
+                     El := Get_Prefix (El);
+                  when Iir_Kind_Signal_Declaration
+                    | Iir_Kind_Signal_Interface_Declaration
+                    | Iir_Kind_Guard_Signal_Declaration =>
+                     exit;
+                  when others =>
+                     Error_Kind ("destroy_types_in_list", El);
+               end case;
+               if Atype /= Null_Iir
+                 and then Is_Anonymous_Type_Definition (Atype)
+               then
+                  Info := Get_Info (Atype);
+                  if Info /= null then
+                     Free_Type_Info (Info, False);
+                     Clear_Info (Atype);
+                  end if;
+               end if;
+            end loop;
+         end loop;
+      end Destroy_Types_In_List;
+
+      --  PROC: the process to be elaborated
+      --  BLOCK_INFO: info for the block containing the process
+      --  BASE_INFO: info for the global block
+      procedure Elab_Process (Proc : Iir;
+                              Block_Info : Block_Info_Acc;
+                              Base_Info : Block_Info_Acc)
+      is
+         Is_Sensitized : Boolean;
+         Subprg : O_Dnode;
+         Constr : O_Assoc_List;
+         Info : Proc_Info_Acc;
+         List : Iir_List;
+         Final : Boolean;
+      begin
+         New_Debug_Line_Stmt (Get_Line_Number (Proc));
+
+         Is_Sensitized :=
+           Get_Kind (Proc) = Iir_Kind_Sensitized_Process_Statement;
+         Info := Get_Info (Proc);
+
+         --  Set instance name.
+         Push_Scope (Info.Process_Decls_Type,
+                     Info.Process_Parent_Field,
+                     Block_Info.Block_Decls_Type);
+
+         --  Register process.
+         if Is_Sensitized then
+            if Get_Postponed_Flag (Proc) then
+               Subprg := Ghdl_Postponed_Sensitized_Process_Register;
+            else
+               Subprg := Ghdl_Sensitized_Process_Register;
+            end if;
+         else
+            if Get_Postponed_Flag (Proc) then
+               Subprg := Ghdl_Postponed_Process_Register;
+            else
+               Subprg := Ghdl_Process_Register;
+            end if;
+         end if;
+
+         Start_Association (Constr, Subprg);
+         New_Association
+           (Constr, New_Unchecked_Address
+            (Get_Instance_Ref (Base_Info.Block_Decls_Type), Ghdl_Ptr_Type));
+         New_Association
+           (Constr,
+            New_Lit (New_Subprogram_Address (Info.Process_Subprg,
+                                             Ghdl_Ptr_Type)));
+         Rtis.Associate_Rti_Context (Constr, Proc);
+--          New_Association
+--            (Constr,
+--             New_Address (New_Selected_Element
+--                          (Get_Instance_Ref (Info.Process_Decls_Type),
+--                           Info.Process_Name),
+--                          Ghdl_Instance_Name_Acc));
+         New_Procedure_Call (Constr);
+
+         --  First elaborate declarations since a driver may depend on
+         --  an alias declaration.
+         Chap4.Elab_Declaration_Chain (Proc, Final);
+
+         List := Get_Driver_List (Proc);
+         Destroy_Types_In_List (List);
+         Register_Signal_List (List, Ghdl_Process_Add_Driver);
+
+         if Is_Sensitized then
+            List := Get_Sensitivity_List (Proc);
+            Destroy_Types_In_List (List);
+            Register_Signal_List (List, Ghdl_Process_Add_Sensitivity);
+         end if;
+
+         Pop_Scope (Info.Process_Decls_Type);
+      end Elab_Process;
+
+      procedure Elab_Implicit_Guard_Signal
+        (Block : Iir_Block_Statement; Block_Info : Block_Info_Acc)
+      is
+         Guard : Iir;
+         Type_Info : Type_Info_Acc;
+         Info : Object_Info_Acc;
+         Constr : O_Assoc_List;
+      begin
+         --  Create the guard signal.
+         Guard := Get_Guard_Decl (Block);
+         Info := Get_Info (Guard);
+         Type_Info := Get_Info (Get_Type (Guard));
+         Start_Association (Constr, Ghdl_Signal_Create_Guard);
+         New_Association
+           (Constr, New_Unchecked_Address
+            (Get_Instance_Ref (Block_Info.Block_Decls_Type), Ghdl_Ptr_Type));
+         New_Association
+           (Constr,
+            New_Lit (New_Subprogram_Address (Info.Object_Function,
+                                             Ghdl_Ptr_Type)));
+--         New_Association (Constr, Chap6.Get_Instance_Name_Ref (Block));
+         New_Assign_Stmt (Get_Var (Info.Object_Var),
+                          New_Convert_Ov (New_Function_Call (Constr),
+                                          Type_Info.Ortho_Type (Mode_Signal)));
+
+         --  Register sensitivity list of the guard signal.
+         Register_Signal_List (Get_Guard_Sensitivity_List (Guard),
+                               Ghdl_Signal_Guard_Dependence);
+      end Elab_Implicit_Guard_Signal;
+
+      procedure Translate_Entity_Instantiation
+        (Aspect : Iir; Mapping : Iir; Parent : Iir; Config_Override : Iir)
+      is
+         Entity_Unit : Iir_Design_Unit;
+         Config : Iir;
+         Arch : Iir;
+         Entity : Iir_Entity_Declaration;
+         Entity_Info : Block_Info_Acc;
+         Arch_Info : Block_Info_Acc;
+
+         Instance_Size : O_Dnode;
+         Arch_Elab : O_Dnode;
+         Arch_Config : O_Dnode;
+         Arch_Config_Type : O_Tnode;
+
+         Var_Sub : O_Dnode;
+      begin
+         --  Extract entity, architecture and configuration from
+         --  binding aspect.
+         case Get_Kind (Aspect) is
+            when Iir_Kind_Entity_Aspect_Entity =>
+               Entity_Unit := 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
+                    (Get_Library_Unit (Entity_Unit));
+               end if;
+               Config := Null_Iir;
+            when Iir_Kind_Entity_Aspect_Configuration =>
+               Config := Get_Library_Unit (Get_Configuration (Aspect));
+               Entity_Unit := 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 := Get_Library_Unit (Entity_Unit);
+         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_Declaration
+            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 : String :=
+                 Image_Identifier (Get_Library (Get_Design_File (Entity_Unit)))
+                 & "__" & Image_Identifier (Entity) & "__"
+                 & Get_Arch_Name & "__";
+               Sub_Inter : O_Inter_List;
+               Arg : O_Dnode;
+            begin
+               if Arch_Info = null then
+                  New_Const_Decl
+                    (Instance_Size, Get_Identifier (Str & "INSTSIZE"),
+                     O_Storage_External, Ghdl_Index_Type);
+
+                  Start_Procedure_Decl
+                    (Sub_Inter, Get_Identifier (Str & "ELAB"),
+                     O_Storage_External);
+                  New_Interface_Decl (Sub_Inter, Arg, Wki_Instance,
+                                      Entity_Info.Block_Decls_Ptr_Type);
+                  Finish_Subprogram_Decl (Sub_Inter, Arch_Elab);
+               end if;
+
+               if Config = Null_Iir then
+                  Start_Procedure_Decl
+                    (Sub_Inter, Get_Identifier (Str & "DEFAULT_CONFIG"),
+                     O_Storage_External);
+                  New_Interface_Decl (Sub_Inter, Arg, Wki_Instance,
+                                      Entity_Info.Block_Decls_Ptr_Type);
+                  Finish_Subprogram_Decl (Sub_Inter, Arch_Config);
+
+                  Arch_Config_Type := Entity_Info.Block_Decls_Ptr_Type;
+               end if;
+            end;
+         end if;
+
+         if Arch_Info = null then
+            if Config /= Null_Iir then
+               --  Architecture is unknown, but we know how to configure
+               --  the block inside it.
+               raise Internal_Error;
+            end if;
+         else
+            Instance_Size := Arch_Info.Block_Instance_Size;
+            Arch_Elab := Arch_Info.Block_Elab_Subprg;
+            if Config /= Null_Iir then
+               Arch_Config := Get_Info (Config).Config_Subprg;
+               Arch_Config_Type := Arch_Info.Block_Decls_Ptr_Type;
+            end if;
+         end if;
+
+         --  Create the instance variable and allocate storage.
+         New_Var_Decl (Var_Sub, Get_Identifier ("SUB_INSTANCE"),
+                       O_Storage_Local, Entity_Info.Block_Decls_Ptr_Type);
+
+         New_Assign_Stmt
+           (New_Obj (Var_Sub),
+            Gen_Alloc (Alloc_System, New_Obj_Value (Instance_Size),
+                       Entity_Info.Block_Decls_Ptr_Type));
+
+         --  1.5) link instance.
+         declare
+            procedure Set_Links (Ref_Type : O_Tnode; Link_Field : O_Fnode)
+            is
+            begin
+               --  Set the ghdl_component_link_instance field.
+               New_Assign_Stmt
+                 (New_Selected_Element
+                  (New_Selected_Element (Get_Instance_Ref (Ref_Type),
+                                         Link_Field),
+                   Rtis.Ghdl_Component_Link_Instance),
+                  New_Address (New_Selected_Acc_Value
+                               (New_Obj (Var_Sub),
+                                Entity_Info.Block_Link_Field),
+                               Rtis.Ghdl_Entity_Link_Acc));
+               --  Set the ghdl_entity_link_parent field.
+               New_Assign_Stmt
+                 (New_Selected_Element
+                  (New_Selected_Acc_Value (New_Obj (Var_Sub),
+                                           Entity_Info.Block_Link_Field),
+                   Rtis.Ghdl_Entity_Link_Parent),
+                  New_Address
+                  (New_Selected_Element (Get_Instance_Ref (Ref_Type),
+                                         Link_Field),
+                   Rtis.Ghdl_Component_Link_Acc));
+            end Set_Links;
+         begin
+            case Get_Kind (Parent) is
+               when Iir_Kind_Component_Declaration =>
+                  --  Instantiation via a component declaration.
+                  declare
+                     Comp_Info : Comp_Info_Acc;
+                  begin
+                     Comp_Info := Get_Info (Parent);
+                     Set_Links (Comp_Info.Comp_Type, Comp_Info.Comp_Link);
+                  end;
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  --  Direct instantiation.
+                  declare
+                     Parent_Info : Block_Info_Acc;
+                  begin
+                     Parent_Info := Get_Info (Get_Parent (Parent));
+                     Set_Links (Parent_Info.Block_Decls_Type,
+                                Get_Info (Parent).Block_Parent_Field);
+                  end;
+               when others =>
+                  Error_Kind ("translate_entity_instantiation(1)", Parent);
+            end case;
+         end;
+
+         Push_Scope (Entity_Info.Block_Decls_Type, Var_Sub);
+         Chap5.Elab_Map_Aspect (Mapping, Entity);
+         Pop_Scope (Entity_Info.Block_Decls_Type);
+
+         --  3) Elab instance.
+         declare
+            Assoc : O_Assoc_List;
+         begin
+            Start_Association (Assoc, Arch_Elab);
+            New_Association (Assoc, New_Obj_Value (Var_Sub));
+            New_Procedure_Call (Assoc);
+         end;
+
+         --  5) Configure
+         declare
+            Assoc : O_Assoc_List;
+         begin
+            Start_Association (Assoc, Arch_Config);
+            New_Association (Assoc, New_Convert_Ov (New_Obj_Value (Var_Sub),
+                                                    Arch_Config_Type));
+            New_Procedure_Call (Assoc);
+         end;
+      end Translate_Entity_Instantiation;
+
+      procedure Elab_Conditionnal_Generate_Statement
+        (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
+      is
+         Scheme : Iir;
+         Info : Block_Info_Acc;
+         Var : O_Dnode;
+         Blk : O_If_Block;
+         V : O_Lnode;
+         Parent_Info : Block_Info_Acc;
+         Base_Info : Block_Info_Acc;
+      begin
+         Parent_Info := Get_Info (Parent);
+         Base_Info := Get_Info (Base_Block);
+         Scheme := Get_Generation_Scheme (Stmt);
+         Info := Get_Info (Stmt);
+         Open_Temp;
+
+         Var := Create_Temp (Info.Block_Decls_Ptr_Type);
+         Start_If_Stmt (Blk, Chap7.Translate_Expression (Scheme));
+         New_Assign_Stmt
+           (New_Obj (Var),
+            Gen_Alloc (Alloc_System,
+                       New_Lit (New_Sizeof (Info.Block_Decls_Type,
+                                            Ghdl_Index_Type)),
+                       Info.Block_Decls_Ptr_Type));
+         New_Else_Stmt (Blk);
+         New_Assign_Stmt
+           (New_Obj (Var),
+            New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)));
+         Finish_If_Stmt (Blk);
+
+         --  Add a link to child in parent.
+         V := Get_Instance_Ref (Parent_Info.Block_Decls_Type);
+         V := New_Selected_Element (V, Info.Block_Parent_Field);
+         New_Assign_Stmt (V, New_Obj_Value (Var));
+
+         Start_If_Stmt
+           (Blk,
+            New_Compare_Op
+            (ON_Neq,
+             New_Obj_Value (Var),
+             New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)),
+             Ghdl_Bool_Type));
+         --  Add a link to parent in child.
+         New_Assign_Stmt
+           (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field),
+            Get_Instance_Access (Base_Block));
+         --  Elaborate block
+         Push_Scope (Info.Block_Decls_Type, Var);
+         Push_Scope_Via_Field_Ptr (Base_Info.Block_Decls_Type,
+                                   Info.Block_Origin_Field,
+                                   Info.Block_Decls_Type);
+         Elab_Block_Declarations (Stmt, Stmt);
+         Pop_Scope (Base_Info.Block_Decls_Type);
+         Pop_Scope (Info.Block_Decls_Type);
+         Finish_If_Stmt (Blk);
+         Close_Temp;
+      end Elab_Conditionnal_Generate_Statement;
+
+      procedure Elab_Iterative_Generate_Statement
+        (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
+      is
+         Scheme : Iir;
+         Iter_Type : Iir;
+         Iter_Base_Type : Iir;
+         Iter_Type_Info : Type_Info_Acc;
+         Info : Block_Info_Acc;
+         Var_Inst : O_Dnode;
+         Var_I : O_Dnode;
+         Label : O_Snode;
+         V : O_Lnode;
+         Var : O_Dnode;
+         Parent_Info : Block_Info_Acc;
+         Base_Info : Block_Info_Acc;
+         Range_Ptr : O_Dnode;
+      begin
+         Parent_Info := Get_Info (Parent);
+         Base_Info := Get_Info (Base_Block);
+
+         Scheme := Get_Generation_Scheme (Stmt);
+         Iter_Type := Get_Type (Scheme);
+         Iter_Base_Type := Get_Base_Type (Iter_Type);
+         Iter_Type_Info := Get_Info (Iter_Base_Type);
+         Info := Get_Info (Stmt);
+
+         Open_Temp;
+
+         --  Evaluate iterator range.
+         Chap3.Elab_Object_Subtype (Iter_Type);
+
+         Range_Ptr := Create_Temp_Ptr
+           (Iter_Type_Info.T.Range_Ptr_Type,
+            Get_Var (Get_Info (Iter_Type).T.Range_Var));
+
+         --  Allocate instances.
+         Var_Inst := Create_Temp (Info.Block_Decls_Array_Ptr_Type);
+         New_Assign_Stmt
+           (New_Obj (Var_Inst),
+            Gen_Alloc
+            (Alloc_System,
+             New_Dyadic_Op (ON_Mul_Ov,
+                            New_Value_Selected_Acc_Value
+                            (New_Obj (Range_Ptr),
+                             Iter_Type_Info.T.Range_Length),
+                            New_Lit (New_Sizeof (Info.Block_Decls_Type,
+                                                 Ghdl_Index_Type))),
+             Info.Block_Decls_Array_Ptr_Type));
+
+         --  Add a link to child in parent.
+         V := Get_Instance_Ref (Parent_Info.Block_Decls_Type);
+         V := New_Selected_Element (V, Info.Block_Parent_Field);
+         New_Assign_Stmt (V, New_Obj_Value (Var_Inst));
+
+         --  Start loop.
+         Var_I := Create_Temp (Ghdl_Index_Type);
+         Init_Var (Var_I);
+         Start_Loop_Stmt (Label);
+         Gen_Exit_When
+           (Label,
+            New_Compare_Op (ON_Eq,
+                            New_Obj_Value (Var_I),
+                            New_Value_Selected_Acc_Value
+                            (New_Obj (Range_Ptr),
+                             Iter_Type_Info.T.Range_Length),
+                            Ghdl_Bool_Type));
+
+         Var := Create_Temp_Ptr
+           (Info.Block_Decls_Ptr_Type,
+            New_Indexed_Element (New_Acc_Value (New_Obj (Var_Inst)),
+                                 New_Obj_Value (Var_I)));
+         --  Add a link to parent in child.
+         New_Assign_Stmt
+           (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field),
+            Get_Instance_Access (Base_Block));
+         --  Mark the block as not (yet) configured.
+         New_Assign_Stmt
+           (New_Selected_Acc_Value (New_Obj (Var),
+                                    Info.Block_Configured_Field),
+            New_Lit (Ghdl_Bool_False_Node));
+
+         --  Elaborate block
+         Push_Scope (Info.Block_Decls_Type, Var);
+         Push_Scope_Via_Field_Ptr (Base_Info.Block_Decls_Type,
+                                   Info.Block_Origin_Field,
+                                   Info.Block_Decls_Type);
+         --  Set iterator value.
+         --  FIXME: this could be slighly optimized...
+         declare
+            Val : O_Dnode;
+            If_Blk : O_If_Block;
+         begin
+            Val := Create_Temp (Iter_Type_Info.Ortho_Type (Mode_Value));
+            Start_If_Stmt
+              (If_Blk,
+               New_Compare_Op (ON_Eq,
+                               New_Value_Selected_Acc_Value
+                               (New_Obj (Range_Ptr),
+                                Iter_Type_Info.T.Range_Dir),
+                               New_Lit (Ghdl_Dir_To_Node),
+                               Ghdl_Bool_Type));
+            New_Assign_Stmt (New_Obj (Val), New_Value_Selected_Acc_Value
+                             (New_Obj (Range_Ptr),
+                              Iter_Type_Info.T.Range_Left));
+            New_Else_Stmt (If_Blk);
+            New_Assign_Stmt (New_Obj (Val), New_Value_Selected_Acc_Value
+                             (New_Obj (Range_Ptr),
+                              Iter_Type_Info.T.Range_Right));
+            Finish_If_Stmt (If_Blk);
+
+            New_Assign_Stmt
+              (Get_Var (Get_Info (Scheme).Iterator_Var),
+               New_Dyadic_Op
+               (ON_Add_Ov,
+                New_Obj_Value (Val),
+                New_Convert_Ov (New_Obj_Value (Var_I),
+                                Iter_Type_Info.Ortho_Type (Mode_Value))));
+         end;
+
+         --  Elaboration.
+         Elab_Block_Declarations (Stmt, Stmt);
+
+         Pop_Scope (Base_Info.Block_Decls_Type);
+         Pop_Scope (Info.Block_Decls_Type);
+
+         Inc_Var (Var_I);
+         Finish_Loop_Stmt (Label);
+         Close_Temp;
+      end Elab_Iterative_Generate_Statement;
+
+      type Merge_Signals_Data is record
+         Sig : Iir;
+         Set_Init : Boolean;
+         Has_Val : Boolean;
+         Val : Mnode;
+      end record;
+
+      procedure Merge_Signals_Rti_Non_Composite (Targ : Mnode;
+                                                 Targ_Type : Iir;
+                                                 Data : Merge_Signals_Data)
+      is
+         Type_Info : Type_Info_Acc;
+         Sig : Mnode;
+
+         Init_Subprg : O_Dnode;
+         Conv : O_Tnode;
+         Assoc : O_Assoc_List;
+         Init_Val : O_Enode;
+      begin
+         Type_Info := Get_Info (Targ_Type);
+
+         Open_Temp;
+
+         if Data.Set_Init then
+            case Type_Info.Type_Mode is
+               when Type_Mode_B2 =>
+                  Init_Subprg := Ghdl_Signal_Init_B2;
+                  Conv := Ghdl_Bool_Type;
+               when Type_Mode_E8 =>
+                  Init_Subprg := Ghdl_Signal_Init_E8;
+                  Conv := Ghdl_I32_Type;
+               when Type_Mode_I32
+                 | Type_Mode_P32 =>
+                  Init_Subprg := Ghdl_Signal_Init_I32;
+                  Conv := Ghdl_I32_Type;
+               when Type_Mode_P64
+                 | Type_Mode_I64 =>
+                  Init_Subprg := Ghdl_Signal_Init_I64;
+                  Conv := Ghdl_I64_Type;
+               when Type_Mode_F64 =>
+                  Init_Subprg := Ghdl_Signal_Init_F64;
+                  Conv := Ghdl_Real_Type;
+               when others =>
+                  Error_Kind ("merge_signals_rti_non_composite", Targ_Type);
+            end case;
+
+            Sig := Stabilize (Targ, True);
+
+            --  Init the signal.
+            Start_Association (Assoc, Init_Subprg);
+            New_Association
+              (Assoc,
+               New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
+            if Data.Has_Val then
+               Init_Val := M2E (Data.Val);
+            else
+               Init_Val := Chap14.Translate_Left_Type_Attribute (Targ_Type);
+            end if;
+            New_Association (Assoc, New_Convert_Ov (Init_Val, Conv));
+            New_Procedure_Call (Assoc);
+         else
+            Sig := Targ;
+         end if;
+
+         Start_Association (Assoc, Ghdl_Signal_Merge_Rti);
+
+         New_Association
+           (Assoc, New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
+         New_Association
+           (Assoc,
+            New_Lit (New_Global_Unchecked_Address
+                     (Get_Info (Data.Sig).Object_Rti,
+                      Rtis.Ghdl_Rti_Access)));
+         New_Procedure_Call (Assoc);
+         Close_Temp;
+      end Merge_Signals_Rti_Non_Composite;
+
+      function Merge_Signals_Rti_Prepare (Targ : Mnode;
+                                          Targ_Type : Iir;
+                                          Data : Merge_Signals_Data)
+                                         return Merge_Signals_Data
+      is
+         pragma Unreferenced (Targ);
+         pragma Unreferenced (Targ_Type);
+         Res : Merge_Signals_Data;
+      begin
+         Res := Data;
+         if Data.Has_Val then
+            if Get_Type_Info (Data.Val).Type_Mode = Type_Mode_Record then
+               Res.Val := Stabilize (Data.Val);
+            else
+               Res.Val := Chap3.Get_Array_Base (Data.Val);
+            end if;
+         end if;
+
+         return Res;
+      end Merge_Signals_Rti_Prepare;
+
+      function Merge_Signals_Rti_Update_Data_Array
+        (Data : Merge_Signals_Data; Targ_Type : Iir; Index : O_Dnode)
+        return Merge_Signals_Data
+      is
+      begin
+         if not Data.Has_Val then
+            return Data;
+         else
+            return Merge_Signals_Data'
+              (Sig => Data.Sig,
+               Val => Chap3.Index_Base (Data.Val, Targ_Type,
+                                        New_Obj_Value (Index)),
+               Has_Val => True,
+               Set_Init => Data.Set_Init);
+         end if;
+      end Merge_Signals_Rti_Update_Data_Array;
+
+      procedure Merge_Signals_Rti_Finish_Data_Composite
+        (Data : in out Merge_Signals_Data)
+      is
+         pragma Unreferenced (Data);
+      begin
+         null;
+      end Merge_Signals_Rti_Finish_Data_Composite;
+
+      function Merge_Signals_Rti_Update_Data_Record
+        (Data : Merge_Signals_Data;
+         Targ_Type : Iir;
+         El : Iir_Element_Declaration) return Merge_Signals_Data
+      is
+         pragma Unreferenced (Targ_Type);
+      begin
+         if not Data.Has_Val then
+            return Data;
+         else
+            return Merge_Signals_Data'
+              (Sig => Data.Sig,
+               Val => Chap6.Translate_Selected_Element (Data.Val, El),
+               Has_Val => True,
+               Set_Init => Data.Set_Init);
+         end if;
+      end Merge_Signals_Rti_Update_Data_Record;
+
+      pragma Inline (Merge_Signals_Rti_Finish_Data_Composite);
+
+      procedure Merge_Signals_Rti is new Foreach_Non_Composite
+        (Data_Type => Merge_Signals_Data,
+         Composite_Data_Type => Merge_Signals_Data,
+         Do_Non_Composite => Merge_Signals_Rti_Non_Composite,
+         Prepare_Data_Array => Merge_Signals_Rti_Prepare,
+         Update_Data_Array => Merge_Signals_Rti_Update_Data_Array,
+         Finish_Data_Array => Merge_Signals_Rti_Finish_Data_Composite,
+         Prepare_Data_Record => Merge_Signals_Rti_Prepare,
+         Update_Data_Record => Merge_Signals_Rti_Update_Data_Record,
+         Finish_Data_Record => Merge_Signals_Rti_Finish_Data_Composite);
+
+      procedure Merge_Signals_Rti_Of_Port_Chain (Chain : Iir)
+      is
+         Port : Iir;
+         Port_Type : Iir;
+         Data : Merge_Signals_Data;
+         Val : Iir;
+      begin
+         Port := Chain;
+         while Port /= Null_Iir loop
+            Port_Type := Get_Type (Port);
+            Data.Sig := Port;
+            case Get_Mode (Port) is
+               when Iir_Buffer_Mode
+                 | Iir_Out_Mode
+                 | Iir_Inout_Mode =>
+                  Data.Set_Init := True;
+               when others =>
+                  Data.Set_Init := False;
+            end case;
+
+            Open_Temp;
+            Val := Get_Default_Value (Port);
+            if Val = Null_Iir then
+               Data.Has_Val := False;
+            else
+               Data.Has_Val := True;
+               Data.Val := E2M (Chap7.Translate_Expression (Val, Port_Type),
+                                Get_Info (Port_Type),
+                                Mode_Value);
+            end if;
+
+            Merge_Signals_Rti (Chap6.Translate_Name (Port), Port_Type, Data);
+            Close_Temp;
+
+            Port := Get_Chain (Port);
+         end loop;
+      end Merge_Signals_Rti_Of_Port_Chain;
+
+      procedure Elab_Block_Declarations (Block : Iir; Base_Block : Iir)
+      is
+         Block_Info : Block_Info_Acc;
+         Base_Info : Block_Info_Acc;
+         Stmt : Iir;
+         Final : Boolean;
+      begin
+         Block_Info := Get_Info (Block);
+         Base_Info := Get_Info (Base_Block);
+
+         New_Debug_Line_Stmt (Get_Line_Number (Block));
+
+         case Get_Kind (Block) is
+            when Iir_Kind_Entity_Declaration =>
+               Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Block));
+            when Iir_Kind_Architecture_Declaration =>
+               null;
+            when Iir_Kind_Block_Statement =>
+               declare
+                  Header : Iir_Block_Header;
+                  Guard : Iir;
+               begin
+                  Guard := Get_Guard_Decl (Block);
+                  if Guard /= Null_Iir then
+                     New_Debug_Line_Stmt (Get_Line_Number (Guard));
+                     Elab_Implicit_Guard_Signal (Block, Base_Info);
+                  end if;
+                  Header := Get_Block_Header (Block);
+                  if Header /= Null_Iir then
+                     New_Debug_Line_Stmt (Get_Line_Number (Header));
+                     Chap5.Elab_Map_Aspect (Header, Block);
+                     Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Header));
+                  end if;
+               end;
+            when Iir_Kind_Generate_Statement =>
+               null;
+            when others =>
+               Error_Kind ("elab_block_declarations", Block);
+         end case;
+
+         Chap4.Elab_Declaration_Chain (Block, Final);
+
+         Stmt := Get_Concurrent_Statement_Chain (Block);
+         while Stmt /= Null_Iir loop
+            case Get_Kind (Stmt) is
+               when Iir_Kind_Process_Statement
+                 | Iir_Kind_Sensitized_Process_Statement =>
+                  Elab_Process (Stmt, Block_Info, Base_Info);
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  declare
+                     Info : Block_Info_Acc;
+                     Constr : O_Assoc_List;
+                  begin
+                     Info := Get_Info (Stmt);
+                     Start_Association (Constr, Info.Block_Elab_Subprg);
+                     New_Association
+                       (Constr, Get_Instance_Access (Base_Block));
+                     New_Procedure_Call (Constr);
+                  end;
+                  --Elab_Component_Instantiation (Stmt, Block_Info);
+               when Iir_Kind_Block_Statement =>
+                  declare
+                     Info : Block_Info_Acc;
+                     Mark : Id_Mark_Type;
+                  begin
+                     Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+                     Info := Get_Info (Stmt);
+                     Push_Scope (Info.Block_Decls_Type,
+                                 Info.Block_Parent_Field,
+                                 Block_Info.Block_Decls_Type);
+                     Elab_Block_Declarations (Stmt, Base_Block);
+                     Pop_Scope (Info.Block_Decls_Type);
+                     Pop_Identifier_Prefix (Mark);
+                  end;
+               when Iir_Kind_Generate_Statement =>
+                  declare
+                     Mark : Id_Mark_Type;
+                  begin
+                     Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+
+                     if Get_Kind (Get_Generation_Scheme (Stmt))
+                       = Iir_Kind_Iterator_Declaration
+                     then
+                        Elab_Iterative_Generate_Statement
+                          (Stmt, Block, Base_Block);
+                     else
+                        Elab_Conditionnal_Generate_Statement
+                          (Stmt, Block, Base_Block);
+                     end if;
+                     Pop_Identifier_Prefix (Mark);
+                  end;
+               when others =>
+                  Error_Kind ("elab_block_declarations", Stmt);
+            end case;
+            Stmt := Get_Chain (Stmt);
+         end loop;
+      end Elab_Block_Declarations;
+   end Chap9;
+
+   package body Chap10 is
+      --  Identifiers.
+      --  The following functions are helpers to create ortho identifiers.
+      Identifier_Buffer : String (1 .. 512);
+      Identifier_Len : Natural := 0;
+      Identifier_Start : Natural := 1;
+      Identifier_Local : Local_Identifier_Type := 0;
+
+
+      Inst_Build : Inst_Build_Acc := null;
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Object => Inst_Build_Type, Name => Inst_Build_Acc);
+
+      procedure Set_Global_Storage (Storage : O_Storage) is
+      begin
+         Global_Storage := Storage;
+      end Set_Global_Storage;
+
+      procedure Pop_Build_Instance
+      is
+         Old : Inst_Build_Acc;
+      begin
+         Old := Inst_Build;
+         Identifier_Start := Old.Prev_Id_Start;
+         Inst_Build := Old.Prev;
+         Unchecked_Deallocation (Old);
+      end Pop_Build_Instance;
+
+--       procedure Push_Global_Factory (Storage : O_Storage)
+--       is
+--          Inst : Inst_Build_Acc;
+--       begin
+--          if Inst_Build /= null then
+--             raise Internal_Error;
+--          end if;
+--          Inst := new Inst_Build_Type (Global);
+--          Inst.Prev := Inst_Build;
+--          Inst_Build := Inst;
+--          Global_Storage := Storage;
+--       end Push_Global_Factory;
+
+--       procedure Pop_Global_Factory is
+--       begin
+--          if Inst_Build.Kind /= Global then
+--             raise Internal_Error;
+--          end if;
+--          Pop_Build_Instance;
+--          Global_Storage := O_Storage_Private;
+--       end Pop_Global_Factory;
+
+      procedure Push_Instance_Factory (Instance_Type : O_Tnode)
+      is
+         Inst : Inst_Build_Acc;
+      begin
+         if Inst_Build /= null and then Inst_Build.Kind /= Instance then
+            raise Internal_Error;
+         end if;
+         Inst := new Inst_Build_Type (Instance);
+         Inst.Prev := Inst_Build;
+
+         Inst.Prev_Id_Start := Identifier_Start;
+         Identifier_Start := Identifier_Len + 1;
+
+         if Instance_Type /= O_Tnode_Null then
+            Start_Uncomplete_Record_Type (Instance_Type, Inst.Elements);
+         else
+            Start_Record_Type (Inst.Elements);
+         end if;
+         Inst.Vars := null;
+         Inst_Build := Inst;
+      end Push_Instance_Factory;
+
+      function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
+        return O_Fnode
+      is
+         Res : O_Fnode;
+      begin
+         New_Record_Field (Inst_Build.Elements, Res, Name, Ftype);
+         return Res;
+      end Add_Instance_Factory_Field;
+
+      procedure Pop_Instance_Factory (Instance_Type : out O_Tnode)
+      is
+         Res : O_Tnode;
+         V : Var_Acc;
+      begin
+         if Inst_Build.Kind /= Instance then
+            --  Not matching.
+            raise Internal_Error;
+         end if;
+         Finish_Record_Type (Inst_Build.Elements, Res);
+         --  Set type of all variable declared in this instance.
+         V := Inst_Build.Vars;
+         while V /= null loop
+            V.I_Type := Res;
+            V := V.I_Link;
+         end loop;
+         Pop_Build_Instance;
+         Instance_Type := Res;
+      end Pop_Instance_Factory;
+
+      procedure Push_Local_Factory
+      is
+         Inst : Inst_Build_Acc;
+      begin
+         if Inst_Build /= null
+           and then (Inst_Build.Kind /= Global and Inst_Build.Kind /= Local)
+         then
+            --  Cannot create a local factory on an instance.
+            raise Internal_Error;
+         end if;
+         Inst := new Inst_Build_Type (Kind => Local);
+         Inst.Prev := Inst_Build;
+         Inst.Prev_Global_Storage := Global_Storage;
+
+         Inst.Prev_Id_Start := Identifier_Start;
+         Identifier_Start := Identifier_Len + 1;
+
+         Inst_Build := Inst;
+         case Global_Storage is
+            when O_Storage_Public =>
+               Global_Storage := O_Storage_Private;
+            when O_Storage_Private
+              | O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               raise Internal_Error;
+         end case;
+      end Push_Local_Factory;
+
+      --  Return TRUE is the current scope is local.
+      function Is_Local_Scope return Boolean is
+      begin
+         if Inst_Build = null then
+            return False;
+         end if;
+         case Inst_Build.Kind is
+            when Local
+              | Instance =>
+               return True;
+            when Global =>
+               return False;
+         end case;
+      end Is_Local_Scope;
+
+      procedure Pop_Local_Factory is
+      begin
+         if Inst_Build.Kind /= Local then
+            --  Not matching.
+            raise Internal_Error;
+         end if;
+         Global_Storage := Inst_Build.Prev_Global_Storage;
+         Pop_Build_Instance;
+      end Pop_Local_Factory;
+
+      type Scope_Type;
+      type Scope_Acc is access Scope_Type;
+      type Scope_Type is record
+         Is_Ptr : Boolean;
+         Stype : O_Tnode;
+         Field : O_Fnode;
+         Parent : O_Tnode;
+         Prev : Scope_Acc;
+      end record;
+      type Scope_Var_Type;
+      type Scope_Var_Acc is access Scope_Var_Type;
+      type Scope_Var_Type is record
+         Svtype : O_Tnode;
+         Var : O_Dnode;
+         Prev : Scope_Var_Acc;
+      end record;
+
+      Scopes : Scope_Acc := null;
+      --  Chained list of unused scopes, in order to reduce number of
+      --  dynamic allocation.
+      Scopes_Old : Scope_Acc := null;
+
+      Scopes_Var : Scope_Var_Acc := null;
+      --  Chained list of unused var_scopes, to reduce number of allocations.
+      Scopes_Var_Old : Scope_Var_Acc := null;
+
+      --  Get a scope, either from the list of free scope or by allocation.
+      function Get_A_Scope return Scope_Acc is
+         Res : Scope_Acc;
+      begin
+         if Scopes_Old /= null then
+            Res := Scopes_Old;
+            Scopes_Old := Scopes_Old.Prev;
+         else
+            Res := new Chap10.Scope_Type;
+         end if;
+         return Res;
+      end Get_A_Scope;
+
+      procedure Push_Scope (Scope_Type : O_Tnode;
+                            Scope_Field : O_Fnode; Scope_Parent : O_Tnode)
+      is
+         Res : Scope_Acc;
+      begin
+         Res := Get_A_Scope;
+         Res.all := (Is_Ptr => False,
+                     Stype => Scope_Type,
+                     Field => Scope_Field,
+                     Parent => Scope_Parent,
+                     Prev => Scopes);
+         Scopes := Res;
+      end Push_Scope;
+
+      procedure Push_Scope_Via_Field_Ptr
+        (Scope_Type : O_Tnode;
+         Scope_Field : O_Fnode; Scope_Parent : O_Tnode)
+      is
+         Res : Scope_Acc;
+      begin
+         Res := Get_A_Scope;
+         Res.all := (Is_Ptr => True,
+                     Stype => Scope_Type,
+                     Field => Scope_Field,
+                     Parent => Scope_Parent,
+                     Prev => Scopes);
+         Scopes := Res;
+      end Push_Scope_Via_Field_Ptr;
+
+      procedure Push_Scope (Scope_Type : O_Tnode; Scope_Param : O_Dnode)
+      is
+         Res : Scope_Var_Acc;
+      begin
+         if Scopes_Var_Old /= null then
+            Res := Scopes_Var_Old;
+            Scopes_Var_Old := Res.Prev;
+         else
+            Res := new Scope_Var_Type;
+         end if;
+         Res.all := (Svtype => Scope_Type,
+                     Var => Scope_Param,
+                     Prev => Scopes_Var);
+         Scopes_Var := Res;
+      end Push_Scope;
+
+      procedure Pop_Scope (Scope_Type : O_Tnode)
+      is
+         Old : Scope_Acc;
+         Var_Old : Scope_Var_Acc;
+      begin
+         --  Search in var scope.
+         if Scopes_Var /= null and then Scopes_Var.Svtype = Scope_Type then
+            Var_Old := Scopes_Var;
+            Scopes_Var := Var_Old.Prev;
+            Var_Old.Prev := Scopes_Var_Old;
+            Scopes_Var_Old := Var_Old;
+         elsif Scopes.Stype /= Scope_Type then
+            --  Bad pop order.
+            raise Internal_Error;
+         else
+            Old := Scopes;
+            Scopes := Old.Prev;
+            Old.Prev := Scopes_Old;
+            Scopes_Old := Old;
+         end if;
+      end Pop_Scope;
+
+      procedure Push_Scope_Soft (Scope_Type : O_Tnode; Scope_Param : O_Dnode)
+      is
+      begin
+         if Scope_Type /= O_Tnode_Null then
+            Push_Scope (Scope_Type, Scope_Param);
+         end if;
+      end Push_Scope_Soft;
+
+      procedure Pop_Scope_Soft (Scope_Type : O_Tnode)
+      is
+      begin
+         if Scope_Type /= O_Tnode_Null then
+            Pop_Scope (Scope_Type);
+         end if;
+      end Pop_Scope_Soft;
+
+      function Create_Global_Var
+        (Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage)
+        return Var_Acc
+      is
+         Var : O_Dnode;
+      begin
+         New_Var_Decl (Var, Name, Storage, Vtype);
+         return new Var_Type'(Kind => Var_Global, E => Var);
+      end Create_Global_Var;
+
+      function Create_Global_Const
+        (Name : O_Ident;
+         Vtype : O_Tnode;
+         Storage : O_Storage;
+         Initial_Value : O_Cnode)
+        return Var_Acc
+      is
+         Res : O_Dnode;
+      begin
+         New_Const_Decl (Res, Name, Storage, Vtype);
+         if Storage /= O_Storage_External
+           and then Initial_Value /= O_Cnode_Null
+         then
+            Start_Const_Value (Res);
+            Finish_Const_Value (Res, Initial_Value);
+         end if;
+         return new Var_Type'(Kind => Var_Global, E => Res);
+      end Create_Global_Const;
+
+      procedure Define_Global_Const (Const : Var_Acc; Val : O_Cnode) is
+      begin
+         Start_Const_Value (Const.E);
+         Finish_Const_Value (Const.E, Val);
+      end Define_Global_Const;
+
+      function Create_Var
+        (Name : Var_Ident_Type;
+         Vtype : O_Tnode;
+         Storage : O_Storage := Global_Storage)
+        return Var_Acc
+      is
+         Res : O_Dnode;
+         Field : O_Fnode;
+         V : Var_Acc;
+         K : Inst_Build_Kind_Type;
+      begin
+         if Inst_Build = null then
+            K := Global;
+         else
+            K := Inst_Build.Kind;
+         end if;
+         case K is
+            when Global =>
+               --  The global scope is in use...
+               return Create_Global_Var (Name.Id, Vtype, Storage);
+            when Local =>
+               --  It is always possible to create a variable in a local scope.
+               --  Create a var.
+               New_Var_Decl (Res, Name.Id, O_Storage_Local, Vtype);
+               return new Var_Type'(Kind => Var_Local, E => Res);
+            when Instance =>
+               --  Create a field.
+               New_Record_Field (Inst_Build.Elements, Field, Name.Id, Vtype);
+               V := new Var_Type'(Kind => Var_Scope, I_Field => Field,
+                                  I_Type => O_Tnode_Null,
+                                  I_Link => Inst_Build.Vars);
+               Inst_Build.Vars := V;
+               return V;
+         end case;
+      end Create_Var;
+
+      function Find_Scope_Type (Stype : O_Tnode) return O_Lnode
+      is
+         S : Scope_Acc;
+         Sv : Scope_Var_Acc;
+      begin
+         --  Find in var.
+         Sv := Scopes_Var;
+         while Sv /= null loop
+            if Sv.Svtype = Stype then
+               return New_Acc_Value (New_Obj (Sv.Var));
+            end if;
+            Sv := Sv.Prev;
+         end loop;
+
+         --  Find in fields.
+         S := Scopes;
+         while S /= null loop
+            if S.Stype = Stype then
+               if S.Is_Ptr then
+                  return New_Access_Element
+                    (New_Value
+                     (New_Selected_Element (Find_Scope_Type (S.Parent),
+                                            S.Field)));
+               else
+                  return New_Selected_Element
+                    (Find_Scope_Type (S.Parent), S.Field);
+               end if;
+            end if;
+            S := S.Prev;
+         end loop;
+
+         --  Not found.
+         raise Internal_Error;
+      end Find_Scope_Type;
+
+      function Get_Instance_Access (Block : Iir) return O_Enode
+      is
+         Info : Block_Info_Acc;
+      begin
+         Info := Get_Info (Block);
+         if Info.Block_Decls_Type = Scopes_Var.Svtype then
+            return New_Value (New_Obj (Scopes_Var.Var));
+         else
+            return New_Address (Get_Instance_Ref (Info.Block_Decls_Type),
+                                Info.Block_Decls_Ptr_Type);
+         end if;
+      end Get_Instance_Access;
+
+      function Get_Instance_Ref (Itype : O_Tnode) return O_Lnode
+      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;
+         return Find_Scope_Type (Itype);
+      end Get_Instance_Ref;
+
+      function Get_Var (Var : Var_Acc) return O_Lnode
+      is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               return New_Obj (Var.E);
+            when Var_Scope =>
+               null;
+         end case;
+
+         return New_Selected_Element (Get_Instance_Ref (Var.I_Type),
+                                      Var.I_Field);
+      end Get_Var;
+
+      function Get_Alloc_Kind_For_Var (Var : Var_Acc) return Allocation_Kind is
+      begin
+         case Var.Kind is
+            when Var_Local =>
+               return Alloc_Stack;
+            when Var_Global
+              | Var_Scope =>
+               return Alloc_System;
+         end case;
+      end Get_Alloc_Kind_For_Var;
+
+      function Is_Var_Stable (Var : Var_Acc) return Boolean is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               return True;
+            when Var_Scope =>
+               return False;
+         end case;
+      end Is_Var_Stable;
+
+      function Is_Var_Field (Var : Var_Acc) return Boolean is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               return False;
+            when Var_Scope =>
+               return True;
+         end case;
+      end Is_Var_Field;
+
+      function Get_Var_Field (Var : Var_Acc) return O_Fnode is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               raise Internal_Error;
+            when Var_Scope =>
+               return Var.I_Field;
+         end case;
+      end Get_Var_Field;
+
+      function Get_Var_Label (Var : Var_Acc) return O_Dnode is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               return Var.E;
+            when Var_Scope =>
+               raise Internal_Error;
+         end case;
+      end Get_Var_Label;
+
+      procedure Free_Var (Var : in out Var_Acc)
+      is
+         procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+           (Var_Type, Var_Acc);
+      begin
+         Unchecked_Deallocation (Var);
+      end Free_Var;
+
+--       type Scope_Layer is record
+--          --  How to dereference a variable in the scope.
+--          --  O_Enode_Null if no there is no way to dereference an element of
+--          --   the scope, like during scope creation.
+--          This : O_Enode;
+
+--          --  Type of the scope; this must be a record type or NULL_TREE for
+--          --   the global scope.
+--          --  This is very important since a variable (in fact a FIELD_DECL)
+--          --   belong to a scope iff the type of the field context is
+--          --   Scope_Type.  As a consequence, Scope_Type of two different
+--          --   layers must be different.
+--          --  Note: scope_type is a type definition (such as RECORD_TYPE) and
+--          --   *not* a TYPE_DECL.
+--          --  NULL_TREE for a local scope.
+--          Scope_Type : O_Tnode;
+
+--          --  The scope just below this one.
+--          --Prev : Scope_Acc;
+--       end record;
+
+      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 Add_Local_Identifier (Len : in out Natural)
+--       is
+--          Str : String := Local_Identifier_Type'Image (Identifier_Local);
+--       begin
+--          Identifier_Local := Identifier_Local + 1;
+
+--          if Inst_Build = null then
+--             Str (1) := 'N';
+--          else
+--             case Inst_Build.Kind is
+--                when Local =>
+--                   Str (1) := 'L';
+--                when Global =>
+--                   Str (1) := 'G';
+--                when Instance =>
+--                   Str (1) := 'I';
+--             end case;
+--          end if;
+--          Add_String (Len, Str);
+--       end Add_Local_Identifier;
+
+      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_Local_Identifier (Len);
+            null;
+         else
+            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 (Id : Iir)
+        return Var_Ident_Type
+      is
+         Res : Var_Ident_Type;
+      begin
+         Res.Id := Create_Id (Get_Identifier (Id), "", Is_Local_Scope);
+         return Res;
+      end Create_Var_Identifier;
+
+      function Create_Var_Identifier (Id : String)
+        return Var_Ident_Type
+      is
+         Res : Var_Ident_Type;
+      begin
+         Res.Id := Create_Id (Null_Identifier, Id, Is_Local_Scope);
+         return Res;
+      end Create_Var_Identifier;
+
+      function Create_Uniq_Identifier return Var_Ident_Type
+      is
+         Res : Var_Ident_Type;
+      begin
+         Res.Id := Create_Uniq_Identifier;
+         return Res;
+      end Create_Uniq_Identifier;
+   end Chap10;
+
+   package body Chap14 is
+      function Translate_Array_Attribute_To_Range (Expr : Iir) return Mnode
+      is
+         Prefix : Iir;
+         Arr : Mnode;
+         Dim : Natural;
+      begin
+         Prefix := Get_Prefix (Expr);
+         case Get_Kind (Prefix) is
+            when Iir_Kind_Type_Declaration
+              | Iir_Kind_Subtype_Declaration =>
+               Arr := T2M (Get_Type (Prefix), Mode_Value);
+            when others =>
+               Arr := Chap6.Translate_Name (Prefix);
+         end case;
+         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, which must be stable.
+      --  Put the result into RES.
+      procedure Range_To_High_Low
+        (Range_Var : Mnode; Res : O_Dnode; Is_High : Boolean)
+      is
+         Op : ON_Op_Kind;
+         If_Blk : O_If_Block;
+      begin
+         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_Var)),
+                                        New_Lit (Ghdl_Dir_To_Node),
+                                        Ghdl_Bool_Type));
+         New_Assign_Stmt (New_Obj (Res),
+                          M2E (Chap3.Range_To_Left (Range_Var)));
+         New_Else_Stmt (If_Blk);
+         New_Assign_Stmt (New_Obj (Res),
+                          M2E (Chap3.Range_To_Right (Range_Var)));
+         Finish_If_Stmt (If_Blk);
+      end Range_To_High_Low;
+
+      function Translate_High_Low_Array_Attribute (Expr : Iir;
+                                                   Is_High : Boolean)
+        return O_Enode
+      is
+         Prefix : Iir;
+         Prefix_Type : Iir;
+         Dim : Natural;
+         Index_Type : Iir;
+         Index_Info : Type_Info_Acc;
+         Res : O_Dnode;
+         Range_Var : Mnode;
+      begin
+         Prefix := Get_Prefix (Expr);
+         Prefix_Type := Get_Type (Prefix);
+         Dim := Natural (Get_Value (Get_Parameter (Expr)));
+         Index_Type := Get_Nth_Element (Get_Index_Subtype_List (Prefix_Type),
+                                        Dim - 1);
+         Index_Info := Get_Info (Get_Base_Type (Index_Type));
+
+         Res := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
+
+         Open_Temp;
+         Range_Var := Stabilize (Translate_Array_Attribute_To_Range (Expr));
+         Range_To_High_Low (Range_Var, Res, Is_High);
+         Close_Temp;
+         return New_Obj_Value (Res);
+      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_Low_High_Type_Attribute
+        (Atype : Iir; Is_Low : Boolean)
+        return O_Enode
+      is
+         Range_Constr : Iir;
+      begin
+         if Get_Type_Staticness (Atype) = Locally then
+            Range_Constr := Get_Range_Constraint (Atype);
+            if Get_Direction (Range_Constr) = Iir_To xor Is_Low then
+               --  TO and HIGH   or  DOWNTO and LOW  -> right
+               return New_Lit (Chap7.Translate_Static_Range_Right
+                               (Range_Constr, Atype));
+            else
+               --  TO and LOW   or   DOWNTO and HIGH  -> left
+               return New_Lit (Chap7.Translate_Static_Range_Left
+                               (Range_Constr, Atype));
+            end if;
+         else
+            declare
+               Res : O_Dnode;
+               Rng : Mnode;
+            begin
+               Res := Create_Temp (Get_Ortho_Type (Atype, Mode_Value));
+               Open_Temp;
+               Rng := Stabilize (Chap3.Type_To_Range (Atype));
+               Range_To_High_Low (Rng, Res, not Is_Low);
+               Close_Temp;
+               return New_Obj_Value (Res);
+            end;
+         end if;
+      end Translate_Low_High_Type_Attribute;
+
+      function Translate_High_Type_Attribute (Atype : Iir) return O_Enode is
+      begin
+         return Translate_Low_High_Type_Attribute (Atype, False);
+      end Translate_High_Type_Attribute;
+
+      function Translate_Low_Type_Attribute (Atype : Iir) return O_Enode is
+      begin
+         return Translate_Low_High_Type_Attribute (Atype, True);
+      end Translate_Low_Type_Attribute;
+
+      function Translate_Left_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_Left
+                            (Get_Range_Constraint (Atype), Atype));
+         else
+            Info := Get_Info (Atype);
+            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
+         Info : Type_Info_Acc;
+      begin
+         if Get_Type_Staticness (Atype) = Locally then
+            return New_Lit (Chap7.Translate_Static_Range_Right
+                            (Get_Range_Constraint (Atype), Atype));
+         else
+            Info := Get_Info (Atype);
+            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
+         T : O_Dnode;
+         Prefix : Iir;
+         Ttype : O_Tnode;
+      begin
+         Prefix := Get_Type (Attr);
+         Ttype := Get_Ortho_Type (Prefix, 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, Get_Type (Get_Prefix (Attr)));
+         return New_Obj_Value (T);
+      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);
+         return New_Obj_Value (T);
+      end Translate_Pos_Attribute;
+
+      function Translate_Succ_Pred_Attribute (Attr : Iir) return O_Enode
+      is
+         Expr_Type : Iir;
+         Tinfo : Type_Info_Acc;
+         Ttype : O_Tnode;
+         Expr : O_Enode;
+         List : Iir_List;
+         Limit : Iir;
+         Is_Succ : Boolean;
+         Op : ON_Op_Kind;
+      begin
+         --  FIXME: should check bounds.
+         Expr_Type := Get_Type (Attr);
+         Tinfo := Get_Info (Expr_Type);
+         Expr := Chap7.Translate_Expression (Get_Parameter (Attr), Expr_Type);
+         Ttype := Tinfo.Ortho_Type (Mode_Value);
+         Is_Succ := Get_Kind (Attr) = Iir_Kind_Succ_Attribute;
+         if Is_Succ then
+            Op := ON_Add_Ov;
+         else
+            Op := ON_Sub_Ov;
+         end if;
+         case Tinfo.Type_Mode is
+            when Type_Mode_B2
+              | Type_Mode_E8
+              | Type_Mode_E32 =>
+               --  Should check it is not the last.
+               declare
+                  L : O_Dnode;
+               begin
+                  List := Get_Enumeration_Literal_List (Get_Base_Type
+                                                        (Expr_Type));
+                  L := Create_Temp_Init (Ttype, Expr);
+                  if Is_Succ then
+                     Limit := Get_Last_Element (List);
+                  else
+                     Limit := Get_First_Element (List);
+                  end if;
+                  Chap6.Check_Bound_Error
+                    (New_Compare_Op (ON_Eq,
+                                     New_Obj_Value (L),
+                                     New_Lit (Get_Ortho_Expr (Limit)),
+                                     Ghdl_Bool_Type),
+                     Attr, 0);
+                  return New_Convert_Ov
+                    (New_Dyadic_Op
+                     (Op,
+                      New_Convert_Ov (New_Obj_Value (L), Ghdl_I32_Type),
+                      New_Lit (New_Signed_Literal (Ghdl_I32_Type, 1))),
+                     Ttype);
+               end;
+            when Type_Mode_I32
+              | Type_Mode_P64 =>
+               return New_Dyadic_Op
+                 (Op, Expr, New_Lit (New_Signed_Literal (Ttype, 1)));
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Translate_Succ_Pred_Attribute;
+
+      --  Read the boolean attribute (active or event) FIELD of simple signal
+      --  SIG.
+      function Read_Bool_Signal_Attribute (Sig : O_Enode; Field : O_Fnode)
+                                          return O_Enode
+      is
+         S : O_Enode;
+      begin
+         S := New_Convert_Ov (Sig, Ghdl_Signal_Ptr);
+         return New_Value
+           (New_Selected_Element (New_Access_Element (S), Field));
+         --Ghdl_Signal_Event_Node));
+      end Read_Bool_Signal_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,
+                        Read_Bool_Signal_Attribute (New_Value (M2Lv (Targ)),
+                                                    Data.Field));
+      end Bool_Sigattr_Non_Composite_Signal;
+
+      function Bool_Sigattr_Prepare_Data_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Bool_Sigattr_Data_Type)
+        return Bool_Sigattr_Data_Type
+      is
+         pragma Unreferenced (Targ, Targ_Type);
+      begin
+         return Data;
+      end Bool_Sigattr_Prepare_Data_Composite;
+
+      function Bool_Sigattr_Update_Data_Array (Data : Bool_Sigattr_Data_Type;
+                                               Targ_Type : Iir;
+                                               Index : O_Dnode)
+        return Bool_Sigattr_Data_Type
+      is
+         pragma Unreferenced (Targ_Type, Index);
+      begin
+         return Data;
+      end Bool_Sigattr_Update_Data_Array;
+
+      function Bool_Sigattr_Update_Data_Record (Data : Bool_Sigattr_Data_Type;
+                                                Targ_Type : Iir;
+                                                El : Iir_Element_Declaration)
+        return Bool_Sigattr_Data_Type
+      is
+         pragma Unreferenced (Targ_Type, El);
+      begin
+         return Data;
+      end Bool_Sigattr_Update_Data_Record;
+
+      procedure Bool_Sigattr_Finish_Data_Composite
+        (Data : in out Bool_Sigattr_Data_Type)
+      is
+         pragma Unreferenced (Data);
+      begin
+         null;
+      end Bool_Sigattr_Finish_Data_Composite;
+
+      procedure Bool_Sigattr_Foreach is new Foreach_Non_Composite
+        (Data_Type => Bool_Sigattr_Data_Type,
+         Composite_Data_Type => Bool_Sigattr_Data_Type,
+         Do_Non_Composite => Bool_Sigattr_Non_Composite_Signal,
+         Prepare_Data_Array => Bool_Sigattr_Prepare_Data_Composite,
+         Update_Data_Array => Bool_Sigattr_Update_Data_Array,
+         Finish_Data_Array => Bool_Sigattr_Finish_Data_Composite,
+         Prepare_Data_Record => Bool_Sigattr_Prepare_Data_Composite,
+         Update_Data_Record => Bool_Sigattr_Update_Data_Record,
+         Finish_Data_Record => Bool_Sigattr_Finish_Data_Composite);
+
+      function Translate_Bool_Signal_Attribute (Attr : Iir; Field : O_Fnode)
+                                               return O_Enode
+      is
+         Data : Bool_Sigattr_Data_Type;
+         Res : O_Dnode;
+         Name : Mnode;
+         Prefix : Iir;
+         Prefix_Type : Iir;
+      begin
+         Prefix := Get_Prefix (Attr);
+         Prefix_Type := Get_Type (Prefix);
+
+         if Get_Kind (Prefix_Type) in Iir_Kinds_Scalar_Type_Definition then
+            --  Effecient handling for a scalar signal.
+            Name := Chap6.Translate_Name (Prefix);
+            return Read_Bool_Signal_Attribute (New_Value (M2Lv (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_Node);
+      end Translate_Event_Attribute;
+
+      function Translate_Active_Attribute (Attr : Iir) return O_Enode is
+      begin
+         return Translate_Bool_Signal_Attribute
+           (Attr, Ghdl_Signal_Active_Node);
+      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 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_Node));
+      end Read_Last_Value;
+
+      function Translate_Last_Value is new Chap7.Translate_Signal_Value
+        (Read_Value => Read_Last_Value);
+
+      function Translate_Last_Value_Attribute (Attr : Iir) return O_Enode
+      is
+         Name : Mnode;
+         Prefix : Iir;
+         Prefix_Type : Iir;
+      begin
+         Prefix := Get_Prefix (Attr);
+         Prefix_Type := Get_Type (Prefix);
+
+         Name := Chap6.Translate_Name (Prefix);
+         if Get_Object_Kind (Name) /= Mode_Signal then
+            raise Internal_Error;
+         end if;
+         return Translate_Last_Value (M2E (Name), Prefix_Type);
+      end Translate_Last_Value_Attribute;
+
+      function Read_Last_Time (Sig : O_Enode; Field : O_Fnode) return O_Enode
+      is
+         T : O_Lnode;
+      begin
+         T := New_Access_Element (New_Convert_Ov (Sig, Ghdl_Signal_Ptr));
+         return New_Value (New_Selected_Element (T, Field));
+      end Read_Last_Time;
+
+      type Last_Time_Data is record
+         Var : O_Dnode;
+         Field : O_Fnode;
+      end record;
+
+      procedure Translate_Last_Time_Non_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Last_Time_Data)
+      is
+         pragma Unreferenced (Targ_Type);
+         Val : O_Dnode;
+         If_Blk : O_If_Block;
+      begin
+         Open_Temp;
+         Val := Create_Temp_Init
+           (Std_Time_Type,
+            Read_Last_Time (New_Value (M2Lv (Targ)), Data.Field));
+         Start_If_Stmt (If_Blk,
+                        New_Compare_Op (ON_Gt,
+                                        New_Obj_Value (Val),
+                                        New_Obj_Value (Data.Var),
+                                        Ghdl_Bool_Type));
+         New_Assign_Stmt (New_Obj (Data.Var), New_Obj_Value (Val));
+         Finish_If_Stmt (If_Blk);
+         Close_Temp;
+      end Translate_Last_Time_Non_Composite;
+
+      function Last_Time_Prepare_Data_Composite
+        (Targ : Mnode; Targ_Type : Iir; Data : Last_Time_Data)
+        return Last_Time_Data
+      is
+         pragma Unreferenced (Targ, Targ_Type);
+      begin
+         return Data;
+      end Last_Time_Prepare_Data_Composite;
+
+      function Last_Time_Update_Data_Array (Data : Last_Time_Data;
+                                            Targ_Type : Iir;
+                                            Index : O_Dnode)
+                                           return Last_Time_Data
+      is
+         pragma Unreferenced (Targ_Type, Index);
+      begin
+         return Data;
+      end Last_Time_Update_Data_Array;
+
+      function Last_Time_Update_Data_Record (Data : Last_Time_Data;
+                                             Targ_Type : Iir;
+                                             El : Iir_Element_Declaration)
+                                            return Last_Time_Data
+      is
+         pragma Unreferenced (Targ_Type, El);
+      begin
+         return Data;
+      end Last_Time_Update_Data_Record;
+
+      procedure Last_Time_Finish_Data_Composite
+        (Data : in out Last_Time_Data)
+      is
+         pragma Unreferenced (Data);
+      begin
+         null;
+      end Last_Time_Finish_Data_Composite;
+
+      procedure Translate_Last_Time is new Foreach_Non_Composite
+        (Data_Type => Last_Time_Data,
+         Composite_Data_Type => Last_Time_Data,
+         Do_Non_Composite => Translate_Last_Time_Non_Composite,
+         Prepare_Data_Array => Last_Time_Prepare_Data_Composite,
+         Update_Data_Array => Last_Time_Update_Data_Array,
+         Finish_Data_Array => Last_Time_Finish_Data_Composite,
+         Prepare_Data_Record => Last_Time_Prepare_Data_Composite,
+         Update_Data_Record => Last_Time_Update_Data_Record,
+         Finish_Data_Record => Last_Time_Finish_Data_Composite);
+
+      function Translate_Last_Time_Attribute (Prefix : Iir; Field : O_Fnode)
+        return O_Enode
+      is
+         Prefix_Type : Iir;
+         Name : Mnode;
+         Info : Type_Info_Acc;
+         Var : O_Dnode;
+         Data : Last_Time_Data;
+         Right_Bound : Iir_Int64;
+         If_Blk : O_If_Block;
+      begin
+         Prefix_Type := Get_Type (Prefix);
+         Name := Chap6.Translate_Name (Prefix);
+         Info := Get_Info (Prefix_Type);
+         Var := Create_Temp (Std_Time_Type);
+
+         if Info.Type_Mode in Type_Mode_Scalar then
+            New_Assign_Stmt (New_Obj (Var),
+                             Read_Last_Time (M2E (Name), Field));
+         else
+            --  Init with a negative value.
+            New_Assign_Stmt (New_Obj (Var),
+                             New_Lit (New_Signed_Literal (Std_Time_Type, -1)));
+            Data := Last_Time_Data'(Var => Var, Field => Field);
+            Translate_Last_Time (Name, Prefix_Type, Data);
+         end if;
+
+         Right_Bound := Get_Value
+           (Get_Right_Limit (Get_Range_Constraint (Time_Subtype_Definition)));
+
+         --  VAR < 0 ?
+         Start_If_Stmt
+           (If_Blk,
+            New_Compare_Op (ON_Lt,
+                            New_Obj_Value (Var),
+                            New_Lit (New_Signed_Literal (Std_Time_Type, 0)),
+                            Ghdl_Bool_Type));
+         --  LRM 14.1 Predefined attributes
+         --   [...]; otherwise, it returns TIME'HIGH.
+         New_Assign_Stmt (New_Obj (Var),
+                          New_Lit (New_Signed_Literal
+                                   (Std_Time_Type, Integer_64 (Right_Bound))));
+         New_Else_Stmt (If_Blk);
+         --  Returns NOW - Var.
+         New_Assign_Stmt (New_Obj (Var),
+                          New_Dyadic_Op (ON_Sub_Ov,
+                                         New_Obj_Value (Ghdl_Now),
+                                         New_Obj_Value (Var)));
+         Finish_If_Stmt (If_Blk);
+         return New_Obj_Value (Var);
+      end Translate_Last_Time_Attribute;
+
+      --  Return TRUE if the scalar signal SIG is being driven.
+      function Read_Driving_Attribute (Sig : O_Enode) return O_Enode
+      is
+         Assoc : O_Assoc_List;
+      begin
+         Start_Association (Assoc, Ghdl_Signal_Driving);
+         New_Association (Assoc, New_Convert_Ov (Sig, Ghdl_Signal_Ptr));
+         return New_Function_Call (Assoc);
+      end Read_Driving_Attribute;
+
+      procedure Driving_Non_Composite_Signal
+        (Targ : Mnode; Targ_Type : Iir; Label : O_Snode)
+      is
+         pragma Unreferenced (Targ_Type);
+      begin
+         Gen_Exit_When
+           (Label,
+            New_Monadic_Op
+            (ON_Not, Read_Driving_Attribute (New_Value (M2Lv (Targ)))));
+      end Driving_Non_Composite_Signal;
+
+      function Driving_Prepare_Data_Composite
+        (Targ : Mnode; Targ_Type : Iir; Label : O_Snode)
+        return O_Snode
+      is
+         pragma Unreferenced (Targ, Targ_Type);
+      begin
+         return Label;
+      end Driving_Prepare_Data_Composite;
+
+      function Driving_Update_Data_Array (Label : O_Snode;
+                                          Targ_Type : Iir;
+                                          Index : O_Dnode)
+        return O_Snode
+      is
+         pragma Unreferenced (Targ_Type, Index);
+      begin
+         return Label;
+      end Driving_Update_Data_Array;
+
+      function Driving_Update_Data_Record (Label : O_Snode;
+                                           Targ_Type : Iir;
+                                           El : Iir_Element_Declaration)
+        return O_Snode
+      is
+         pragma Unreferenced (Targ_Type, El);
+      begin
+         return Label;
+      end Driving_Update_Data_Record;
+
+      procedure Driving_Finish_Data_Composite (Label : in out O_Snode)
+      is
+         pragma Unreferenced (Label);
+      begin
+         null;
+      end Driving_Finish_Data_Composite;
+
+      procedure Driving_Foreach is new Foreach_Non_Composite
+        (Data_Type => O_Snode,
+         Composite_Data_Type => O_Snode,
+         Do_Non_Composite => Driving_Non_Composite_Signal,
+         Prepare_Data_Array => Driving_Prepare_Data_Composite,
+         Update_Data_Array => Driving_Update_Data_Array,
+         Finish_Data_Array => Driving_Finish_Data_Composite,
+         Prepare_Data_Record => Driving_Prepare_Data_Composite,
+         Update_Data_Record => Driving_Update_Data_Record,
+         Finish_Data_Record => Driving_Finish_Data_Composite);
+
+      function Translate_Driving_Attribute (Attr : Iir) return O_Enode
+      is
+         Label : O_Snode;
+         Res : O_Dnode;
+         Name : Mnode;
+         Prefix : Iir;
+         Prefix_Type : Iir;
+      begin
+         Prefix := Get_Prefix (Attr);
+         Prefix_Type := Get_Type (Prefix);
+
+         if Get_Kind (Prefix_Type) in Iir_Kinds_Scalar_Type_Definition then
+            --  Effecient handling for a scalar signal.
+            Name := Chap6.Translate_Name (Prefix);
+            return Read_Driving_Attribute (New_Value (M2Lv (Name)));
+         else
+            --  Element per element handling for composite signals.
+            Res := Create_Temp (Std_Boolean_Type_Node);
+            Open_Temp;
+            New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_False_Node));
+            Name := Chap6.Translate_Name (Prefix);
+            Start_Loop_Stmt (Label);
+            Driving_Foreach (Name, Prefix_Type, Label);
+            New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_True_Node));
+            New_Exit_Stmt (Label);
+            Finish_Loop_Stmt (Label);
+            Close_Temp;
+            return New_Obj_Value (Res);
+         end if;
+      end Translate_Driving_Attribute;
+
+      function Read_Driving_Value (Sig : O_Enode; Sig_Type : Iir)
+                                  return O_Enode
+      is
+         Tinfo : Type_Info_Acc;
+         Subprg : O_Dnode;
+         Assoc : O_Assoc_List;
+      begin
+         Tinfo := Get_Info (Sig_Type);
+         case Tinfo.Type_Mode is
+            when Type_Mode_B2 =>
+               Subprg := Ghdl_Signal_Driving_Value_B2;
+            when Type_Mode_E8 =>
+               Subprg := Ghdl_Signal_Driving_Value_E8;
+            when Type_Mode_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 : Iir;
+         Pinfo : Type_Info_Acc;
+         Res : O_Dnode;
+         Subprg : O_Dnode;
+         Assoc : O_Assoc_List;
+         Conv : O_Tnode;
+      begin
+         Prefix_Type := Get_Base_Type (Get_Type (Get_Prefix (Attr)));
+         Pinfo := Get_Info (Prefix_Type);
+         Res := Create_Temp (Std_String_Node);
+         Create_Temp_Stack2_Mark;
+         case Pinfo.Type_Mode is
+            when Type_Mode_B2 =>
+               Subprg := Ghdl_Image_B2;
+               Conv := Ghdl_Bool_Type;
+            when Type_Mode_E8 =>
+               Subprg := Ghdl_Image_E8;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_I32 =>
+               Subprg := Ghdl_Image_I32;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_P32 =>
+               Subprg := Ghdl_Image_P32;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_P64 =>
+               Subprg := Ghdl_Image_P64;
+               Conv := Ghdl_I64_Type;
+            when Type_Mode_F64 =>
+               Subprg := Ghdl_Image_F64;
+               Conv := Ghdl_Real_Type;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Start_Association (Assoc, Subprg);
+         New_Association (Assoc,
+                          New_Address (New_Obj (Res), Std_String_Ptr_Node));
+         New_Association
+           (Assoc,
+            New_Convert_Ov
+            (Chap7.Translate_Expression (Get_Parameter (Attr), Prefix_Type),
+             Conv));
+         case Pinfo.Type_Mode is
+            when Type_Mode_B2
+              | Type_Mode_E8
+              | Type_Mode_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 : Iir;
+         Pinfo : Type_Info_Acc;
+         Subprg : O_Dnode;
+         Assoc : O_Assoc_List;
+         Conv : O_Tnode;
+      begin
+         Prefix_Type := Get_Base_Type (Get_Type (Get_Prefix (Attr)));
+         Pinfo := Get_Info (Prefix_Type);
+         case Pinfo.Type_Mode is
+            when Type_Mode_B2 =>
+               Subprg := Ghdl_Value_B2;
+               Conv := Ghdl_Bool_Type;
+            when Type_Mode_E8 =>
+               Subprg := Ghdl_Value_E8;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_I32 =>
+               Subprg := Ghdl_Value_I32;
+               Conv := Ghdl_I32_Type;
+            when Type_Mode_P64 =>
+               Subprg := Ghdl_Value_P64;
+               Conv := Ghdl_I64_Type;
+            when Type_Mode_F64 =>
+               Subprg := Ghdl_Value_F64;
+               Conv := Ghdl_Real_Type;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Start_Association (Assoc, Subprg);
+         New_Association
+           (Assoc,
+            Chap7.Translate_Expression (Get_Parameter (Attr),
+                                        String_Type_Definition));
+         case Pinfo.Type_Mode is
+            when Type_Mode_B2
+              | Type_Mode_E8
+              | Type_Mode_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), Conv);
+      end Translate_Value_Attribute;
+
+      --  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
+         use Name_Table;
+         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
+         use Name_Table;
+      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 pah 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 =>
+               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_Declaration =>
+               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;
+
+      function Translate_Path_Instance_Name_Attribute (Attr : Iir)
+                                                      return O_Enode
+      is
+         Prefix : Iir;
+         Res : O_Dnode;
+         Name_Cst : O_Dnode;
+         Constr : O_Assoc_List;
+         Is_Instance : Boolean;
+      begin
+         Prefix := Get_Prefix (Attr);
+         Is_Instance := Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute;
+
+         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_Constant_Interface_Declaration
+              | Iir_Kind_Iterator_Declaration
+              | Iir_Kind_Variable_Declaration
+              | Iir_Kind_Variable_Interface_Declaration
+              | Iir_Kind_Signal_Declaration
+              | Iir_Kind_Signal_Interface_Declaration
+              | Iir_Kind_File_Declaration
+              | Iir_Kind_File_Interface_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_Kind_Design_Unit
+              | Iir_Kind_Package_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 ("translate_path_instance_name_attribute", Prefix);
+         end case;
+         Create_Temp_Stack2_Mark;
+
+         Res := Create_Temp (Std_String_Node);
+         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,
+                             Create_String_Len (Path_Str (1 .. Path_Len),
+                                                Create_Uniq_Identifier));
+         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 Path_Instance = Null_Iir then
+            Rtis.Associate_Null_Rti_Context (Constr);
+         else
+            Rtis.Associate_Rti_Context (Constr, 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 unit value.
+      Ghdl_Rti_Unit_Val : O_Tnode;
+      Ghdl_Rti_Unit_32 : O_Fnode;
+      Ghdl_Rti_Unit_64 : O_Fnode;
+      Ghdl_Rti_Unit_Addr : O_Fnode;
+
+      --  Node for an unit.
+      Ghdl_Rtin_Unit : O_Tnode;
+      Ghdl_Rtin_Unit_Common : O_Fnode;
+      Ghdl_Rtin_Unit_Name : O_Fnode;
+      Ghdl_Rtin_Unit_Value  : O_Fnode;
+
+      --  Node for a physical type
+      Ghdl_Rtin_Type_Physical : O_Tnode;
+      Ghdl_Rtin_Type_Physical_Common : O_Fnode;
+      Ghdl_Rtin_Type_Physical_Name : O_Fnode;
+      Ghdl_Rtin_Type_Physical_Nbr : O_Fnode;
+      Ghdl_Rtin_Type_Physical_Units : O_Fnode;
+
+      --  Node for a scalar subtype definition.
+      Ghdl_Rtin_Subtype_Scalar : O_Tnode;
+      Ghdl_Rtin_Subtype_Scalar_Common : O_Fnode;
+      Ghdl_Rtin_Subtype_Scalar_Name : O_Fnode;
+      Ghdl_Rtin_Subtype_Scalar_Base : O_Fnode;
+      Ghdl_Rtin_Subtype_Scalar_Range : O_Fnode;
+
+      --  Node for an access or a file type.
+      Ghdl_Rtin_Type_Fileacc : O_Tnode;
+      Ghdl_Rtin_Type_Fileacc_Common : O_Fnode;
+      Ghdl_Rtin_Type_Fileacc_Name : O_Fnode;
+      Ghdl_Rtin_Type_Fileacc_Base : O_Fnode;
+
+      --  Node for an array type.
+      Ghdl_Rtin_Type_Array : O_Tnode;
+      Ghdl_Rtin_Type_Array_Common : O_Fnode;
+      Ghdl_Rtin_Type_Array_Name : O_Fnode;
+      Ghdl_Rtin_Type_Array_Element : O_Fnode;
+      Ghdl_Rtin_Type_Array_Nbrdim : O_Fnode;
+      Ghdl_Rtin_Type_Array_Indexes : O_Fnode;
+
+      --  Node for an array subtype.
+      Ghdl_Rtin_Subtype_Array : O_Tnode;
+      Ghdl_Rtin_Subtype_Array_Common : O_Fnode;
+      Ghdl_Rtin_Subtype_Array_Name : O_Fnode;
+      Ghdl_Rtin_Subtype_Array_Basetype : O_Fnode;
+      Ghdl_Rtin_Subtype_Array_Bounds : O_Fnode;
+      Ghdl_Rtin_Subtype_Array_Valsize : O_Fnode;
+      Ghdl_Rtin_Subtype_Array_Sigsize : O_Fnode;
+
+      --  Node for a record element.
+      Ghdl_Rtin_Element : O_Tnode;
+      Ghdl_Rtin_Element_Common : O_Fnode;
+      Ghdl_Rtin_Element_Name : O_Fnode;
+      Ghdl_Rtin_Element_Type : O_Fnode;
+      Ghdl_Rtin_Element_Valoff : O_Fnode;
+      Ghdl_Rtin_Element_Sigoff : O_Fnode;
+
+      --  Node for a record type.
+      Ghdl_Rtin_Type_Record : O_Tnode;
+      Ghdl_Rtin_Type_Record_Common : O_Fnode;
+      Ghdl_Rtin_Type_Record_Name : O_Fnode;
+      Ghdl_Rtin_Type_Record_Nbrel : O_Fnode;
+      Ghdl_Rtin_Type_Record_Elements : O_Fnode;
+      --Ghdl_Rtin_Type_Record_Valsize : O_Fnode;
+      --Ghdl_Rtin_Type_Record_Sigsize : O_Fnode;
+
+      --  Node for an object.
+      Ghdl_Rtin_Object : O_Tnode;
+      Ghdl_Rtin_Object_Common : O_Fnode;
+      Ghdl_Rtin_Object_Name : O_Fnode;
+      Ghdl_Rtin_Object_Loc : O_Fnode;
+      Ghdl_Rtin_Object_Type : O_Fnode;
+
+      --  Node for an instance.
+      Ghdl_Rtin_Instance : O_Tnode;
+      Ghdl_Rtin_Instance_Common : O_Fnode;
+      Ghdl_Rtin_Instance_Name : O_Fnode;
+      Ghdl_Rtin_Instance_Loc : O_Fnode;
+      Ghdl_Rtin_Instance_Parent : O_Fnode;
+      Ghdl_Rtin_Instance_Type : O_Fnode;
+
+      --  Node for a component.
+      Ghdl_Rtin_Component : O_Tnode;
+      Ghdl_Rtin_Component_Common : O_Fnode;
+      Ghdl_Rtin_Component_Name : O_Fnode;
+      Ghdl_Rtin_Component_Nbr_Child : O_Fnode;
+      Ghdl_Rtin_Component_Children : O_Fnode;
+
+      procedure Rti_Initialize
+      is
+      begin
+         --  Create type ghdl_rti_kind is (ghdl_rtik_typedef_bool, ...)
+         declare
+            Constr : O_Enum_List;
+         begin
+            Start_Enum_Type (Constr, 8);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_top"),
+               Ghdl_Rtik_Top);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_library"),
+               Ghdl_Rtik_Library);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_package"),
+               Ghdl_Rtik_Package);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_package_body"),
+               Ghdl_Rtik_Package_Body);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_entity"),
+               Ghdl_Rtik_Entity);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_architecture"),
+               Ghdl_Rtik_Architecture);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_process"),
+               Ghdl_Rtik_Process);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_block"),
+               Ghdl_Rtik_Block);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_if_generate"),
+               Ghdl_Rtik_If_Generate);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_for_generate"),
+               Ghdl_Rtik_For_Generate);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_instance"),
+               Ghdl_Rtik_Instance);
+
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_constant"),
+               Ghdl_Rtik_Constant);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_iterator"),
+               Ghdl_Rtik_Iterator);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_variable"),
+               Ghdl_Rtik_Variable);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_signal"),
+               Ghdl_Rtik_Signal);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_file"),
+               Ghdl_Rtik_File);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_port"),
+               Ghdl_Rtik_Port);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_generic"),
+               Ghdl_Rtik_Generic);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_alias"),
+               Ghdl_Rtik_Alias);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_guard"),
+               Ghdl_Rtik_Guard);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_component"),
+               Ghdl_Rtik_Component);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_attribute"),
+               Ghdl_Rtik_Attribute);
+
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_b2"),
+               Ghdl_Rtik_Type_B2);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_e8"),
+               Ghdl_Rtik_Type_E8);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_e32"),
+               Ghdl_Rtik_Type_E32);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_i32"),
+               Ghdl_Rtik_Type_I32);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_i64"),
+               Ghdl_Rtik_Type_I64);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_f64"),
+               Ghdl_Rtik_Type_F64);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_p32"),
+               Ghdl_Rtik_Type_P32);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_p64"),
+               Ghdl_Rtik_Type_P64);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_access"),
+               Ghdl_Rtik_Type_Access);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_array"),
+               Ghdl_Rtik_Type_Array);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_record"),
+               Ghdl_Rtik_Type_Record);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_type_file"),
+               Ghdl_Rtik_Type_File);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_subtype_scalar"),
+               Ghdl_Rtik_Subtype_Scalar);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_subtype_array"),
+               Ghdl_Rtik_Subtype_Array);
+            New_Enum_Literal
+              (Constr, Get_Identifier ("__ghdl_rtik_subtype_array_ptr"),
+               Ghdl_Rtik_Subtype_Array_Ptr);
+            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_unit"),
+                              Ghdl_Rtik_Unit);
+
+            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_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_rti_loc
+         declare
+            Constr : O_Element_List;
+         begin
+            Start_Union_Type (Constr);
+            New_Union_Field (Constr, Ghdl_Rti_Loc_Offset,
+                             Get_Identifier ("offset"), Ghdl_Index_Type);
+            New_Union_Field (Constr, Ghdl_Rti_Loc_Address,
+                             Get_Identifier ("address"), Ghdl_Ptr_Type);
+            Finish_Union_Type (Constr, Ghdl_Rti_Loc);
+            New_Type_Decl (Get_Identifier ("__ghdl_rti_loc"), Ghdl_Rti_Loc);
+         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_Rti_Loc);
+            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_Rti_Loc);
+            Finish_Record_Type (Constr, Ghdl_Rtin_Subtype_Scalar);
+            New_Type_Decl (Get_Identifier ("__ghdl_rtin_subtype_scalar"),
+                           Ghdl_Rtin_Subtype_Scalar);
+         end;
+
+         declare
+            Constr : O_Element_List;
+         begin
+            Start_Union_Type (Constr);
+            New_Union_Field (Constr, Ghdl_Rti_Unit_32,
+                             Get_Identifier ("unit_32"), Ghdl_I32_Type);
+            if not Flag_Only_32b then
+               New_Union_Field (Constr, Ghdl_Rti_Unit_64,
+                                Get_Identifier ("unit_64"), Ghdl_I64_Type);
+            end if;
+            New_Union_Field (Constr, Ghdl_Rti_Unit_Addr,
+                             Get_Identifier ("addr"), Ghdl_Ptr_Type);
+            Finish_Union_Type (Constr, Ghdl_Rti_Unit_Val);
+            New_Type_Decl (Get_Identifier ("__ghdl_rti_unit_val"),
+                           Ghdl_Rti_Unit_Val);
+         end;
+
+         --  Unit
+         declare
+            Constr : O_Element_List;
+         begin
+            Start_Record_Type (Constr);
+            New_Record_Field (Constr, Ghdl_Rtin_Unit_Common,
+                              Get_Identifier ("common"), Ghdl_Rti_Common);
+            New_Record_Field (Constr, Ghdl_Rtin_Unit_Name,
+                              Get_Identifier ("name"), Char_Ptr_Type);
+            New_Record_Field (Constr, Ghdl_Rtin_Unit_Value,
+                              Get_Identifier ("value"), Ghdl_Rti_Unit_Val);
+            Finish_Record_Type (Constr, Ghdl_Rtin_Unit);
+            New_Type_Decl (Get_Identifier ("__ghdl_rtin_unit"),
+                           Ghdl_Rtin_Unit);
+         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_Rti_Loc);
+            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Valsize,
+                              Get_Identifier ("val_size"), Ghdl_Rti_Loc);
+            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Sigsize,
+                              Get_Identifier ("sig_size"), Ghdl_Rti_Loc);
+            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);
+            --New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Valsize,
+            --                  Get_Identifier ("val_size"), Ghdl_Rti_Loc);
+            --New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Sigsize,
+            --                  Get_Identifier ("sig_size"), Ghdl_Rti_Loc);
+            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_Rti_Loc);
+            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_Rti_Loc);
+            New_Record_Field (Constr, Ghdl_Rtin_Instance_Parent,
+                              Wki_Parent, Ghdl_Rti_Access);
+            New_Record_Field (Constr, Ghdl_Rtin_Instance_Type,
+                              Get_Identifier ("instance"), Ghdl_Rti_Access);
+            Finish_Record_Type (Constr, Ghdl_Rtin_Instance);
+            New_Type_Decl (Get_Identifier ("__ghdl_rtin_instance"),
+                           Ghdl_Rtin_Instance);
+         end;
+
+         --  Component
+         declare
+            Constr : O_Element_List;
+         begin
+            Start_Record_Type (Constr);
+            New_Record_Field (Constr, Ghdl_Rtin_Component_Common,
+                              Get_Identifier ("common"), Ghdl_Rti_Common);
+            New_Record_Field (Constr, Ghdl_Rtin_Component_Name,
+                              Get_Identifier ("name"), Char_Ptr_Type);
+            New_Record_Field (Constr, Ghdl_Rtin_Component_Nbr_Child,
+                              Get_Identifier ("nbr_child"), Ghdl_Index_Type);
+            New_Record_Field (Constr, Ghdl_Rtin_Component_Children,
+                              Get_Identifier ("children"), Ghdl_Rti_Arr_Acc);
+            Finish_Record_Type (Constr, Ghdl_Rtin_Component);
+            New_Type_Decl (Get_Identifier ("__ghdl_rtin_component"),
+                           Ghdl_Rtin_Component);
+         end;
+
+      end Rti_Initialize;
+
+      type Rti_Array is array (1 .. 8) of O_Dnode;
+      type Rti_Array_List;
+      type Rti_Array_List_Acc is access Rti_Array_List;
+      type Rti_Array_List is record
+         Rtis : Rti_Array;
+         Next : Rti_Array_List_Acc;
+      end record;
+
+      type Rti_Block is record
+         Depth : Rti_Depth_Type;
+         Nbr : Integer;
+         List : Rti_Array_List;
+         Last_List : Rti_Array_List_Acc;
+         Last_Nbr : Integer;
+      end record;
+
+      Cur_Block : Rti_Block := (Depth => 0,
+                                Nbr => 0,
+                                List => (Rtis => (others => O_Dnode_Null),
+                                         Next => null),
+                                Last_List => null,
+                                Last_Nbr => 0);
+
+      Free_List : Rti_Array_List_Acc := null;
+
+      procedure Push_Rti_Node (Prev : out Rti_Block; Deeper : Boolean := True)
+      is
+         Ndepth : Rti_Depth_Type;
+      begin
+         if Deeper then
+            Ndepth := Cur_Block.Depth + 1;
+         else
+            Ndepth := Cur_Block.Depth;
+         end if;
+         Prev := Cur_Block;
+         Cur_Block := (Depth => Ndepth,
+                       Nbr => 0,
+                       List => (Rtis => (others => O_Dnode_Null),
+                                Next => null),
+                       Last_List => null,
+                       Last_Nbr => 0);
+      end Push_Rti_Node;
+
+      procedure Add_Rti_Node (Node : O_Dnode)
+      is
+      begin
+         if Node = O_Dnode_Null then
+            --  FIXME: temporary for not yet handled types.
+            return;
+         end if;
+         if Cur_Block.Last_Nbr = Rti_Array'Last then
+            declare
+               N : Rti_Array_List_Acc;
+            begin
+               if Free_List = null then
+                  N := new Rti_Array_List;
+               else
+                  N := Free_List;
+                  Free_List := N.Next;
+               end if;
+               N.Next := null;
+               if Cur_Block.Last_List = null then
+                  Cur_Block.List.Next := N;
+               else
+                  Cur_Block.Last_List.Next := N;
+               end if;
+               Cur_Block.Last_List := N;
+            end;
+            Cur_Block.Last_Nbr := 1;
+         else
+            Cur_Block.Last_Nbr := Cur_Block.Last_Nbr + 1;
+         end if;
+         if Cur_Block.Last_List = null then
+            Cur_Block.List.Rtis (Cur_Block.Last_Nbr) := Node;
+         else
+            Cur_Block.Last_List.Rtis (Cur_Block.Last_Nbr) := Node;
+         end if;
+         Cur_Block.Nbr := Cur_Block.Nbr + 1;
+      end Add_Rti_Node;
+
+      function Generate_Rti_Array (Id : O_Ident) return O_Dnode
+      is
+         Arr_Type : O_Tnode;
+         List : O_Array_Aggr_List;
+         L : Rti_Array_List_Acc;
+         Nbr : Integer;
+         Val : O_Cnode;
+         Res : O_Dnode;
+      begin
+         Arr_Type := New_Constrained_Array_Type
+           (Ghdl_Rti_Array,
+            New_Unsigned_Literal (Ghdl_Index_Type,
+                                  Unsigned_64 (Cur_Block.Nbr + 1)));
+         New_Const_Decl (Res, Id, O_Storage_Private, Arr_Type);
+         Start_Const_Value (Res);
+         Start_Array_Aggr (List, Arr_Type);
+         Nbr := Cur_Block.Nbr;
+         for I in Cur_Block.List.Rtis'Range loop
+            exit when I > Nbr;
+            New_Array_Aggr_El
+              (List, New_Global_Unchecked_Address (Cur_Block.List.Rtis (I),
+                                                   Ghdl_Rti_Access));
+         end loop;
+         L := Cur_Block.List.Next;
+         while L /= null loop
+            Nbr := Nbr - Cur_Block.List.Rtis'Length;
+            for I in L.Rtis'Range loop
+               exit when I > Nbr;
+               New_Array_Aggr_El
+                 (List, New_Global_Unchecked_Address (L.Rtis (I),
+                                                      Ghdl_Rti_Access));
+            end loop;
+            L := L.Next;
+         end loop;
+         New_Array_Aggr_El (List, New_Null_Access (Ghdl_Rti_Access));
+         Finish_Array_Aggr (List, Val);
+         Finish_Const_Value (Res, Val);
+         return Res;
+      end Generate_Rti_Array;
+
+      procedure Pop_Rti_Node (Prev : Rti_Block)
+      is
+         L : Rti_Array_List_Acc;
+      begin
+         L := Cur_Block.List.Next;
+         if L /= null then
+            Cur_Block.Last_List.Next := Free_List;
+            Free_List := Cur_Block.List.Next;
+            Cur_Block.List.Next := null;
+         end if;
+         Cur_Block := Prev;
+      end Pop_Rti_Node;
+
+      function Get_Depth_From_Var (Var : Var_Acc := null) return Rti_Depth_Type
+      is
+      begin
+         if Var = null or else Is_Var_Field (Var) then
+            return Cur_Block.Depth;
+         else
+            return 0;
+         end if;
+      end Get_Depth_From_Var;
+
+      function Generate_Common
+        (Kind : O_Cnode; Var : Var_Acc := null; Mode : Natural := 0)
+        return O_Cnode
+      is
+         List : O_Record_Aggr_List;
+         Res : O_Cnode;
+         Val : Unsigned_64;
+      begin
+         Start_Record_Aggr (List, Ghdl_Rti_Common);
+         New_Record_Aggr_El (List, Kind);
+         Val := Unsigned_64 (Get_Depth_From_Var (Var));
+         New_Record_Aggr_El (List, New_Unsigned_Literal (Ghdl_Rti_Depth, Val));
+         New_Record_Aggr_El
+           (List, New_Unsigned_Literal (Ghdl_Rti_U8, Unsigned_64 (Mode)));
+         New_Record_Aggr_El (List, New_Unsigned_Literal (Ghdl_Rti_Depth, 0));
+         Finish_Record_Aggr (List, Res);
+         return Res;
+      end Generate_Common;
+
+      --  Same as Generat_Common but for types.
+      function Generate_Common_Type (Kind : O_Cnode;
+                                     Depth : Rti_Depth_Type;
+                                     Max_Depth : Rti_Depth_Type;
+                                     Mode : Natural := 0)
+                                    return O_Cnode
+      is
+         List : O_Record_Aggr_List;
+         Res : O_Cnode;
+      begin
+         Start_Record_Aggr (List, Ghdl_Rti_Common);
+         New_Record_Aggr_El (List, Kind);
+         New_Record_Aggr_El
+           (List,
+            New_Unsigned_Literal (Ghdl_Rti_Depth, Unsigned_64 (Depth)));
+         New_Record_Aggr_El
+           (List, New_Unsigned_Literal (Ghdl_Rti_U8, Unsigned_64 (Mode)));
+         New_Record_Aggr_El
+           (List,
+            New_Unsigned_Literal (Ghdl_Rti_Depth, Unsigned_64 (Max_Depth)));
+         Finish_Record_Aggr (List, Res);
+         return Res;
+      end Generate_Common_Type;
+
+      function Generate_Name (Node : Iir) return O_Dnode
+      is
+         use Name_Table;
+         Id : Name_Id;
+      begin
+         Id := Get_Identifier (Node);
+         if Is_Character (Id) then
+            Name_Buffer (1) := ''';
+            Name_Buffer (2) := Get_Character (Id);
+            Name_Buffer (3) := ''';
+            Name_Length := 3;
+         else
+            Image (Id);
+         end if;
+         return Create_String (Name_Buffer (1 .. Name_Length),
+                               Create_Identifier ("RTISTR"));
+      end Generate_Name;
+
+      function Get_Null_Loc return O_Cnode is
+      begin
+         return New_Union_Aggr (Ghdl_Rti_Loc,
+                                Ghdl_Rti_Loc_Address,
+                                New_Null_Access (Ghdl_Ptr_Type));
+      end Get_Null_Loc;
+
+      function Var_Acc_To_Loc (Var : Var_Acc) return O_Cnode
+      is
+      begin
+         if Is_Var_Field (Var) then
+            return New_Union_Aggr (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset,
+                                   New_Offsetof (Get_Var_Field (Var),
+                                                 Ghdl_Index_Type));
+         else
+            return New_Union_Aggr
+              (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Address,
+               New_Global_Unchecked_Address (Get_Var_Label (Var),
+                                             Ghdl_Ptr_Type));
+         end if;
+      end Var_Acc_To_Loc;
+
+      --  Generate a name constant for the name of type definition DEF.
+      --  If DEF is an anonymous subtype, returns O_LNODE_NULL.
+      --  Use function NEW_NAME_ADDRESS (defined below) to convert the
+      --  result into an address expression.
+      function Generate_Type_Name (Def : Iir) return O_Dnode
+      is
+         Decl : Iir;
+      begin
+         Decl := Get_Type_Declarator (Def);
+         if Decl /= Null_Iir then
+            return Generate_Name (Decl);
+         else
+            return O_Dnode_Null;
+         end if;
+      end Generate_Type_Name;
+
+      --  Convert a name constant NAME into an address.
+      --  If NAME is O_LNODE_NULL, return a null address.
+      --  To be used with GENERATE_TYPE_NAME.
+      function New_Name_Address (Name : O_Dnode) return O_Cnode
+      is
+      begin
+         if Name = O_Dnode_Null then
+            return New_Null_Access (Char_Ptr_Type);
+         else
+            return New_Global_Unchecked_Address (Name, Char_Ptr_Type);
+         end if;
+      end New_Name_Address;
+
+      function New_Rti_Address (Rti : O_Dnode) return O_Cnode is
+      begin
+         return New_Global_Unchecked_Address (Rti, Ghdl_Rti_Access);
+      end New_Rti_Address;
+
+      --  Declare the RTI constant for type definition attached to INFO.
+      --  The only feature is not to declare it if it was already declared.
+      --  (due to an incomplete type declaration).
+      procedure Generate_Type_Rti (Info : Type_Info_Acc; Rti_Type : O_Tnode)
+      is
+      begin
+         if Info.Type_Rti = O_Dnode_Null then
+            New_Const_Decl (Info.Type_Rti, Create_Identifier ("RTI"),
+                            Global_Storage, Rti_Type);
+         end if;
+      end Generate_Type_Rti;
+
+      function Generate_Type_Definition (Atype : Iir; Force : Boolean := False)
+                                        return O_Dnode;
+
+      procedure Generate_Enumeration_Type_Definition (Atype : Iir)
+      is
+         Val : O_Cnode;
+         Info : Type_Info_Acc;
+      begin
+         Info := Get_Info (Atype);
+         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Enum);
+         Info.T.Rti_Max_Depth := 0;
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         declare
+            Lit_List : Iir_List := Get_Enumeration_Literal_List (Atype);
+            Nbr_Lit : Integer := Get_Nbr_Elements (Lit_List);
+            Lit : Iir;
+
+            type Dnode_Array is array (Natural range <>) of O_Dnode;
+            Name_Lits : Dnode_Array (0 .. Nbr_Lit - 1);
+            Mark : Id_Mark_Type;
+            Name_Arr_Type : O_Tnode;
+            Name_Arr : O_Dnode;
+
+            Arr_Aggr : O_Array_Aggr_List;
+            Rec_Aggr : O_Record_Aggr_List;
+            Kind : O_Cnode;
+            Name : O_Dnode;
+         begin
+            --  Generate name for each literal.
+            for I in Name_Lits'Range loop
+               Lit := Get_Nth_Element (Lit_List, I);
+               Push_Identifier_Prefix (Mark, Get_Identifier (Lit));
+               Name_Lits (I) := Generate_Name (Lit);
+               Pop_Identifier_Prefix (Mark);
+            end loop;
+
+            --  Generate array of names.
+            Name_Arr_Type := New_Constrained_Array_Type
+              (Char_Ptr_Array_Type,
+               New_Unsigned_Literal (Ghdl_Index_Type,
+                                     Unsigned_64 (Nbr_Lit)));
+            New_Const_Decl (Name_Arr, Create_Identifier ("RTINAMES"),
+                            O_Storage_Private, Name_Arr_Type);
+            Start_Const_Value (Name_Arr);
+            Start_Array_Aggr (Arr_Aggr, Name_Arr_Type);
+            for I in Name_Lits'Range loop
+               New_Array_Aggr_El
+                 (Arr_Aggr, New_Global_Address (Name_Lits (I), Char_Ptr_Type));
+            end loop;
+            Finish_Array_Aggr (Arr_Aggr, Val);
+            Finish_Const_Value (Name_Arr, Val);
+
+            Name := Generate_Type_Name (Atype);
+
+            Start_Const_Value (Info.Type_Rti);
+            case Info.Type_Mode is
+               when Type_Mode_B2 =>
+                  Kind := Ghdl_Rtik_Type_B2;
+               when Type_Mode_E8 =>
+                  Kind := Ghdl_Rtik_Type_E8;
+               when Type_Mode_E32 =>
+                  Kind := Ghdl_Rtik_Type_E32;
+               when others =>
+                  raise Internal_Error;
+            end case;
+            Start_Record_Aggr (Rec_Aggr, Ghdl_Rtin_Type_Enum);
+            New_Record_Aggr_El (Rec_Aggr, Generate_Common_Type (Kind, 0, 0));
+            New_Record_Aggr_El (Rec_Aggr, New_Name_Address (Name));
+            New_Record_Aggr_El
+              (Rec_Aggr, New_Unsigned_Literal (Ghdl_Index_Type,
+                                               Unsigned_64 (Nbr_Lit)));
+            New_Record_Aggr_El
+              (Rec_Aggr,
+               New_Global_Address (Name_Arr, Char_Ptr_Array_Ptr_Type));
+            Finish_Record_Aggr (Rec_Aggr, Val);
+            Finish_Const_Value (Info.Type_Rti, Val);
+         end;
+      end Generate_Enumeration_Type_Definition;
+
+      procedure Generate_Scalar_Type_Definition (Atype : Iir; Name : O_Dnode)
+      is
+         Info : Type_Info_Acc;
+         Kind : O_Cnode;
+         Val : O_Cnode;
+         List : O_Record_Aggr_List;
+      begin
+         Info := Get_Info (Atype);
+
+         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Scalar);
+         Info.T.Rti_Max_Depth := 0;
+
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         Start_Const_Value (Info.Type_Rti);
+         case Info.Type_Mode is
+            when Type_Mode_I32 =>
+               Kind := Ghdl_Rtik_Type_I32;
+            when Type_Mode_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;
+         Field : O_Fnode;
+         Const : O_Dnode;
+         Conv_Type : O_Tnode;
+         Unit_Type : Type_Info_Acc;
+         Info : Object_Info_Acc;
+      begin
+         Push_Identifier_Prefix (Mark, Get_Identifier (Unit));
+         Name := Generate_Name (Unit);
+         New_Const_Decl (Const, Create_Identifier ("RTI"),
+                         Global_Storage, Ghdl_Rtin_Unit);
+         Start_Const_Value (Const);
+         Start_Record_Aggr (Aggr, Ghdl_Rtin_Unit);
+         New_Record_Aggr_El (Aggr, Generate_Common (Ghdl_Rtik_Unit));
+         New_Record_Aggr_El (Aggr, New_Name_Address (Name));
+         Info := Get_Info (Unit);
+         if Info /= null then
+            --  Handle non-static units.  The only possibility is a unit of
+            --  std.standard.time.
+            Field := Ghdl_Rti_Unit_Addr;
+            Val := New_Global_Unchecked_Address
+              (Get_Var_Label (Info.Object_Var), Ghdl_Ptr_Type);
+         else
+            Unit_Type := Get_Info (Get_Type (Unit));
+            case Unit_Type.Type_Mode is
+               when Type_Mode_P64 =>
+                  Field := Ghdl_Rti_Unit_64;
+                  Conv_Type := Ghdl_I64_Type;
+               when Type_Mode_P32 =>
+                  Field := Ghdl_Rti_Unit_32;
+                  Conv_Type := Ghdl_I32_Type;
+               when others =>
+                  raise Internal_Error;
+            end case;
+            Val := Chap7.Translate_Numeric_Literal (Unit, Conv_Type);
+         end if;
+         New_Record_Aggr_El
+           (Aggr, New_Union_Aggr (Ghdl_Rti_Unit_Val, Field, 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;
+         Mode : Integer;
+         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);
+         if Get_Info (Unit) /= null then
+            Mode := 1;
+         else
+            Mode := 0;
+         end if;
+         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, Mode));
+         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_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 Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+               Base_Type := Get_Base_Type (Atype);
+               Base := Get_Info (Base_Type).Type_Rti;
+               Kind := Ghdl_Rtik_Subtype_Unconstrained_Array;
+            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 : Iir_List;
+         Nbr_Indexes : Integer;
+         Index : Iir;
+         Tmp : O_Dnode;
+         Arr_Type : O_Tnode;
+         Arr_Aggr : O_Array_Aggr_List;
+         Val : O_Cnode;
+         Mark : Id_Mark_Type;
+      begin
+         --  Translate each index.
+         List := Get_Index_Subtype_List (Atype);
+         Nbr_Indexes := Get_Nbr_Elements (List);
+         for I in 1 .. Nbr_Indexes loop
+            Index := Get_Nth_Element (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 0 .. Nbr_Indexes - 1 loop
+            Index := Get_Nth_Element (List, I);
+            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 (Info : Type_Info_Acc) return Natural is
+      begin
+         if Info.C /= null then
+            return 1;
+         else
+            return 0;
+         end if;
+      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;
+            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 (Info)));
+         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;
+         Bounds : Var_Acc;
+         Name : O_Dnode;
+         Kind : O_Cnode;
+         Mark : Id_Mark_Type;
+         Depth : Rti_Depth_Type;
+      begin
+         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_Ptr_Array =>
+               Kind := Ghdl_Rtik_Subtype_Array_Ptr;
+            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 (Info)));
+         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 (Bounds));
+         for I in Mode_Value .. Mode_Signal loop
+            if I = Mode_Signal and then not Get_Signal_Type_Flag (Atype) then
+               Val := Get_Null_Loc;
+            else
+               case Info.Type_Mode is
+                  when Type_Mode_Array =>
+                     Val := New_Union_Aggr (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset,
+                                            New_Sizeof (Info.Ortho_Type (I),
+                                                        Ghdl_Index_Type));
+                  when Type_Mode_Ptr_Array =>
+                     Val := Var_Acc_To_Loc (Info.C.Size_Var (I));
+                  when others =>
+                     Error_Kind ("generate_array_subtype_definition", Atype);
+               end case;
+            end if;
+            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_Chain : Iir;
+         El : Iir;
+         Prev : Rti_Block;
+         El_Arr : O_Dnode;
+         Res : O_Cnode;
+         Info : Type_Info_Acc;
+         Max_Depth : Rti_Depth_Type;
+      begin
+         Info := Get_Info (Atype);
+         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Record);
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
+
+         El_Chain := Get_Element_Declaration_Chain (Atype);
+         Max_Depth := 0;
+
+         --  Generate elements.
+         Push_Rti_Node (Prev, False);
+         El := El_Chain;
+         while El /= Null_Iir loop
+            declare
+               Type_Rti : O_Dnode;
+               El_Name : O_Dnode;
+               El_Type : Iir;
+               Aggr : O_Record_Aggr_List;
+               Field_Info : Field_Info_Acc;
+               Val : O_Cnode;
+               El_Const : O_Dnode;
+               Mark : Id_Mark_Type;
+            begin
+               Push_Identifier_Prefix (Mark, Get_Identifier (El));
+
+               El_Type := Get_Type (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);
+               Field_Info := Get_Info (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 (Field_Info.Field_Node (I),
+                                          Ghdl_Index_Type);
+                  else
+                     Val := New_Unsigned_Literal (Ghdl_Index_Type, 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;
+            El := Get_Chain (El);
+         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 (Info)));
+            New_Record_Aggr_El (Aggr, New_Name_Address (Name));
+            New_Record_Aggr_El
+              (Aggr, New_Unsigned_Literal
+               (Ghdl_Index_Type,
+                Unsigned_64 (Get_Number_Element_Declaration (Atype))));
+            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 (Info)));
+         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 : Type_Info_Acc;
+      begin
+         Info := Get_Info (Atype);
+         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
+              | Iir_Kind_Unconstrained_Array_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 : Iir;
+         Info : Type_Info_Acc;
+         Rti_Type : O_Tnode;
+      begin
+         Ndef := Get_Type (Get_Type_Declarator (Def));
+         Info := Get_Info (Ndef);
+         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
+         Rti : O_Dnode;
+         Mark : Id_Mark_Type;
+         Id : Name_Id;
+         Def : Iir;
+      begin
+         Id := Get_Identifier (Decl);
+         Push_Identifier_Prefix (Mark, Id);
+         Def := Get_Type (Decl);
+         if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
+            Rti := Generate_Incomplete_Type_Definition (Def);
+         else
+            Rti := Generate_Type_Definition (Def, True);
+         end if;
+         Pop_Identifier_Prefix (Mark);
+         return Rti;
+      end Generate_Type_Decl;
+
+      procedure Generate_Signal_Rti (Sig : Iir)
+      is
+         Info : Object_Info_Acc;
+      begin
+         Info := Get_Info (Sig);
+         New_Const_Decl (Info.Object_Rti, Create_Identifier (Sig, "__RTI"),
+                         Global_Storage, Ghdl_Rtin_Object);
+      end Generate_Signal_Rti;
+
+      procedure Generate_Object (Decl : Iir; Rti : in out O_Dnode)
+      is
+         Decl_Type : Iir;
+         Type_Info : Type_Info_Acc;
+         Name : O_Dnode;
+         Comm : O_Cnode;
+         Val : O_Cnode;
+         List : O_Record_Aggr_List;
+         Info : Ortho_Info_Acc;
+         Mark : Id_Mark_Type;
+         Var : Var_Acc;
+         Mode : Natural;
+         Has_Id : Boolean;
+      begin
+         case Get_Kind (Decl) is
+            when Iir_Kind_Transaction_Attribute
+              | Iir_Kind_Stable_Attribute
+              | Iir_Kind_Quiet_Attribute
+              | Iir_Kind_Delayed_Attribute =>
+               Has_Id := False;
+               Push_Identifier_Prefix_Uniq (Mark);
+            when others =>
+               Has_Id := True;
+               Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+         end case;
+
+         if Rti = O_Dnode_Null then
+            New_Const_Decl (Rti, Create_Identifier ("RTI"),
+                            Global_Storage, Ghdl_Rtin_Object);
+         end if;
+
+         if Global_Storage /= O_Storage_External then
+            Decl_Type := Get_Type (Decl);
+            Type_Info := Get_Info (Decl_Type);
+            if Type_Info.Type_Rti = O_Dnode_Null then
+               declare
+                  Mark : Id_Mark_Type;
+                  Tmp : O_Dnode;
+               begin
+                  Push_Identifier_Prefix (Mark, "OT");
+                  Tmp := Generate_Type_Definition (Decl_Type);
+                  Pop_Identifier_Prefix (Mark);
+               end;
+            end if;
+
+            if Has_Id then
+               Name := Generate_Name (Decl);
+            else
+               Name := O_Dnode_Null;
+            end if;
+
+            Info := Get_Info (Decl);
+
+            Start_Const_Value (Rti);
+            Start_Record_Aggr (List, Ghdl_Rtin_Object);
+            Mode := 0;
+            case Get_Kind (Decl) is
+               when Iir_Kind_Signal_Declaration =>
+                  Comm := Ghdl_Rtik_Signal;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Signal_Interface_Declaration =>
+                  Comm := Ghdl_Rtik_Port;
+                  Var := Info.Object_Var;
+                  Mode := Iir_Mode'Pos (Get_Mode (Decl));
+               when Iir_Kind_Constant_Declaration =>
+                  Comm := Ghdl_Rtik_Constant;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Constant_Interface_Declaration =>
+                  Comm := Ghdl_Rtik_Generic;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Variable_Declaration =>
+                  Comm := Ghdl_Rtik_Variable;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Guard_Signal_Declaration =>
+                  Comm := Ghdl_Rtik_Guard;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Iterator_Declaration =>
+                  Comm := Ghdl_Rtik_Iterator;
+                  Var := Info.Iterator_Var;
+               when Iir_Kind_File_Declaration =>
+                  Comm := Ghdl_Rtik_File;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Attribute_Declaration =>
+                  Comm := Ghdl_Rtik_Attribute;
+                  Var := null;
+               when Iir_Kind_Transaction_Attribute =>
+                  Comm := Ghdl_Rtik_Attribute_Transaction;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Quiet_Attribute =>
+                  Comm := Ghdl_Rtik_Attribute_Quiet;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Stable_Attribute =>
+                  Comm := Ghdl_Rtik_Attribute_Stable;
+                  Var := Info.Object_Var;
+               when Iir_Kind_Object_Alias_Declaration =>
+                  Comm := Ghdl_Rtik_Alias;
+                  Var := Info.Alias_Var;
+                  Mode := Object_Kind_Type'Pos (Info.Alias_Kind);
+               when others =>
+                  Error_Kind ("rti.generate_object", Decl);
+            end case;
+            case Get_Kind (Decl) is
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Signal_Interface_Declaration =>
+                  Mode := Mode
+                    + 16 * Iir_Signal_Kind'Pos (Get_Signal_Kind (Decl));
+               when others =>
+                  null;
+            end case;
+            case Get_Kind (Decl) is
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Signal_Interface_Declaration
+                 | Iir_Kind_Guard_Signal_Declaration
+                 | Iir_Kind_Transaction_Attribute
+                 | Iir_Kind_Stable_Attribute
+                 | Iir_Kind_Quiet_Attribute
+                 | Iir_Kind_Delayed_Attribute =>
+                  if Get_Has_Active_Flag (Decl) then
+                     Mode := Mode + 64;
+                  end if;
+               when others =>
+                  null;
+            end case;
+            New_Record_Aggr_El (List, Generate_Common (Comm, Var, Mode));
+            New_Record_Aggr_El (List, New_Name_Address (Name));
+            if Var = null then
+               Val := Get_Null_Loc;
+            else
+               Val := Var_Acc_To_Loc (Var);
+            end if;
+            New_Record_Aggr_El (List, Val);
+            New_Record_Aggr_El (List, New_Rti_Address (Type_Info.Type_Rti));
+            Finish_Record_Aggr (List, Val);
+            Finish_Const_Value (Rti, Val);
+         end if;
+         Pop_Identifier_Prefix (Mark);
+      end Generate_Object;
+
+      procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode);
+      procedure Generate_Declaration_Chain (Chain : Iir);
+
+      procedure Generate_Component_Declaration (Comp : Iir)
+      is
+         Prev : Rti_Block;
+         Name : O_Dnode;
+         Arr : O_Dnode;
+         List : O_Record_Aggr_List;
+         Res : O_Cnode;
+         Mark : Id_Mark_Type;
+         Info : Comp_Info_Acc;
+      begin
+         Push_Identifier_Prefix (Mark, Get_Identifier (Comp));
+         Info := Get_Info (Comp);
+
+         New_Const_Decl (Info.Comp_Rti_Const, Create_Identifier ("RTI"),
+                         Global_Storage, Ghdl_Rtin_Component);
+
+         if Global_Storage /= O_Storage_External then
+            Push_Rti_Node (Prev);
+
+            Generate_Declaration_Chain (Get_Generic_Chain (Comp));
+            Generate_Declaration_Chain (Get_Port_Chain (Comp));
+
+            Name := Generate_Name (Comp);
+
+            Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY"));
+
+            Start_Const_Value (Info.Comp_Rti_Const);
+            Start_Record_Aggr (List, Ghdl_Rtin_Component);
+            New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Component));
+            New_Record_Aggr_El (List,
+                                New_Global_Address (Name, Char_Ptr_Type));
+            New_Record_Aggr_El
+              (List, New_Unsigned_Literal (Ghdl_Index_Type,
+                                           Unsigned_64 (Cur_Block.Nbr)));
+            New_Record_Aggr_El (List,
+                                New_Global_Address (Arr, Ghdl_Rti_Arr_Acc));
+            Finish_Record_Aggr (List, Res);
+            Finish_Const_Value (Info.Comp_Rti_Const, Res);
+            Pop_Rti_Node (Prev);
+         end if;
+
+         Pop_Identifier_Prefix (Mark);
+         Add_Rti_Node (Info.Comp_Rti_Const);
+      end Generate_Component_Declaration;
+
+      procedure Generate_Instance (Stmt : Iir; Parent : O_Dnode)
+      is
+         Name : O_Dnode;
+         List : O_Record_Aggr_List;
+         Val : O_Cnode;
+         Inst : Iir;
+         Info : Block_Info_Acc;
+      begin
+         Name := Generate_Name (Stmt);
+         Info := Get_Info (Stmt);
+
+         New_Const_Decl (Info.Block_Rti_Const, Create_Identifier ("RTI"),
+                         Global_Storage, Ghdl_Rtin_Instance);
+
+         Inst := Get_Instantiated_Unit (Stmt);
+         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_Union_Aggr (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset,
+                                  New_Offsetof (Info.Block_Parent_Field,
+                                                Ghdl_Index_Type)));
+         New_Record_Aggr_El (List, New_Rti_Address (Parent));
+         case Get_Kind (Inst) is
+            when Iir_Kind_Component_Declaration =>
+               Val := New_Rti_Address (Get_Info (Inst).Comp_Rti_Const);
+            when Iir_Kind_Entity_Aspect_Entity =>
+               declare
+                  Ent : Iir;
+               begin
+                  Ent := Get_Library_Unit (Get_Entity (Inst));
+                  Val := New_Rti_Address (Get_Info (Ent).Block_Rti_Const);
+               end;
+            when Iir_Kind_Entity_Aspect_Configuration =>
+               declare
+                  Config : Iir;
+                  Ent : Iir;
+               begin
+                  Config := Get_Library_Unit (Get_Configuration (Inst));
+                  Ent := Get_Library_Unit (Get_Entity (Config));
+                  Val := New_Rti_Address (Get_Info (Ent).Block_Rti_Const);
+               end;
+            when others =>
+               Val := New_Null_Access (Ghdl_Rti_Access);
+         end case;
+
+         New_Record_Aggr_El (List, Val);
+         Finish_Record_Aggr (List, Val);
+         Finish_Const_Value (Info.Block_Rti_Const, Val);
+         Add_Rti_Node (Info.Block_Rti_Const);
+      end Generate_Instance;
+
+      procedure Generate_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_Type_Declaration
+                 | Iir_Kind_Subtype_Declaration =>
+                  Add_Rti_Node (Generate_Type_Decl (Decl));
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Signal_Interface_Declaration
+                 | Iir_Kind_Constant_Declaration
+                 | Iir_Kind_Constant_Interface_Declaration
+                 | Iir_Kind_Variable_Declaration
+                 | Iir_Kind_File_Declaration
+                 | Iir_Kind_Transaction_Attribute
+                 | Iir_Kind_Quiet_Attribute
+                 | Iir_Kind_Stable_Attribute =>
+                  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_Function_Body
+                 | Iir_Kind_Procedure_Declaration
+                 | Iir_Kind_Procedure_Body =>
+                  --  FIXME: to be added (for foreign).
+                  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", 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 others =>
+                  Error_Kind ("rti.generate_concurrent_statement_chain", Stmt);
+            end case;
+            Stmt := Get_Chain (Stmt);
+         end loop;
+      end Generate_Concurrent_Statement_Chain;
+
+      procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode)
+      is
+         Name : O_Dnode;
+         Arr : O_Dnode;
+         List : O_Record_Aggr_List;
+
+         Rti : O_Dnode;
+
+         Kind : O_Cnode;
+         Res : O_Cnode;
+
+         Prev : Rti_Block;
+         Info : Ortho_Info_Acc;
+
+         Field : O_Fnode;
+         Inst : O_Tnode;
+      begin
+         --  The type of a generator iterator is elaborated in the parent.
+         if Get_Kind (Blk) = Iir_Kind_Generate_Statement then
+            declare
+               Scheme : Iir;
+               Iter_Type : Iir;
+               Type_Info : Type_Info_Acc;
+               Mark : Id_Mark_Type;
+               Tmp : O_Dnode;
+            begin
+               Scheme := Get_Generation_Scheme (Blk);
+               if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                  Iter_Type := Get_Type (Scheme);
+                  Type_Info := Get_Info (Iter_Type);
+                  if Type_Info.Type_Rti = O_Dnode_Null then
+                     Push_Identifier_Prefix (Mark, "ITERATOR");
+                     Tmp := Generate_Type_Definition (Iter_Type);
+                     Add_Rti_Node (Tmp);
+                     Pop_Identifier_Prefix (Mark);
+                  end if;
+               end if;
+            end;
+         end if;
+
+         New_Const_Decl (Rti, Create_Identifier ("RTI"),
+                         O_Storage_Public, Ghdl_Rtin_Block);
+         Push_Rti_Node (Prev);
+
+         Field := O_Fnode_Null;
+         Inst := O_Tnode_Null;
+         Info := Get_Info (Blk);
+         case Get_Kind (Blk) is
+            when Iir_Kind_Package_Declaration =>
+               Kind := Ghdl_Rtik_Package;
+               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            when Iir_Kind_Package_Body =>
+               Kind := Ghdl_Rtik_Package_Body;
+               -- FIXME: yes or not ?
+               --Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            when Iir_Kind_Architecture_Declaration =>
+               Kind := Ghdl_Rtik_Architecture;
+               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+               Generate_Concurrent_Statement_Chain
+                 (Get_Concurrent_Statement_Chain (Blk), Rti);
+               Field := Info.Block_Parent_Field;
+               Inst := Info.Block_Decls_Type;
+            when Iir_Kind_Entity_Declaration =>
+               Kind := Ghdl_Rtik_Entity;
+               Generate_Declaration_Chain (Get_Generic_Chain (Blk));
+               Generate_Declaration_Chain (Get_Port_Chain (Blk));
+               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+               Generate_Concurrent_Statement_Chain
+                 (Get_Concurrent_Statement_Chain (Blk), Rti);
+               Inst := Info.Block_Decls_Type;
+            when Iir_Kind_Process_Statement
+              | Iir_Kind_Sensitized_Process_Statement =>
+               Kind := Ghdl_Rtik_Process;
+               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+               Field := Info.Process_Parent_Field;
+               Inst := Info.Process_Decls_Type;
+            when Iir_Kind_Block_Statement =>
+               Kind := Ghdl_Rtik_Block;
+               declare
+                  Guard : Iir;
+                  Header : Iir;
+                  Guard_Info : Object_Info_Acc;
+               begin
+                  Guard := Get_Guard_Decl (Blk);
+                  if Guard /= Null_Iir then
+                     Guard_Info := Get_Info (Guard);
+                     Generate_Object (Guard, Guard_Info.Object_Rti);
+                     Add_Rti_Node (Guard_Info.Object_Rti);
+                  end if;
+                  Header := Get_Block_Header (Blk);
+                  if Header /= Null_Iir then
+                     Generate_Declaration_Chain (Get_Generic_Chain (Header));
+                     Generate_Declaration_Chain (Get_Port_Chain (Header));
+                  end if;
+               end;
+               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+               Generate_Concurrent_Statement_Chain
+                 (Get_Concurrent_Statement_Chain (Blk), Rti);
+               Field := Info.Block_Parent_Field;
+               Inst := Info.Block_Decls_Type;
+            when Iir_Kind_Generate_Statement =>
+               declare
+                  Scheme : Iir;
+                  Scheme_Rti : O_Dnode := O_Dnode_Null;
+               begin
+                  Scheme := Get_Generation_Scheme (Blk);
+                  if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                     Generate_Object (Scheme, Scheme_Rti);
+                     Add_Rti_Node (Scheme_Rti);
+                     Kind := Ghdl_Rtik_For_Generate;
+                  else
+                     Kind := Ghdl_Rtik_If_Generate;
+                  end if;
+               end;
+               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+               Generate_Concurrent_Statement_Chain
+                 (Get_Concurrent_Statement_Chain (Blk), Rti);
+               Field := Info.Block_Parent_Field;
+               Inst := Info.Block_Decls_Type;
+            when others =>
+               Error_Kind ("rti.generate_block", Blk);
+         end case;
+
+         Name := Generate_Name (Blk);
+
+         Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY"));
+
+         Start_Const_Value (Rti);
+         Start_Record_Aggr (List, Ghdl_Rtin_Block);
+         New_Record_Aggr_El (List, Generate_Common (Kind));
+         New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
+         if Field = O_Fnode_Null then
+            Res := Get_Null_Loc;
+         else
+            Res := New_Union_Aggr (Ghdl_Rti_Loc,
+                                   Ghdl_Rti_Loc_Offset,
+                                   New_Offsetof (Field, Ghdl_Index_Type));
+         end if;
+         New_Record_Aggr_El (List, Res);
+         if Parent_Rti = O_Dnode_Null then
+            Res := New_Null_Access (Ghdl_Rti_Access);
+         else
+            Res := New_Rti_Address (Parent_Rti);
+         end if;
+         New_Record_Aggr_El (List, Res);
+         if Inst = O_Tnode_Null then
+            Res := New_Unsigned_Literal (Ghdl_Index_Type, 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_Declaration
+              | 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_Declaration =>
+               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_Architecture_Declaration =>
+                  Info.Block_Rti_Const := Rti;
+               when 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);
+                     Info.Package_Rti_Const := Rti;
+                  end;
+               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_Declaration =>
+                  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 (Arch : Iir)
+      is
+         use Configuration;
+
+         Unit : Iir_Design_Unit;
+         Lib_Unit : Iir;
+         Lib : Iir_Library_Declaration;
+         Arr : O_Dnode;
+         Res : O_Cnode;
+         Aggr : O_Record_Aggr_List;
+         Prev : Rti_Block;
+      begin
+         Push_Rti_Node (Prev);
+         Add_Rti_Node (Get_Info (Standard_Package).Package_Rti_Const);
+         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);
+
+            Lib_Unit := Get_Library_Unit (Unit);
+            case Get_Kind (Lib_Unit) is
+               when Iir_Kind_Package_Declaration =>
+                  Add_Rti_Node (Get_Info (Lib_Unit).Package_Rti_Const);
+               when others =>
+                  null;
+            end case;
+         end loop;
+         Arr := Generate_Rti_Array (Get_Identifier ("__ghdl_top_RTIARRAY"));
+         New_Const_Decl (Ghdl_Rti_Top, Get_Identifier ("__ghdl_rti_top"),
+                         O_Storage_Public, Ghdl_Rtin_Block);
+         Start_Const_Value (Ghdl_Rti_Top);
+         Start_Record_Aggr (Aggr, Ghdl_Rtin_Block);
+         New_Record_Aggr_El (Aggr, Generate_Common (Ghdl_Rtik_Top));
+         New_Record_Aggr_El (Aggr, New_Null_Access (Char_Ptr_Type));
+         New_Record_Aggr_El (Aggr, Get_Null_Loc);
+         New_Record_Aggr_El
+           (Aggr, New_Rti_Address (Get_Info (Arch).Block_Rti_Const));
+         New_Record_Aggr_El (Aggr, New_Unsigned_Literal (Ghdl_Index_Type, 0));
+         New_Record_Aggr_El
+           (Aggr, New_Unsigned_Literal (Ghdl_Index_Type,
+                                        Unsigned_64 (Cur_Block.Nbr)));
+         New_Record_Aggr_El (Aggr, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc));
+         Finish_Record_Aggr (Aggr, Res);
+         Finish_Const_Value (Ghdl_Rti_Top, Res);
+         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_Declaration
+              | 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 others =>
+               Error_Kind ("get_context_rti", Node);
+         end case;
+         return New_Rti_Address (Rti_Const);
+      end Get_Context_Rti;
+
+      function Get_Context_Addr (Node : Iir) return O_Enode
+      is
+         Node_Info : Ortho_Info_Acc;
+
+         Block_Type : O_Tnode;
+      begin
+         Node_Info := Get_Info (Node);
+
+         case Get_Kind (Node) is
+            when Iir_Kind_Component_Declaration =>
+               Block_Type := Node_Info.Comp_Type;
+            when Iir_Kind_Entity_Declaration
+              | Iir_Kind_Architecture_Declaration
+              | Iir_Kind_Block_Statement
+              | Iir_Kind_Generate_Statement =>
+               Block_Type := Node_Info.Block_Decls_Type;
+            when Iir_Kind_Package_Declaration
+              | Iir_Kind_Package_Body =>
+               return New_Lit (New_Null_Access (Ghdl_Ptr_Type));
+            when Iir_Kind_Process_Statement
+              | Iir_Kind_Sensitized_Process_Statement =>
+               Block_Type := Node_Info.Process_Decls_Type;
+            when others =>
+               Error_Kind ("get_context_addr", Node);
+         end case;
+         return New_Unchecked_Address (Get_Instance_Ref (Block_Type),
+                                       Ghdl_Ptr_Type);
+      end Get_Context_Addr;
+
+      procedure Associate_Rti_Context (Assoc : in out O_Assoc_List; Node : Iir)
+      is
+      begin
+         New_Association (Assoc, New_Lit (Get_Context_Rti (Node)));
+         New_Association (Assoc, Get_Context_Addr (Node));
+      end Associate_Rti_Context;
+
+      procedure Associate_Null_Rti_Context (Assoc : in out O_Assoc_List) is
+      begin
+         New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Rti_Access)));
+         New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type)));
+      end Associate_Null_Rti_Context;
+   end Rtis;
+
+   procedure Gen_Filename (Design_File : Iir)
+   is
+      Info : Design_File_Info_Acc;
+   begin
+      if Current_Filename_Node /= O_Dnode_Null then
+         raise Internal_Error;
+      end if;
+      Info := Get_Info (Design_File);
+      if Info = null then
+         Info := Add_Info (Design_File, Kind_Design_File);
+         Info.Design_Filename := Create_String
+           (Get_Design_File_Filename (Design_File),
+            Create_Uniq_Identifier, O_Storage_Private);
+      end if;
+      Current_Filename_Node := Info.Design_Filename;
+   end Gen_Filename;
+
+   --  Decorate the tree in order to be usable with the internal simulator.
+   procedure Translate (Unit : Iir_Design_Unit; Main : Boolean)
+   is
+      Design_File : Iir_Design_File;
+      El : Iir;
+      Lib : Iir_Library_Declaration;
+      Lib_Mark, Ent_Mark, Sep_Mark, Unit_Mark : Id_Mark_Type;
+      Id : Name_Id;
+   begin
+      Update_Node_Infos;
+
+      Design_File := Get_Design_File (Unit);
+
+      if False then
+         El := Get_Context_Items (Unit);
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Use_Clause =>
+                  null;
+               when Iir_Kind_Library_Clause =>
+                  null;
+               when others =>
+                  Error_Kind ("translate1", El);
+            end case;
+         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_Declaration 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)));
+
+      case Get_Kind (El) is
+         when Iir_Kind_Package_Declaration =>
+            New_Debug_Comment_Decl
+              ("package declaration " & Image_Identifier (El));
+            Chap2.Translate_Package_Declaration (El);
+         when Iir_Kind_Package_Body =>
+            New_Debug_Comment_Decl ("package body " & Image_Identifier (El));
+            --Push_Global_Factory (O_Storage_Private);
+            Chap2.Translate_Package_Body (El);
+            --Pop_Global_Factory;
+         when Iir_Kind_Entity_Declaration =>
+            New_Debug_Comment_Decl ("entity " & Image_Identifier (El));
+            --Set_Global_Storage (O_Storage_Private);
+            Chap1.Translate_Entity_Declaration (El);
+         when Iir_Kind_Architecture_Declaration =>
+            New_Debug_Comment_Decl ("architecture " & Image_Identifier (El));
+            --Set_Global_Storage (O_Storage_Private);
+            Chap1.Translate_Architecture_Declaration (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 : Iir;
+               begin
+                  --  Note: this is done inside the architecture identifier.
+                  Entity := Get_Library_Unit (Get_Entity (El));
+                  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_Entity);
+                  Pop_Identifier_Prefix (Mark_Sep);
+                  Pop_Identifier_Prefix (Mark_Arch);
+               end;
+            else
+               Chap1.Translate_Configuration_Declaration (El);
+            end if;
+         when others =>
+            Error_Kind ("translate", El);
+      end case;
+
+      Current_Filename_Node := O_Dnode_Null;
+
+      --Pop_Global_Factory;
+      if Id /= Null_Identifier then
+         Pop_Identifier_Prefix (Unit_Mark);
+      end if;
+      if Get_Kind (El) = Iir_Kind_Architecture_Declaration 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
+      Node_Infos.Init;
+      Node_Infos.Set_Last (4);
+      Node_Infos.Table (0 .. 4) := (others => null);
+      New_Debug_Comment_Decl ("internal declarations, part 1");
+      --  Give a name to sizetype.
+      --Finish_Type_Decl (Sizetype, Get_Identifier ("__ghdl_size_t"));
+
+      -- 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_Kind := Get_Identifier ("kind");
+      Wki_Dim := Get_Identifier ("dim");
+      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");
+
+      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_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);
+      Const_Ptr_Type_Node := Ghdl_Ptr_Type;
+      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 : __ghdl_str_len_ptr;
+      --     line : integer;
+      --     col : Integer;
+      --  end record;
+      declare
+         Constr : O_Element_List;
+      begin
+         Start_Record_Type (Constr);
+         New_Record_Field (Constr, Ghdl_Location_Filename_Node,
+                           Get_Identifier ("filename"),
+                           Char_Ptr_Type);
+         New_Record_Field (Constr, Ghdl_Location_Line_Node,
+                           Get_Identifier ("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 -- (loc : __ghdl_location_acc);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_program_error"),
+         O_Storage_External);
+      --New_Interface_Decl (Interfaces, Param,
+      --                    Get_Identifier ("location"),
+      --                    Ghdl_Location_Ptr_Node);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Program_Error);
+
+      --  procedure __ghdl_bound_check_failed_l0;
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_bound_check_failed_l0"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("index"),
+                          Ghdl_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed_L0);
+
+      --  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, Get_Identifier ("filename"), Char_Ptr_Type);
+      New_Interface_Decl
+        (Interfaces, Param, Get_Identifier ("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;
+   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, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type);
+      Finish_Subprogram_Decl (Interfaces, Init_Signal);
+
+      --  procedure __ghdl_signal_simple_assign_XXX (sign : __ghdl_signal_ptr;
+      --                                             val : VAL_TYPE);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_simple_assign_" & Suffix),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type);
+      Finish_Subprogram_Decl (Interfaces, Simple_Assign);
+
+      --  procedure __ghdl_signal_start_assign_XXX (sign : __ghdl_signal_ptr;
+      --                                            reject : std_time;
+      --                                            val : VAL_TYPE;
+      --                                            after : std_time);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_" & Suffix),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
+                          Std_Time_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
+                          Val_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Start_Assign);
+
+      --  procedure __ghdl_signal_next_assign_XXX (sign : __ghdl_signal_ptr;
+      --                                            val : VAL_TYPE;
+      --                                            after : std_time);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_" & Suffix),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
+                          Val_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Next_Assign);
+
+      --  procedure __ghdl_signal_associate_XXX (sign : __ghdl_signal_ptr;
+      --                                        val : VAL_TYPE);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_associate_" & Suffix),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
+                          Val_Type);
+      Finish_Subprogram_Decl (Interfaces, Associate_Value);
+
+      --  function __ghdl_signal_driving_value_XXX (sign : __ghdl_signal_ptr)
+      --     return VAL_TYPE;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_driving_value_" & Suffix),
+         O_Storage_External, Val_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Driving_Value);
+   end Create_Signal_Subprograms;
+
+   --  procedure __ghdl_image_NAME (res : std_string_ptr_node;
+   --                               val : VAL_TYPE;
+   --                               rti : ghdl_rti_access);
+   --
+   --  function __ghdl_value_NAME (val : std_string_ptr_node;
+   --                              rti : ghdl_rti_access);
+   --      return VAL_TYPE;
+   procedure Create_Image_Value_Subprograms (Name : String;
+                                             Val_Type : O_Tnode;
+                                             Has_Td : Boolean;
+                                             Image_Subprg : out O_Dnode;
+                                             Value_Subprg : out O_Dnode)
+   is
+      Interfaces : O_Inter_List;
+      Param : O_Dnode;
+   begin
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_image_" & Name),
+         O_Storage_External);
+      New_Interface_Decl
+        (Interfaces, Param, Get_Identifier ("res"), Std_String_Ptr_Node);
+      New_Interface_Decl
+        (Interfaces, Param, Get_Identifier ("val"), Val_Type);
+      if Has_Td then
+         New_Interface_Decl
+           (Interfaces, Param, Get_Identifier ("rti"), Rtis.Ghdl_Rti_Access);
+      end if;
+      Finish_Subprogram_Decl (Interfaces, Image_Subprg);
+
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_value_" & Name),
+         O_Storage_External, Val_Type);
+      New_Interface_Decl
+        (Interfaces, Param, Get_Identifier ("val"), Std_String_Ptr_Node);
+      if Has_Td then
+         New_Interface_Decl
+           (Interfaces, Param, Get_Identifier ("rti"), Rtis.Ghdl_Rti_Access);
+      end if;
+      Finish_Subprogram_Decl (Interfaces, Value_Subprg);
+   end Create_Image_Value_Subprograms;
+
+   --  Do internal declarations that need std.standard declarations.
+   procedure Post_Initialize
+   is
+      Interfaces : O_Inter_List;
+      Rec : O_Element_List;
+      Param : O_Dnode;
+      Integer_Otype : O_Tnode;
+      Real_Otype : O_Tnode;
+      Time_Otype : O_Tnode;
+      Info : Type_Info_Acc;
+   begin
+      New_Debug_Comment_Decl ("internal declarations, part 2");
+      Info := Get_Info (String_Type_Definition);
+      Std_String_Node := Info.Ortho_Type (Mode_Value);
+      Std_String_Ptr_Node := Info.Ortho_Ptr_Type (Mode_Value);
+      Integer_Otype := Get_Ortho_Type (Integer_Type_Definition, Mode_Value);
+      Real_Otype := Get_Ortho_Type (Real_Type_Definition, Mode_Value);
+      Time_Otype := Get_Ortho_Type (Time_Type_Definition, Mode_Value);
+
+      --  __ghdl_now : time;
+      --  ??? maybe this should be a function ?
+      New_Var_Decl (Ghdl_Now, Get_Identifier ("__ghdl_now"),
+                    O_Storage_External, Time_Otype);
+
+      --  procedure __ghdl_assert_failed (str : __ghdl_array_template;
+      --                                  severity : ghdl_int);
+      --                                  loc : __ghdl_location_acc);
+
+      --  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_report", Ghdl_Report);
+      end;
+
+      New_Var_Decl (Ghdl_Assert_Default_Report,
+                    Get_Identifier ("__ghdl_assert_default_report"),
+                    O_Storage_External,
+                    Get_Info (String_Type_Definition).Ortho_Type (Mode_Value));
+
+      --  procedure __ghdl_text_write (file : __ghdl_file_index;
+      --                               str  : std_string_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_text_write"), O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
+                          Std_String_Ptr_Node);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_Write);
+
+      --  function __ghdl_text_read_length (file : __ghdl_file_index;
+      --                                    str : std_string_ptr)
+      --     return std__standard_integer;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_text_read_length"),
+         O_Storage_External, Integer_Otype);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
+                          Std_String_Ptr_Node);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_Read_Length);
+
+      --  procedure __ghdl_write_scalar (file : __ghdl_file_index;
+      --                                 ptr : __ghdl_ptr_type;
+      --                                 length : __ghdl_index_type);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_write_scalar"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("ptr"),
+                          Ghdl_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Length, Ghdl_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Write_Scalar);
+
+      --  procedure __ghdl_read_scalar (file : __ghdl_file_index;
+      --                                ptr : __ghdl_ptr_type;
+      --                                length : __ghdl_index_type);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_read_scalar"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("ptr"),
+                          Ghdl_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Length, Ghdl_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Read_Scalar);
+
+      --  function __ghdl_real_exp (left : std__standard__real;
+      --                            right : std__standard__integer)
+      --   return std__standard__real;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_real_exp"), O_Storage_External,
+         Real_Otype);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("left"),
+                          Real_Otype);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("right"),
+                          Integer_Otype);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Real_Exp);
+
+      --  function __ghdl_integer_exp (left : std__standard__integer;
+      --                               right : std__standard__integer)
+      --   return std__standard__integer;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_integer_exp"), O_Storage_External,
+         Integer_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Left, Integer_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Right, Integer_Otype);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Integer_Exp);
+
+
+      --  procedure __ghdl_image_b2 (res : std_string_ptr_node;
+      --                             val : ghdl_bool_type;
+      --                             rti : ghdl_rti_access);
+      Create_Image_Value_Subprograms
+        ("b2", Ghdl_Bool_Type, True, Ghdl_Image_B2, Ghdl_Value_B2);
+
+      --  procedure __ghdl_image_e8 (res : std_string_ptr_node;
+      --                             val : ghdl_i32_type;
+      --                             rti : ghdl_rti_access);
+      Create_Image_Value_Subprograms
+        ("e8", Ghdl_I32_Type, True, Ghdl_Image_E8, Ghdl_Value_E8);
+
+      --  procedure __ghdl_image_i32 (res : std_string_ptr_node;
+      --                              val : ghdl_i32_type);
+      Create_Image_Value_Subprograms
+        ("i32", Ghdl_I32_Type, False, Ghdl_Image_I32, Ghdl_Value_I32);
+
+      --  procedure __ghdl_image_p32 (res : std_string_ptr_node;
+      --                              val : ghdl_i32_type;
+      --                             rti : ghdl_rti_access);
+      Create_Image_Value_Subprograms
+        ("p32", Ghdl_I32_Type, True, Ghdl_Image_P32, Ghdl_Value_P32);
+
+      --  procedure __ghdl_image_p64 (res : std_string_ptr_node;
+      --                              val : ghdl_i64_type;
+      --                             rti : ghdl_rti_access);
+      if not Flag_Only_32b then
+         Create_Image_Value_Subprograms
+           ("p64", Ghdl_I64_Type, True, Ghdl_Image_P64, Ghdl_Value_P64);
+      end if;
+
+      --  procedure __ghdl_image_f64 (res : std_string_ptr_node;
+      --                              val : ghdl_real_type);
+      Create_Image_Value_Subprograms
+        ("f64", Ghdl_Real_Type, False, Ghdl_Image_F64, Ghdl_Value_F64);
+
+      -------------
+      --  files  --
+      -------------
+
+      --  procedure __ghdl_text_file_open (file : file_index_type;
+      --                                   mode : Ghdl_I32_Type;
+      --                                   str : std__standard__string_PTR);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_text_file_open"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mode"),
+                          Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
+                          Std_String_Ptr_Node);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_File_Open);
+
+      --  procedure __ghdl_file_open (file : file_index_type;
+      --                              mode : Ghdl_I32_Type;
+      --                              str : std__standard__string_PTR);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_file_open"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mode"),
+                          Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
+                          Std_String_Ptr_Node);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Open);
+
+      --  function __ghdl_text_file_open_status
+      --    (file : file_index_type;
+      --     mode : Ghdl_I32_Type;
+      --     str : std__standard__string_PTR)
+      --     return ghdl_i32_type;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_text_file_open_status"),
+         O_Storage_External, Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mode"),
+                          Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
+                          Std_String_Ptr_Node);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_File_Open_Status);
+
+      --  function __ghdl_file_open_status (file : file_index_type;
+      --                                    mode : Ghdl_I32_Type;
+      --                                    str : std__standard__string_PTR)
+      --     return ghdl_i32_type;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_file_open_status"),
+         O_Storage_External, Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mode"),
+                          Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
+                          Std_String_Ptr_Node);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Open_Status);
+
+      --  function __ghdl_file_endfile (file : file_index_type)
+      --    return std_boolean_type_node;
+      Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_file_endfile"),
+                           O_Storage_External, Std_Boolean_Type_Node);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Endfile);
+
+      --  procedure __ghdl_text_file_close (file : file_index_type);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_text_file_close"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_File_Close);
+
+      --  procedure __ghdl_file_close (file : file_index_type);
+      Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_file_close"),
+                            O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Close);
+
+      ---------------
+      --  signals  --
+      ---------------
+
+      --  procedure __ghdl_signal_create_resolution
+      --    (func : ghdl_ptr_type;
+      --     instance : ghdl_ptr_type;
+      --     sig : ghdl_ptr_type;
+      --     nbr_sig : ghdl_index_type);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_create_resolution"),
+         O_Storage_External);
+      New_Interface_Decl
+        (Interfaces, Param, Get_Identifier ("func"), Ghdl_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Instance, Ghdl_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Ptr_Type);
+      New_Interface_Decl
+        (Interfaces, Param, Get_Identifier ("nbr_sig"), Ghdl_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Create_Resolution);
+
+      --  Declarations for signals.
+      --  Max length of a scalar type.
+      --  type __ghdl_scalar_bytes is __ghdl_chararray (0 .. 8);
+      Ghdl_Scalar_Bytes := New_Constrained_Array_Type
+        (Chararray_Type, New_Unsigned_Literal (Ghdl_Index_Type, 8));
+      New_Type_Decl (Get_Identifier ("__ghdl_scalar_bytes"),
+                     Ghdl_Scalar_Bytes);
+      --  Type __signal_signal is record
+      Start_Record_Type (Rec);
+      New_Record_Field (Rec, Ghdl_Signal_Value_Node,
+                        Get_Identifier ("value"),
+                        Ghdl_Scalar_Bytes);
+      New_Record_Field (Rec, Ghdl_Signal_Driving_Value_Node,
+                        Get_Identifier ("driving_value"),
+                        Ghdl_Scalar_Bytes);
+      New_Record_Field (Rec, Ghdl_Signal_Last_Value_Node,
+                        Get_Identifier ("last_value"),
+                        Ghdl_Scalar_Bytes);
+      New_Record_Field (Rec, Ghdl_Signal_Last_Event_Node,
+                        Get_Identifier ("last_event"),
+                        Time_Otype);
+      New_Record_Field (Rec, Ghdl_Signal_Last_Active_Node,
+                        Get_Identifier ("last_active"),
+                        Time_Otype);
+      New_Record_Field (Rec, Ghdl_Signal_Event_Node,
+                        Get_Identifier ("event"),
+                        Std_Boolean_Type_Node);
+      New_Record_Field (Rec, Ghdl_Signal_Active_Node,
+                        Get_Identifier ("active"),
+                        Std_Boolean_Type_Node);
+      Finish_Record_Type (Rec, 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);
+
+      Ghdl_Signal_Ptr_Ptr := New_Access_Type (Ghdl_Signal_Ptr);
+      New_Type_Decl (Get_Identifier ("__ghdl_signal_ptr_ptr"),
+                     Ghdl_Signal_Ptr_Ptr);
+
+      --  procedure __ghdl_signal_merge_rti
+      --       (sig : ghdl_signal_ptr; rti : ghdl_rti_access)
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_merge_rti"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Rti, Rtis.Ghdl_Rti_Access);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Merge_Rti);
+
+      --  procedure __ghdl_signal_add_source (targ : __ghdl_signal_ptr;
+      --                                      src : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_add_source"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("targ"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("src"),
+                          Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Add_Source);
+
+      --  procedure __ghdl_signal_effective_value (targ : __ghdl_signal_ptr;
+      --                                           src : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_effective_value"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("targ"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("src"),
+                          Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Effective_Value);
+
+      --  procedure __ghdl_signal_set_disconnect (sig : __ghdl_signal_ptr;
+      --                                          val : std_time);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_set_disconnect"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      New_Interface_Decl
+        (Interfaces, Param, Get_Identifier ("time"), Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Set_Disconnect);
+
+      --  procedure __ghdl_signal_disconnect (sig : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_disconnect"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Disconnect);
+
+      --  function __ghdl_signal_get_nbr_drivers (sig : __ghdl_signal_ptr)
+      --                                          return ghdl_index_type;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_get_nbr_drivers"),
+         O_Storage_External, Ghdl_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Get_Nbr_Drivers);
+
+      --  function __ghdl_signal_get_nbr_sources (sig : __ghdl_signal_ptr)
+      --                                          return ghdl_index_type;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_get_nbr_ports"),
+         O_Storage_External, Ghdl_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Get_Nbr_Ports);
+
+      --  function __ghdl_signal_read_driver (sig : __ghdl_signal_ptr;
+      --                                      num : ghdl_index_type)
+      --                                     return ghdl_ptr_type;
+      declare
+         procedure Create_Signal_Read (Name : String; Subprg : out O_Dnode) is
+         begin
+            Start_Function_Decl
+              (Interfaces, Get_Identifier (Name),
+               O_Storage_External, Ghdl_Ptr_Type);
+            New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+            New_Interface_Decl
+              (Interfaces, Param, Get_Identifier ("num"), Ghdl_Index_Type);
+            Finish_Subprogram_Decl (Interfaces, Subprg);
+         end Create_Signal_Read;
+      begin
+         Create_Signal_Read
+           ("__ghdl_signal_read_driver", Ghdl_Signal_Read_Driver);
+         Create_Signal_Read
+           ("__ghdl_signal_read_port", Ghdl_Signal_Read_Port);
+      end;
+
+      --  function __ghdl_signal_driving (sig : __ghdl_signal_ptr)
+      --                                 return std_boolean;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_driving"),
+         O_Storage_External, Std_Boolean_Type_Node);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Driving);
+
+      --  procedure __ghdl_signal_simple_assign_error
+      --              (sig : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_simple_assign_error"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      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);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_error"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
+                          Std_Time_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Start_Assign_Error);
+
+      --  procedure __ghdl_signal_next_assign_error (sig : __ghdl_signal_ptr;
+      --                                             after : std_time);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_error"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Error);
+
+      --  procedure __ghdl_signal_start_assign_null (sign : __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, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
+                          Std_Time_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Start_Assign_Null);
+
+      --  procedure __ghdl_signal_next_assign_null (sig : __ghdl_signal_ptr;
+      --                                            after : std_time);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_null"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Null);
+
+      --  function __ghdl_create_signal_enum8 (init_val : ghdl_i32_type)
+      --                                       return __ghdl_signal_ptr;
+      --  procedure __ghdl_signal_simple_assign_e8 (sign : __ghdl_signal_ptr;
+      --                                            val : __ghdl_integer);
+      Create_Signal_Subprograms ("e8", Ghdl_I32_Type,
+                                 Ghdl_Create_Signal_E8,
+                                 Ghdl_Signal_Init_E8,
+                                 Ghdl_Signal_Simple_Assign_E8,
+                                 Ghdl_Signal_Start_Assign_E8,
+                                 Ghdl_Signal_Next_Assign_E8,
+                                 Ghdl_Signal_Associate_E8,
+                                 Ghdl_Signal_Driving_Value_E8);
+
+      --  function __ghdl_create_signal_b2 (init_val : ghdl_bool_type)
+      --                                    return __ghdl_signal_ptr;
+      --  procedure __ghdl_signal_simple_assign_b2 (sign : __ghdl_signal_ptr;
+      --                                            val : ghdl_bool_type);
+      Create_Signal_Subprograms ("b2", Ghdl_Bool_Type,
+                                 Ghdl_Create_Signal_B2,
+                                 Ghdl_Signal_Init_B2,
+                                 Ghdl_Signal_Simple_Assign_B2,
+                                 Ghdl_Signal_Start_Assign_B2,
+                                 Ghdl_Signal_Next_Assign_B2,
+                                 Ghdl_Signal_Associate_B2,
+                                 Ghdl_Signal_Driving_Value_B2);
+
+      Create_Signal_Subprograms ("i32", Ghdl_I32_Type,
+                                 Ghdl_Create_Signal_I32,
+                                 Ghdl_Signal_Init_I32,
+                                 Ghdl_Signal_Simple_Assign_I32,
+                                 Ghdl_Signal_Start_Assign_I32,
+                                 Ghdl_Signal_Next_Assign_I32,
+                                 Ghdl_Signal_Associate_I32,
+                                 Ghdl_Signal_Driving_Value_I32);
+
+      Create_Signal_Subprograms ("f64", Ghdl_Real_Type,
+                                 Ghdl_Create_Signal_F64,
+                                 Ghdl_Signal_Init_F64,
+                                 Ghdl_Signal_Simple_Assign_F64,
+                                 Ghdl_Signal_Start_Assign_F64,
+                                 Ghdl_Signal_Next_Assign_F64,
+                                 Ghdl_Signal_Associate_F64,
+                                 Ghdl_Signal_Driving_Value_F64);
+
+      if not Flag_Only_32b then
+         Create_Signal_Subprograms ("i64", Ghdl_I64_Type,
+                                    Ghdl_Create_Signal_I64,
+                                    Ghdl_Signal_Init_I64,
+                                    Ghdl_Signal_Simple_Assign_I64,
+                                    Ghdl_Signal_Start_Assign_I64,
+                                    Ghdl_Signal_Next_Assign_I64,
+                                    Ghdl_Signal_Associate_I64,
+                                    Ghdl_Signal_Driving_Value_I64);
+      end if;
+
+      --  procedure __ghdl_process_add_sensitivity (sig : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_add_sensitivity"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Add_Sensitivity);
+
+      --  procedure __ghdl_process_add_driver (sig : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_add_driver"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Add_Driver);
+
+      declare
+         procedure Create_Signal_Conversion (Name : String; Res : out O_Dnode)
+         is
+         begin
+            Start_Procedure_Decl
+              (Interfaces, Get_Identifier (Name), O_Storage_External);
+            New_Interface_Decl
+              (Interfaces, Param, Get_Identifier ("func"), Ghdl_Ptr_Type);
+            New_Interface_Decl
+              (Interfaces, Param, Wki_Instance, Ghdl_Ptr_Type);
+            New_Interface_Decl
+              (Interfaces, Param, Get_Identifier ("src"), Ghdl_Signal_Ptr);
+            New_Interface_Decl
+              (Interfaces, Param, Get_Identifier ("src_len"), Ghdl_Index_Type);
+            New_Interface_Decl
+              (Interfaces, Param, Get_Identifier ("dst"), Ghdl_Signal_Ptr);
+            New_Interface_Decl
+              (Interfaces, Param, Get_Identifier ("dst_len"), Ghdl_Index_Type);
+            Finish_Subprogram_Decl (Interfaces, Res);
+         end Create_Signal_Conversion;
+      begin
+         --  procedure __ghdl_signal_in_conversion (func : ghdl_ptr_type;
+         --                                         instance : ghdl_ptr_type;
+         --                                         src : ghdl_signal_ptr;
+         --                                         src_len : ghdl_index_type;
+         --                                         dst : ghdl_signal_ptr;
+         --                                         dst_len : ghdl_index_type);
+         Create_Signal_Conversion
+           ("__ghdl_signal_in_conversion", Ghdl_Signal_In_Conversion);
+         Create_Signal_Conversion
+           ("__ghdl_signal_out_conversion", Ghdl_Signal_Out_Conversion);
+      end;
+
+      declare
+         --  function __ghdl_create_XXX_signal (val : std_time)
+         --    return __ghdl_signal_ptr;
+         procedure Create_Signal_Attribute (Name : String; Res : out O_Dnode)
+         is
+         begin
+            Start_Function_Decl (Interfaces, Get_Identifier (Name),
+                                 O_Storage_External, Ghdl_Signal_Ptr);
+            New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
+                                Std_Time_Type);
+            Finish_Subprogram_Decl (Interfaces, Res);
+         end Create_Signal_Attribute;
+      begin
+         --  function __ghdl_create_stable_signal (val : std_time)
+         --    return __ghdl_signal_ptr;
+         Create_Signal_Attribute
+           ("__ghdl_create_stable_signal", Ghdl_Create_Stable_Signal);
+
+         --  function __ghdl_create_quiet_signal (val : std_time)
+         --    return __ghdl_signal_ptr;
+         Create_Signal_Attribute
+           ("__ghdl_create_quiet_signal", Ghdl_Create_Quiet_Signal);
+
+         --  function __ghdl_create_transaction_signal
+         --    return __ghdl_signal_ptr;
+         Start_Function_Decl
+           (Interfaces, Get_Identifier ("__ghdl_create_transaction_signal"),
+            O_Storage_External, Ghdl_Signal_Ptr);
+         Finish_Subprogram_Decl (Interfaces, Ghdl_Create_Transaction_Signal);
+      end;
+
+      --  procedure __ghdl_signal_attribute_register_prefix
+      --    (sig : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces,
+         Get_Identifier ("__ghdl_signal_attribute_register_prefix"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl
+        (Interfaces, Ghdl_Signal_Attribute_Register_Prefix);
+
+      --  function __ghdl_create_delayed_signal (sig : __ghdl_signal_ptr;
+      --                                         val : std_time)
+      --    return __ghdl_signal_ptr;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_create_delayed_signal"),
+         O_Storage_External, Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("sig"),
+                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Create_Delayed_Signal);
+
+      --  function __ghdl_signal_create_guard
+      --    (this : ghdl_ptr_type;
+      --     proc : ghdl_ptr_type;
+      --     instance_name : __ghdl_instance_name_acc)
+      --    return __ghdl_signal_ptr;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_create_guard"),
+         O_Storage_External, Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("this"),
+                          Ghdl_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("proc"),
+                          Ghdl_Ptr_Type);
+--    New_Interface_Decl (Interfaces, Param, Get_Identifier ("instance_name"),
+--                          Ghdl_Instance_Name_Acc);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Create_Guard);
+
+      --  procedure __ghdl_signal_guard_dependence (sig : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_signal_guard_dependence"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Guard_Dependence);
+
+      --  procedure __ghdl_process_wait_exit (void);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_wait_exit"),
+         O_Storage_External);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Exit);
+
+      --  void __ghdl_process_wait_timeout (time : std_time);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_wait_timeout"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Timeout);
+
+      --  void __ghdl_process_wait_set_timeout (time : std_time);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_wait_set_timeout"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"),
+                          Std_Time_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Set_Timeout);
+
+      --  void __ghdl_process_wait_add_sensitivity (sig : __ghdl_signal_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_wait_add_sensitivity"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Add_Sensitivity);
+
+      --  function __ghdl_process_wait_suspend return __ghdl_bool_type;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_wait_suspend"),
+         O_Storage_External, Ghdl_Bool_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Suspend);
+
+      --  void __ghdl_process_wait_close (void);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_wait_close"),
+         O_Storage_External);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Close);
+
+      declare
+         procedure Create_Get_Name (Name : String; Res : out O_Dnode)
+         is
+         begin
+            Start_Procedure_Decl
+              (Interfaces, Get_Identifier (Name), O_Storage_External);
+            New_Interface_Decl
+              (Interfaces, Param, Wki_Res, Std_String_Ptr_Node);
+            New_Interface_Decl (Interfaces, Param, Get_Identifier ("ctxt"),
+                                Rtis.Ghdl_Rti_Access);
+            New_Interface_Decl (Interfaces, Param, Get_Identifier ("addr"),
+                                Ghdl_Ptr_Type);
+            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;
+   end Post_Initialize;
+
+   procedure Translate_Std_Type_Declaration (Decl : Iir)
+   is
+      Chain : Iir;
+      Infos : Chap7.Implicit_Subprogram_Infos;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Type_Declaration =>
+            Chap4.Translate_Type_Declaration (Decl);
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            Chap4.Translate_Anonymous_Type_Declaration (Decl);
+         when others =>
+            Error_Kind ("translate_std_type_declaration", Decl);
+      end case;
+
+      --  Also declares the subprograms.
+      Chain := Get_Chain (Decl);
+      Chap7.Init_Implicit_Subprogram_Infos (Infos);
+      while Chain /= Null_Iir loop
+         case Get_Kind (Chain) is
+            when Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               Chap7.Translate_Implicit_Subprogram (Chain, Infos);
+               Chain := Get_Chain (Chain);
+            when others =>
+               exit;
+         end case;
+      end loop;
+   end Translate_Std_Type_Declaration;
+
+   procedure Translate_Standard (Main : Boolean)
+   is
+      use Std_Package;
+      Lib_Mark, Unit_Mark : Id_Mark_Type;
+      Info : Ortho_Info_Acc;
+   begin
+      Update_Node_Infos;
+
+      New_Debug_Comment_Decl ("package std.standard");
+      if Main then
+         Gen_Filename (Std_Standard_File);
+         Set_Global_Storage (O_Storage_Public);
+      else
+         Set_Global_Storage (O_Storage_External);
+      end if;
+
+      Info := Add_Info (Standard_Package, Kind_Package);
+
+      Reset_Identifier_Prefix;
+      Push_Identifier_Prefix
+        (Lib_Mark, Get_Identifier (Libraries.Std_Library));
+      Push_Identifier_Prefix
+        (Unit_Mark, Get_Identifier (Standard_Package));
+
+      Chap4.Translate_Bool_Type_Declaration (Boolean_Type);
+      --  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);
+
+      Chap4.Translate_Bool_Type_Declaration (Bit_Type);
+
+      Chap4.Translate_Type_Declaration (Character_Type);
+
+      Chap4.Translate_Type_Declaration (Severity_Level_Type);
+
+      Chap4.Translate_Anonymous_Type_Declaration (Universal_Integer_Type);
+      Chap4.Translate_Subtype_Declaration (Universal_Integer_Subtype);
+
+      Chap4.Translate_Anonymous_Type_Declaration (Universal_Real_Type);
+      Chap4.Translate_Subtype_Declaration (Universal_Real_Subtype);
+
+      Chap4.Translate_Anonymous_Type_Declaration (Convertible_Integer_Type);
+      Chap4.Translate_Anonymous_Type_Declaration (Convertible_Real_Type);
+
+      Translate_Std_Type_Declaration (Real_Type);
+      Std_Real_Type_Node := Get_Ortho_Type (Real_Type_Definition, Mode_Value);
+      Chap4.Translate_Subtype_Declaration (Real_Subtype);
+
+      Translate_Std_Type_Declaration (Integer_Type);
+      Std_Integer_Type_Node := Get_Ortho_Type
+        (Integer_Type_Definition, Mode_Value);
+      Chap4.Translate_Subtype_Declaration (Integer_Subtype);
+      Chap4.Translate_Subtype_Declaration (Natural_Subtype);
+      Chap4.Translate_Subtype_Declaration (Positive_Subtype);
+
+      Translate_Std_Type_Declaration (String_Type);
+
+      Translate_Std_Type_Declaration (Bit_Vector_Type);
+
+      declare
+         Type_Staticness : Iir_Staticness;
+         Subtype_Staticness : Iir_Staticness;
+      begin
+         --  With VHDL93 and later, time type is globally static.  As a result,
+         --  it will be elaborated at run-time (and not statically).
+         --  However, there is no elaboration of std.standard.  Furthermore,
+         --  time type can be pre-elaborated without any difficulties.
+         --  There is a kludge here:  set type staticess of time type locally
+         --  and then revert it just after its translation.
+         Type_Staticness := Get_Type_Staticness (Time_Type_Definition);
+         Subtype_Staticness := Get_Type_Staticness (Time_Subtype_Definition);
+         if Flags.Flag_Time_64 then
+            Set_Type_Staticness (Time_Type_Definition, Locally);
+         end if;
+         Set_Type_Staticness (Time_Subtype_Definition, Locally);
+
+         Translate_Std_Type_Declaration (Time_Type);
+         Chap4.Translate_Subtype_Declaration (Time_Subtype);
+
+         if Flags.Vhdl_Std > Vhdl_87 then
+            Set_Type_Staticness (Delay_Length_Subtype_Definition, Locally);
+            Chap4.Translate_Subtype_Declaration (Delay_Length_Subtype);
+            Set_Type_Staticness (Delay_Length_Subtype_Definition,
+                                 Subtype_Staticness);
+         end if;
+
+         Set_Type_Staticness (Time_Type_Definition, Type_Staticness);
+         Set_Type_Staticness (Time_Subtype_Definition, Subtype_Staticness);
+      end;
+      Std_Time_Type := Get_Ortho_Type (Time_Type_Definition, Mode_Value);
+
+      if Flags.Vhdl_Std > Vhdl_87 then
+         Translate_Std_Type_Declaration (File_Open_Kind_Type);
+         Translate_Std_Type_Declaration (File_Open_Status_Type);
+         Std_File_Open_Status_Type :=
+           Get_Ortho_Type (File_Open_Status_Type_Definition, Mode_Value);
+      end if;
+
+      if Flag_Rti then
+         Rtis.Generate_Unit (Standard_Package);
+         Std_Standard_Boolean_Rti
+           := Get_Info (Boolean_Type_Definition).Type_Rti;
+         Std_Standard_Bit_Rti
+           := Get_Info (Bit_Type_Definition).Type_Rti;
+      end if;
+
+      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
+                 | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
+                  null;
+               when Iir_Kind_Enumeration_Type_Definition
+                 | Iir_Kind_Array_Type_Definition
+                 | Iir_Kind_Integer_Subtype_Definition
+                 | Iir_Kind_Floating_Subtype_Definition
+                 | Iir_Kind_Physical_Subtype_Definition
+                 | Iir_Kind_Enumeration_Subtype_Definition =>
+                  Free_Type_Info (Info, True);
+               when Iir_Kind_Array_Subtype_Definition =>
+                  Free_Var (Info.T.Array_Bounds);
+                  Info.T := Ortho_Info_Type_Array_Init;
+                  Free_Type_Info (Info, True);
+               when others =>
+                  --  By default, info are not shared.
+                  --  The exception is infos for implicit subprograms, but
+                  --  they are always consecutive and not free twice due to
+                  --  prev_info mechanism.
+                  Free_Info (I);
+            end case;
+            Prev_Info := Info;
+         end if;
+      end loop;
+      Node_Infos.Free;
+      Free_Old_Temp;
+   end Finalize;
+
+   package body Chap12 is
+      --  Create __ghdl_ELABORATE
+      procedure Gen_Main (Entity : Iir_Entity_Declaration;
+                          Arch : Iir_Architecture_Declaration;
+                          Config_Subprg : O_Dnode)
+      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;
+      begin
+         Arch_Info := Get_Info (Arch);
+         Entity_Info := Get_Info (Entity);
+
+         --  We need to create code.
+         Set_Global_Storage (O_Storage_Private);
+
+         New_Var_Decl
+           (Ghdl_Rti_Top_Instance, Get_Identifier ("__ghdl_rti_top_instance"),
+            O_Storage_External, Ghdl_Ptr_Type);
+
+         New_Var_Decl (Ghdl_Rti_Top_Ptr,
+                       Get_Identifier ("__ghdl_rti_top_ptr"),
+                       O_Storage_External, Ghdl_Ptr_Type);
+
+
+         --  Declare (but do not define):
+         --  Variable for the hierarchy top instance.
+
+         Start_Procedure_Decl (Inter_List, Get_Identifier ("__ghdl_ELABORATE"),
+                               O_Storage_Public);
+         Finish_Subprogram_Decl (Inter_List, Ghdl_Elaborate);
+
+         Start_Subprogram_Body (Ghdl_Elaborate);
+         New_Var_Decl (Arch_Instance, Wki_Arch_Instance,
+                       O_Storage_Local, Arch_Info.Block_Decls_Ptr_Type);
+
+         New_Var_Decl (Instance, Wki_Instance, O_Storage_Local,
+                       Entity_Info.Block_Decls_Ptr_Type);
+
+         --  create instance for the architecture
+         New_Assign_Stmt
+           (New_Obj (Arch_Instance),
+            Gen_Alloc (Alloc_System,
+                       New_Lit (New_Sizeof (Arch_Info.Block_Decls_Type,
+                                            Ghdl_Index_Type)),
+                       Arch_Info.Block_Decls_Ptr_Type));
+
+         --  Set the top instance.
+         New_Assign_Stmt
+           (New_Obj (Instance),
+            New_Address (New_Selected_Acc_Value (New_Obj (Arch_Instance),
+                                                 Arch_Info.Block_Parent_Field),
+                         Entity_Info.Block_Decls_Ptr_Type));
+
+         --  Clear parent field of entity link.
+         New_Assign_Stmt
+           (New_Selected_Element
+            (New_Selected_Acc_Value (New_Obj (Instance),
+                                     Entity_Info.Block_Link_Field),
+             Rtis.Ghdl_Entity_Link_Parent),
+            New_Lit (New_Null_Access (Rtis.Ghdl_Component_Link_Acc)));
+
+         --  Set top instances and RTI.
+         --  Do it before the elaboration code, since it may be used to
+         --  diagnose errors.
+         New_Assign_Stmt (New_Obj (Ghdl_Rti_Top_Instance),
+                          New_Convert_Ov (New_Obj_Value (Arch_Instance),
+                                          Ghdl_Ptr_Type));
+
+         New_Assign_Stmt (New_Obj (Ghdl_Rti_Top_Ptr),
+                          New_Unchecked_Address (New_Obj (Ghdl_Rti_Top),
+                                                 Ghdl_Ptr_Type));
+
+         Gen_Filename (Get_Design_File (Get_Design_Unit (Entity)));
+
+         --  init instance
+         Push_Scope (Entity_Info.Block_Decls_Type, Instance);
+         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_Scope (Entity_Info.Block_Decls_Type);
+         Finish_Subprogram_Body;
+
+         Current_Filename_Node := O_Dnode_Null;
+      end Gen_Main;
+
+      procedure Gen_Setup_Info
+      is
+         Cst : O_Dnode;
+      begin
+         Cst := Create_String (Flags.Flag_String,
+                               Get_Identifier ("__ghdl_flag_string"),
+                               O_Storage_Public);
+      end Gen_Setup_Info;
+
+      --  Return TRUE iff 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.
+      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 Get_Kind (Get_Type (El)) in
+              Iir_Kinds_Unconstrained_Array_Type_Definition
+              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;
+
+      procedure Gen_Last_Arch (Entity : Iir_Entity_Declaration)
+      is
+         Entity_Info : Block_Info_Acc;
+
+         Arch : Iir_Architecture_Declaration;
+         Arch_Info : Block_Info_Acc;
+
+         Lib : Iir_Library_Declaration;
+         Lib_Mark, Entity_Mark, Arch_Mark : Id_Mark_Type;
+
+         Config : Iir_Configuration_Declaration;
+         Config_Info : Config_Info_Acc;
+
+         Const : O_Dnode;
+         Instance : O_Dnode;
+         Inter_List : O_Inter_List;
+         Constr : O_Assoc_List;
+         Subprg : O_Dnode;
+      begin
+         Arch := Libraries.Get_Latest_Architecture (Entity);
+         if Arch = Null_Iir then
+            Error_Msg_Elab ("no architecture for " & Disp_Node (Entity));
+         end if;
+         Arch_Info := Get_Info (Arch);
+         if Arch_Info = null then
+            --  Nothing to do here, since the architecture is not used.
+            return;
+         end if;
+         Entity_Info := Get_Info (Entity);
+
+         --  Create trampoline for elab, default_architecture
+         --  re-create instsize.
+         Reset_Identifier_Prefix;
+         Lib := Get_Library (Get_Design_File (Get_Design_Unit (Entity)));
+         Push_Identifier_Prefix (Lib_Mark, Get_Identifier (Lib));
+         Push_Identifier_Prefix (Entity_Mark, Get_Identifier (Entity));
+         Push_Identifier_Prefix (Arch_Mark, "LASTARCH");
+
+         --  Instance size.
+         New_Const_Decl
+           (Const, Create_Identifier ("INSTSIZE"), O_Storage_Public,
+            Ghdl_Index_Type);
+         Start_Const_Value (Const);
+         Finish_Const_Value
+           (Const, New_Sizeof (Arch_Info.Block_Decls_Type, Ghdl_Index_Type));
+
+         --  Elaborator.
+         Start_Procedure_Decl
+           (Inter_List, Create_Identifier ("ELAB"), O_Storage_Public);
+         New_Interface_Decl
+           (Inter_List, Instance, Wki_Instance,
+            Entity_Info.Block_Decls_Ptr_Type);
+         Finish_Subprogram_Decl (Inter_List, Subprg);
+
+         Start_Subprogram_Body (Subprg);
+         Start_Association (Constr, Arch_Info.Block_Elab_Subprg);
+         New_Association (Constr, New_Obj_Value (Instance));
+         New_Procedure_Call (Constr);
+         Finish_Subprogram_Body;
+
+         --  Default config.
+         Config := Get_Library_Unit
+           (Get_Default_Configuration_Declaration (Arch));
+         Config_Info := Get_Info (Config);
+         if Config_Info /= null then
+            --  Do not create a trampoline for the default_config if it is not
+            --  used.
+            Start_Procedure_Decl
+              (Inter_List, Create_Identifier ("DEFAULT_CONFIG"),
+               O_Storage_Public);
+            New_Interface_Decl (Inter_List, Instance, Wki_Instance,
+                                Arch_Info.Block_Decls_Ptr_Type);
+            Finish_Subprogram_Decl (Inter_List, Subprg);
+
+            Start_Subprogram_Body (Subprg);
+            Start_Association (Constr, Config_Info.Config_Subprg);
+            New_Association (Constr, New_Obj_Value (Instance));
+            New_Procedure_Call (Constr);
+            Finish_Subprogram_Body;
+         end if;
+
+         Pop_Identifier_Prefix (Arch_Mark);
+         Pop_Identifier_Prefix (Entity_Mark);
+         Pop_Identifier_Prefix (Lib_Mark);
+      end Gen_Last_Arch;
+
+      procedure Gen_Dummy_Default_Config (Arch : Iir_Architecture_Declaration)
+      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);
+         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.
+                     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);
+
+            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_Declaration =>
+                  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;
+         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_Declaration;
+         Conf_Info : Config_Info_Acc;
+         Last_Design_Unit : 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_Library_Unit (Get_Entity (Config_Lib));
+         Arch := Get_Block_Specification
+           (Get_Block_Configuration (Config_Lib));
+
+         --  Be sure the entity can be at the top of a design.
+         Check_Entity_Declaration_Top (Entity);
+
+         --  If all design units are loaded, late semantic checks can be
+         --  performed.
+         if Flag_Load_All_Design_Units then
+            for I in Design_Units.First .. Design_Units.Last loop
+               Unit := Design_Units.Table (I);
+               Sem.Sem_Analysis_Checks_List (Unit, False);
+               if Get_Analysis_Checks_List (Unit) /= Null_Iir_List then
+                  --  There cannot be remaining checks to do.
+                  raise Internal_Error;
+               end if;
+            end loop;
+         end if;
+
+         --  Return now in case of errors.
+         if Nbr_Errors /= 0 then
+            return;
+         end if;
+
+         if Flags.Verbose then
+            Ada.Text_IO.Put_Line ("List of units in the hierarchy design:");
+            for I in Design_Units.First .. Design_Units.Last loop
+               Unit := Design_Units.Table (I);
+               Lib_Unit := Get_Library_Unit (Unit);
+               Ada.Text_IO.Put_Line (' ' & Disp_Node (Lib_Unit));
+            end loop;
+         end if;
+
+         if Whole then
+            --  In compile-and-elaborate mode, do not generate code for
+            --  unused subprograms.
+            --  FIXME: should be improved by creating a span-tree.
+            Flag_Discard_Unused := True;
+            Flag_Discard_Unused_Implicit := True;
+         end if;
+
+         --  Generate_Library add infos, therefore the info array must be
+         --  adjusted.
+         Update_Node_Infos;
+         Rtis.Generate_Library (Libraries.Std_Library, True);
+         Translate_Standard (Whole);
+
+         --  Translate all configurations needed.
+         --  Also, set the ELAB_FLAG on package with body.
+         for I in Design_Units.First .. Design_Units.Last loop
+            Unit := Design_Units.Table (I);
+            Lib_Unit := Get_Library_Unit (Unit);
+
+            if Whole then
+               --  In whole compilation mode, force to generate RTIS of
+               --  libraries.
+               Rtis.Generate_Library
+                 (Get_Library (Get_Design_File (Unit)), True);
+            end if;
+
+            case Get_Kind (Lib_Unit) is
+               when Iir_Kind_Configuration_Declaration =>
+                  --  Always generate code for configuration.
+                  --  Because default binding may be changed between analysis
+                  --  and elaboration.
+                  Translate (Unit, True);
+               when Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Architecture_Declaration
+                 | Iir_Kind_Package_Declaration =>
+                  Set_Elab_Flag (Unit, False);
+                  Translate (Unit, Whole);
+               when Iir_Kind_Package_Body =>
+                  Set_Elab_Flag
+                    (Get_Design_Unit (Get_Package (Lib_Unit)), True);
+                  Translate (Unit, Whole);
+               when others =>
+                  Error_Kind ("elaborate", Lib_Unit);
+            end case;
+         end loop;
+
+         --  Generate code to elaboration body-less package.
+         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_Declaration
+                 | Iir_Kind_Package_Body
+                 | Iir_Kind_Configuration_Declaration =>
+                  null;
+               when others =>
+                  Error_Kind ("elaborate(2)", Lib_Unit);
+            end case;
+         end loop;
+
+         if Flag_Rti then
+            Rtis.Generate_Top (Arch);
+         end if;
+
+         --  Create main code.
+         Conf_Info := Get_Info (Config_Lib);
+         Gen_Main (Entity, Arch, Conf_Info.Config_Subprg);
+
+         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/translate/translation.ads b/translate/translation.ads
new file mode 100644
index 000000000..2b885a8da
--- /dev/null
+++ b/translate/translation.ads
@@ -0,0 +1,96 @@
+--  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;
+with Ortho_Ident; use Ortho_Ident;
+with Types; use Types;
+
+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;
+
+   type Foreign_Kind_Type is (Foreign_Unknown,
+                              Foreign_Vhpidirect,
+                              Foreign_Intrinsic);
+
+   type Foreign_Info_Type (Kind : Foreign_Kind_Type := Foreign_Unknown)
+   is record
+      Subprg : O_Ident;
+
+      case Kind is
+         when Foreign_Unknown =>
+            null;
+         when Foreign_Vhpidirect =>
+            Lib : Name_Id;
+         when Foreign_Intrinsic =>
+            null;
+      end case;
+   end record;
+
+   Foreign_Bad : constant Foreign_Info_Type := (Kind => Foreign_Unknown,
+                                                Subprg => O_Ident_Nul);
+
+   --  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; Extract_Name : Boolean)
+                                 return Foreign_Info_Type;
+
+end Translation;
diff --git a/types.ads b/types.ads
new file mode 100644
index 000000000..9cfce90d6
--- /dev/null
+++ b/types.ads
@@ -0,0 +1,124 @@
+--  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 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;
+
+package Types is
+   pragma Preelaborate (Types);
+
+   --  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);
+
+   -- 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;
+
+   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;
+
+   subtype String_Fat is String (Positive);
+   type String_Fat_Acc is access String_Fat;
+
+   -- Array of iir_int32.
+   -- Used by recording feature of scan.
+   type Iir_Int32_Array is array (Natural range <>) of Iir_Int32;
+   type Iir_Int32_Array_Acc is access Iir_Int32_Array;
+
+   -- 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;
+
+   -- 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;
+end Types;
diff --git a/version.ads b/version.ads
new file mode 100644
index 000000000..a3d192743
--- /dev/null
+++ b/version.ads
@@ -0,0 +1,3 @@
+package Version is
+   Ghdl_Version : constant String := "GHDL 0.19 (20050819) [Sokcho edition]";
+end Version;
diff --git a/website/index.html b/website/index.html
new file mode 100644
index 000000000..ba9015e70
--- /dev/null
+++ b/website/index.html
@@ -0,0 +1,109 @@
+<?xml version="1.0" encoding="ISO-8859-1" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+  <head>
+    <title>GHDL home page</title>
+    <link rel="shortcut icon" href="favicon.ico">
+    <style type="text/css">
+      H1 { text-align: center}
+    </style>
+  </head>
+
+  <body>
+    <h1>GHDL home page</h1>
+
+<table>
+<tr>
+<td valign="top">
+<table border="0" width="100%">
+<tr>
+<td style="white-space: nowrap">
+<a href="download.html">Download</a><br/>
+<a href="features.html">Features</a><br/>
+<a href="manual.html">Manual</a><br/>
+<a href="waveviewer.html">Wave viewer</a><br/>
+<a href="bug.html">Bug report</a><br/>
+<a href="more.html">More</a><br/>
+<a href="roadmap.html">Roadmap</a><br/>
+<a href="links.html">Links</a><br/>
+</td>
+</tr>
+</table>
+</td>
+<td valign="top">
+    <p>
+      GHDL is a complete <a href="http://www.vhdl.org">VHDL</a>
+      simulator, using the <a href="http://gcc.gnu.org">GCC</a>
+      technology.
+    </p>
+
+    <p>
+      VHDL is a language standardized by the
+      <a href="http://www.ieee.org">IEEE</a>, intended for developing
+      electronic systems.
+    </p>
+	
+    <p>
+      GHDL implements the VHDL language according to the IEEE
+      1076-1987 or the IEEE 1076-1993 standard.  GHDL compiles VHDL
+      files and creates a binary which simulates (or executes) your
+      design. See the <a href="features.html">features</a> page for
+      more details.
+    </p>
+
+    <p>
+      GHDL does not do synthesis: it cannot translate your design into
+      a netlist.
+    </p>
+
+    <p>
+      Go to the <a href="download.html">download</a> page to download the
+      sources or the binaries of GHDL.
+    </p>
+
+    <p>
+      There is a low-traffic mailing list managed by ezmlm,
+      <a href="mailto:ghdl-discuss@lists.suug.ch">ghdl-discuss@lists.suug.ch
+     </a>.  You can subscribe by sending a mail to
+      <a href="mailto:ghdl-discuss-subscribe@lists.suug.ch">
+       ghdl-discuss-subscribe@lists.suug.ch</a>.
+    </p>
+
+    <p>
+      GHDL is Free Software; you can redistribute 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.
+    </p>
+    <p>
+      GHDL is distributed in the hope that it will be useful,
+      but WITHOUT ANY WARRANTY; without even the implied warranty of
+      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+      GNU General Public License for more details.
+    </p>
+</td>
+</tr>
+</table>
+<!--
+ vhdl simulator
+ what is vhdl ?
+ vhdl 87, 93
+ gcc back end
+ todo
+ main features
+ install the files.
+ simple example
+-->
+    <hr/>
+      <p>
+	Copyright (C) 2004, 2005 Tristan Gingold -- tgingold AT free DOT fr
+      </p>
+      <p>
+	<!-- Created: Thu Nov  7 11:13:57 CET 2002 -->
+	<!-- hhmts start -->
+Last modified: Mon Aug 22 18:31:42 CEST 2005
+<!-- hhmts end -->
+      </p>
+  </body>
+</html>
diff --git a/xrefs.adb b/xrefs.adb
new file mode 100644
index 000000000..825239d1d
--- /dev/null
+++ b/xrefs.adb
@@ -0,0 +1,251 @@
+--  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 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 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
+      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
+      Res : Iir;
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol =>
+            Res := Get_Named_Entity (Name);
+            if Res = Std_Package.Error_Mark then
+               return;
+            end if;
+            Add_Xref (Get_Location (Name), Res, Xref_Ref);
+         when Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Slice_Name =>
+            null;
+         when Iir_Kind_Attribute_Name =>
+            --  FIXME: user defined attributes.
+            null;
+         when others =>
+            Error_Kind ("xref_name_1", Name);
+      end case;
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Operator_Symbol =>
+            null;
+         when Iir_Kind_Selected_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Attribute_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Selected_By_All_Name =>
+            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
+   begin
+      return Xref_Table.Table (Op1).Loc < Xref_Table.Table (Op2).Loc;
+   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/xrefs.ads b/xrefs.ads
new file mode 100644
index 000000000..99645be63
--- /dev/null
+++ b/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 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 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/xtools/Makefile b/xtools/Makefile
new file mode 100644
index 000000000..0704f9973
--- /dev/null
+++ b/xtools/Makefile
@@ -0,0 +1,34 @@
+--  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.
+all: check_iirs
+
+check_iirs: force
+	gnatmake -g check_iirs
+
+MODE=--generate
+
+../iirs.adb: ../iirs.adb.in ../iirs.ads ../nodes.ads ./check_iirs
+	$(RM) $@
+	./check_iirs $(MODE) > subprg.ada
+	sed -e "/^   --  Subprograms/r subprg.ada" \
+	  < ../iirs.adb.in > $@
+	chmod -w $@
+
+force:
+
+clean:
+	$(RM) *.o *.ali *~ check_iirs
diff --git a/xtools/check_iirs.adb b/xtools/check_iirs.adb
new file mode 100644
index 000000000..3b28dfee8
--- /dev/null
+++ b/xtools/check_iirs.adb
@@ -0,0 +1,64 @@
+--  Tool to check the coherence of the iirs package.
+--  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 Check_Iirs_Pkg;
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Check_Iirs
+is
+   type Prg_Mode is (Mode_Generate, Mode_Genfast, Mode_Free);
+   Mode : Prg_Mode;
+   procedure Usage is
+   begin
+      Put_Line ("usage: " & Command_Name & " MODE");
+      Put_Line ("MODE is one of:");
+      Put_Line (" --generate");
+      Put_Line (" --genfast");
+      Put_Line (" --list-free-fields");
+   end Usage;
+begin
+   if Argument_Count /= 1 then
+      Usage;
+      Set_Exit_Status (Failure);
+      return;
+   end if;
+   if Argument (1) = "--generate" then
+      Mode := Mode_Generate;
+   elsif Argument (1) = "--genfast" then
+      Mode := Mode_Genfast;
+   elsif Argument (1) = "--list-free-fields" then
+      Mode := Mode_Free;
+   else
+      Usage;
+      Set_Exit_Status (Failure);
+      return;
+   end if;
+
+   Check_Iirs_Pkg.Read_Fields;
+   Check_Iirs_Pkg.Check_Iirs;
+   Check_Iirs_Pkg.Read_Desc;
+   case Mode is
+      when Mode_Generate =>
+         Check_Iirs_Pkg.Gen_Func;
+      when Mode_Genfast =>
+         Check_Iirs_Pkg.Flag_Checks := False;
+         Check_Iirs_Pkg.Gen_Func;
+      when Mode_Free =>
+         Check_Iirs_Pkg.List_Free_Fields;
+   end case;
+end Check_Iirs;
diff --git a/xtools/check_iirs_pkg.adb b/xtools/check_iirs_pkg.adb
new file mode 100644
index 000000000..6f705f701
--- /dev/null
+++ b/xtools/check_iirs_pkg.adb
@@ -0,0 +1,1217 @@
+--  Tool to check the coherence of the iirs package.
+--  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.Spitbol; use GNAT.Spitbol;
+with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
+with GNAT.Spitbol.Table_Integer; use GNAT.Spitbol.Table_Integer;
+with GNAT.Table;
+
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
+with Ada.Command_Line; use Ada.Command_Line;
+
+package body Check_Iirs_Pkg is
+   --  Exception raise in case of error.
+   Err : exception;
+
+   --  Identifier get by getident_pat.
+   Ident : VString := Nul;
+   Ident_2 : VString := Nul;
+   Ident_3 : VString := Nul;
+   Ident_4 : VString := Nul;
+   Ident_5 : VString := Nul;
+
+   --  Enumel_Pat set this variable to the position of the comma.
+   --  Used to detect the absence of a comma.
+   Comma_Pos : aliased Natural;
+
+   --  Patterns
+   --  Space.
+   Wsp : Pattern := Span (' ');
+
+   --  "type Iir_Kind is".
+   Type_Iir_Kind_Pat : Pattern :=
+     Wsp & "type" & Wsp & "Iir_Kind" & Wsp & "is" & Rpos (0);
+
+   --  "("
+   Lparen_Pat : Pattern := Wsp & '(' & Rpos (0);
+
+   --  Comment.
+   Comment_Pat : Pattern := Wsp & "--";
+
+   --  End of ada line
+   Eol_Pat : Pattern := Comment_Pat or Rpos (0);
+
+   --  "," followed by EOL.
+   Comma_Eol_Pat : Pattern := ',' & Eol_Pat;
+
+   --  A-Za-z
+   Basic_Pat : Pattern := Span (Basic_Set);
+
+   --  A-Za-z0-9
+   Alnum_Pat : Pattern := Span (Alphanumeric_Set);
+
+   --  Ada identifier.
+   Ident_Pat : Pattern := Basic_Pat & Arbno (('_' or "") & Alnum_Pat);
+   -- Basic_Pat & Arbno (Alnum_Pat) & Arbno ('_' & Alnum_Pat);
+
+   --  Eat the ada identifier.
+   Getident_Pat : Pattern := Ident_Pat * Ident;
+   Getident2_Pat : Pattern := Ident_Pat * Ident_2;
+   Getident3_Pat : Pattern := Ident_Pat * Ident_3;
+   Getident4_Pat : Pattern := Ident_Pat * Ident_4;
+   Getident5_Pat : Pattern := Ident_Pat * Ident_5;
+
+   --  Get an enumeration elements.
+   Enumel_Pat : Pattern := Wsp & Getident_Pat
+     & ((',' & Setcur (Comma_Pos'Access)) or "") & Eol_Pat;
+
+   --  End of an enumeration declaration.
+   End_Enum_Pat : Pattern := Wsp & ");" & Eol_Pat;
+
+   Format_Pat : Pattern := "      Format_" & Getident_Pat
+     & ((',' & Setcur (Comma_Pos'Access)) or "") & Eol_Pat;
+
+   Fields_Of_Format_Pat : Pattern := "   -- Fields of Format_" & Getident_Pat
+     & ":" & Rpos (0);
+
+   --  "subtype XX is Iir_Kind range".
+   Iir_Kind_Subtype_Pat : Pattern :=
+     Wsp & "subtype" & Wsp & Getident_Pat & Wsp & "is" & Wsp & "Iir_Kind"
+     & Wsp & "range" & Eol_Pat;
+
+   --  Pattern for a range.
+   Start_Range_Pat : Pattern := Wsp & Getident_Pat & Wsp & ".." & Eol_Pat;
+   Comment_Range_Pat : Pattern := Wsp & "--" & Getident_Pat & Rpos (0);
+   End_Range_Pat : Pattern := Wsp & Getident_Pat & ";" & Eol_Pat;
+
+   --  End of public package part.
+   End_Pat : Pattern := "end Iirs;" & Rpos (0);
+
+   --  Pattern for a function field.
+   Func_Decl_Pat : Pattern := "   --  Field: " & Getident_Pat
+     & ( "" or (" (" & Getident2_Pat & ")")) & Rpos (0);
+
+   --  function Get_XXX.
+   Function_Get_Pat : Pattern := "   function Get_"  & Getident_Pat
+     & " (" & Getident2_Pat & " : " & Getident3_Pat & ") return "
+     & Getident4_Pat & ";" & Rpos (0);
+
+   --  procedure Set_XXX.
+   Procedure_Set_Pat : Pattern := "   procedure Set_"  & Getident_Pat
+     & " (" & Getident2_Pat & " : " & Getident3_Pat
+     & "; " & Getident4_Pat & " : " & Getident5_Pat & ");" & Rpos (0);
+
+   Field_Decl_Pat : Pattern := "   --   " & Getident_Pat & " : ";
+   Field_Type_Pat : Pattern := "   --   " & Ident_Pat & " : "
+     & Getident_Pat & ("" or (" (" & Arb & ")")) & Rpos (0);
+
+   --  Formats of nodes.
+   type Format_Type is range 0 .. 7;
+   No_Format : constant Format_Type := 0;
+   Format_Pos : Format_Type := No_Format;
+
+   Format2pos : GNAT.Spitbol.Table_Integer.Table (8);
+
+   type Format_Info is record
+      Name : String_Access;
+   end record;
+
+   Formats : array (Format_Type) of Format_Info := (others => (Name => null));
+
+   type Format_Mask_Type is array (Format_Type) of Boolean;
+   pragma Pack (Format_Mask_Type);
+
+   --  Type of a IIR name.
+   type Iir_Type is new Natural range 0 .. 255;
+   No_Iir : constant Iir_Type := 0;
+
+   --  Table to convert an Iir name to its position.
+   Iir_Kind2pos : GNAT.Spitbol.Table_Integer.Table (256);
+   --  Last iir used during table construction.
+   Iir_Pos : Iir_Type := No_Iir;
+
+   --  Table of Get_ functions.
+   Function2pos : GNAT.Spitbol.Table_Integer.Table (256);
+
+   --  Table of field.
+   Field2pos : GNAT.Spitbol.Table_Integer.Table (32);
+
+   type Range_Type is record
+     L : Iir_Type;
+     H : Iir_Type;
+   end record;
+
+   Null_Range : constant Range_Type := (No_Iir, No_Iir);
+
+   function Img (Rng : Range_Type) return String is
+   begin
+      return "(" & Iir_Type'Image (Rng.L) & ", "
+        & Iir_Type'Image (Rng.H) & ")";
+   end Img;
+
+   package Table_Range is new GNAT.Spitbol.Table (Range_Type, Null_Range, Img);
+   use Table_Range;
+
+   Iir_Kinds2pos : Table_Range.Table (32);
+
+   --  Field type.  They represent a raw field.
+   type Field_Type is new Integer range 0 .. 64;
+   No_Field : constant Field_Type := 0;
+   --  Position of the last field.
+   Field_Pos : Field_Type := No_Field;
+
+   type Field_Info is record
+      --  Name of the field.
+      Name : String_Access;
+      --  Type of the field.
+      Ftype : String_Access;
+      --  Formats in which the field is valid.
+      Formats : Format_Mask_Type;
+   end record;
+
+   package Field_Table is new GNAT.Table
+     (Table_Component_Type => Field_Info,
+      Table_Index_Type => Field_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 32,
+      Table_Increment => 100);
+
+   --  Function type.  They represent a field name.
+   type Func_Type is new Natural;
+   No_Func : constant Func_Type := 0;
+   --  Last function known; used during the construction of the func_table.
+   Function_Pos : Func_Type := No_Func;
+
+   type Field2Func_Array is array (Field_Type) of Func_Type;
+
+   --  Information for each Iir node.
+   type Iir_Info is record
+      --  Name of the Kind.
+      Name : String_Access;
+
+      --  If TRUE, the node was described.
+      Described : Boolean;
+
+      --  Format used by the node.
+      Format : Format_Type;
+
+      --  Function used to get the value of each field.
+      Func : Field2Func_Array;
+   end record;
+
+   --  Table of IIr.
+   package Iir_Table is new GNAT.Table
+     (Table_Component_Type => Iir_Info,
+      Table_Index_Type => Iir_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 256,
+      Table_Increment => 100);
+
+   --  Table of functions.
+   type Iir_Bool_Array is array (Iir_Type) of Boolean;
+   pragma Pack (Iir_Bool_Array);
+
+   type Conversion_Type is (None, Via_Pos_Attr, Via_Unchecked);
+
+   type Func_Info is record
+      --  Name of the function.
+      Name : Vstring;
+      --  Field get/set by the function.
+      Field : Field_Type;
+      --  If true, the iir use this function.
+      Uses : Iir_Bool_Array;
+      --  Name of the target.
+      Target_Name : String_Access;
+      --  Type of the target.
+      Target_Type : String_Access;
+      --  Name of the value.
+      Value_Name : String_Access;
+      --  Type of the value.
+      Value_Type : String_Access;
+      --  Conversion;
+      Conv : Conversion_Type;
+   end record;
+
+   package Func_Table is new GNAT.Table
+     (Table_Component_Type => Func_Info,
+      Table_Index_Type => Func_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 256,
+      Table_Increment => 100);
+
+   --  Get the position of IIR V.
+   function Get_Iir_Pos (V : VString) return Iir_Type
+   is
+      P : Integer;
+   begin
+      P := Get (Iir_Kind2pos, V);
+
+      if P < 0 then
+         --  Identifier unknown.
+         raise Err;
+      end if;
+      return Iir_Type (P);
+   end Get_Iir_Pos;
+
+   Disp_Func : Boolean := False;
+
+   Flag_Disp_Format : Boolean := False;
+   Flag_Disp_Field : Boolean := False;
+
+   procedure Read_Fields
+   is
+      In_Node : File_Type;
+      Line : VString := Nul;
+
+      Format_Mask : Format_Mask_Type;
+
+      procedure Parse_Field
+      is
+         P : Integer;
+         Name : Vstring := Ident;
+      begin
+         if not Match (Line, Field_Type_Pat) then
+            Put_Line ("**  field declaration without type");
+            raise Err;
+         end if;
+
+         --  Check if the field is not already known.
+         P := Get (Field2pos, Name);
+         if P > 0 then
+            if Ident /= Field_Table.Table (Field_Type (P)).Ftype.all then
+               Put_Line ("*** field type mismatch");
+               raise Err;
+            end if;
+            for I in Format_Mask'Range loop
+               if Format_Mask (I) then
+                  Field_Table.Table (Field_Type (P)).Formats (I) := True;
+               end if;
+            end loop;
+            return;
+         end if;
+
+         Field_Pos := Field_Pos + 1;
+         Set (Field2pos, Name, Natural (Field_Pos));
+         Field_Table.Set_Last (Field_Pos);
+         Field_Table.Table (Field_Pos) :=
+           (Name => new String'(To_String (Name)),
+            Ftype => new String'(To_String (Ident)),
+            Formats => Format_Mask);
+         if Flag_Disp_Field then
+            Put_Line ("found field '"
+                      & Field_Table.Table (Field_Pos).Name.all & "'");
+         end if;
+      end Parse_Field;
+   begin
+      Open (In_Node, In_File, "../nodes.ads");
+
+      Anchored_Mode := True;
+
+      --  Read lines until "type format_type is":
+      loop
+         Line := Get_Line (In_Node);
+         exit when Match (Line, "   type Format_Type is" & Rpos (0));
+      end loop;
+      --  Expect '('.
+      Line := Get_Line (In_Node);
+      if not Match (Line, "     (" & Rpos (0)) then
+         raise Err;
+      end if;
+
+      --  Read all formats.
+      loop
+         Line := Get_Line (In_Node);
+
+         --  Read the identifier.
+         Comma_Pos := 0;
+         if not Match (Line, Format_Pat) then
+            raise Err;
+         end if;
+
+         --  Put it into the table.
+         Format_Pos := Format_Pos + 1;
+         Set (Format2Pos, Ident, Natural (Format_Pos));
+         Formats (Format_Pos) := (Name => new String'(To_String (Ident)));
+         if Flag_Disp_Format then
+            Put_Line ("found format " & S (Ident));
+         end if;
+
+         --  If there is no comma, then this is the end of enumeration.
+         exit when Comma_Pos = 0;
+      end loop;
+
+      --  Read ");"
+      Line := Get_Line (In_Node);
+      if not Match (Line, "     );" & Rpos (0)) then
+         raise Err;
+      end if;
+
+      --  Read fields.
+
+      loop
+         Line := Get_Line (In_Node);
+         exit when Match (Line, "   -- Common fields are:" & Rpos (0));
+      end loop;
+      Format_Mask := (others => True);
+      loop
+         Line := Get_Line (In_Node);
+         if Match (Line, Field_Decl_Pat) then
+            Parse_Field;
+         elsif Match (Line, Rpos (0)) then
+            Line := Get_Line (In_Node);
+            exit when not Match (Line, Fields_Of_Format_Pat);
+            declare
+               P : Integer;
+            begin
+               P := Get (Format2pos, Ident);
+               if P < 0 then
+                  Put_Line ("*** unknown format");
+                  raise Err;
+               end if;
+               Format_Mask := (others => False);
+               Format_Mask (Format_Type (P)) := True;
+            end;
+         else
+            Put_Line ("**  bad line in field declarations");
+            raise Err;
+         end if;
+      end loop;
+      Close (In_Node);
+
+      if False then
+        Put_Line ("Fields:");
+        for I in 1 .. Field_Pos loop
+           Put (Field_Table.Table (I).Name.all);
+           Put (": ");
+           Put (Field_Table.Table (I).Ftype.all);
+           Put ("  ");
+           for J in Format_Mask_Type'Range loop
+              if Field_Table.Table (I).Formats (J)
+                and then Formats (J).Name /= null
+              then
+                 Put (" ");
+                 Put (Formats (J).Name.all);
+              end if;
+           end loop;
+           New_Line;
+        end loop;
+      end if;
+   end Read_Fields;
+
+   --  Read all Iir_Kind_* names and put them into Iir_Table.
+   --  Fill Iir_Kinds2pos
+   --  Fill Func_Table.
+   procedure Check_Iirs
+   is
+      --  iirs.ads file.
+      In_Iirs : File_Type;
+
+      --  Line read from In_Iirs.
+      Line : VString := Nul;
+   begin
+      --  Open the file.
+      Open (In_Iirs, In_File, "../iirs.ads");
+
+      Anchored_Mode := True;
+
+      --  Read lines until "type Iir_Kind is"
+      loop
+         Line := Get_Line (In_Iirs);
+         exit when Match (Line, Type_Iir_Kind_Pat);
+      end loop;
+
+      if Flag_Disp_Iir then
+         Put_Line ("found iir_kind at line"
+                   & Positive_Count'Image (Ada.Text_IO.Line (In_Iirs)));
+      end if;
+
+      --Debug_Mode := True;
+
+      --  Read '('
+      Line := Get_Line (In_Iirs);
+      if not Match (Line, Lparen_Pat) then
+         raise Err;
+      end if;
+
+      --  Read all kind.
+      loop
+         Line := Get_Line (In_Iirs);
+
+         --  Skip comments and empty lines.
+         if Match (Line, Eol_Pat) then
+            goto Continue;
+         end if;
+
+         --  Read the identifier.
+         Comma_Pos := 0;
+         if not Match (Line, Enumel_Pat) then
+            raise Err;
+         end if;
+
+         --  Put it into the table.
+         Iir_Pos := Iir_Pos + 1;
+         Set (Iir_Kind2pos, Ident, Natural (Iir_Pos));
+         Iir_Table.Set_Last (Iir_Pos);
+         Iir_Table.Table (Iir_Pos) := (Name => new String'(To_String (Ident)),
+                                       Described => False,
+                                       Format => No_Format,
+                                       Func => (others => No_Func));
+         if Flag_Disp_Iir then
+            Put_Line ("found " & S (Ident) & Iir_Type'Image (Iir_Pos));
+         end if;
+
+         --  If there is no comma, then this is the end of enumeration.
+         exit when Comma_Pos = 0;
+         << Continue >> null;
+      end loop;
+
+      --  Read ");"
+      Line := Get_Line (In_Iirs);
+      if not Match (Line, End_Enum_Pat) then
+         raise Err;
+      end if;
+
+      --  Look for iir_kind subtype.
+      loop
+         Line := Get_Line (In_Iirs);
+         exit when Match (Line, End_Pat);
+
+         Ident_2 := Null_Unbounded_String;
+
+         if Match (Line, Iir_Kind_Subtype_Pat) then
+            declare
+               Start : Iir_Type;
+               Pos : Iir_Type;
+               P : Iir_Type;
+               Rng_Ident : VString := Ident;
+            begin
+               Line := Get_Line (In_Iirs);
+               if not Match (Line, Start_Range_Pat) then
+                  --  Bad pattern for left bound.
+                  raise Err;
+               end if;
+               Start := Get_Iir_Pos (Ident);
+               Pos := Start;
+               if Flag_Disp_Subtype then
+                  Put_Line ("found subtype " & S (Rng_Ident));
+                  Put_Line ("     " & S (Ident) & " .."
+                            & Iir_Type'Image (Pos));
+               end if;
+
+               loop
+                  Line := Get_Line (In_Iirs);
+                  if Match (Line, End_Range_Pat) then
+                     P := Get_Iir_Pos (Ident);
+                     if P /= Pos + 1 and then Flag_Disp_Subtype Then
+                        Put_Line ("** missing comments");
+                        for I in Pos + 1 .. P - 1 loop
+                           Put_Line ("   --" & Iir_Table.Table (I).Name.all);
+                        end loop;
+                     end if;
+                     Set (Iir_Kinds2pos, Rng_Ident, Range_Type'(Start, P));
+                     if Flag_Disp_Subtype then
+                        Put_Line ("     " & S (Ident) & Iir_Type'Image (P));
+                     end if;
+                     exit;
+                  elsif Match (Line, Comment_Range_Pat) then
+                     P := Get_Iir_Pos (Ident);
+                     if P /= Pos + 1 then
+                        --  Bad order.
+                        raise Err;
+                     else
+                        Pos := Pos + 1;
+                     end if;
+                  else
+                     --  Comment (with identifier) or end of range expected.
+                     raise Err;
+                  end if;
+               end loop;
+            end;
+         elsif Match (Line, Func_Decl_Pat) then
+            declare
+               Field_Pos : Integer;
+               F : Func_Type;
+               Conv : Conversion_Type;
+            begin
+               Field_Pos := Get (Field2pos, Ident);
+               if Field_Pos < 0 then
+                  Put_Line ("*** field not found: '" & S (Ident) & "'");
+                  raise Err;
+               end if;
+
+               if Ident_2 /= Null_Unbounded_String then
+                  if Ident_2 = "pos" then
+                     Conv := Via_Pos_Attr;
+                  elsif Ident_2 = "uc" then
+                     Conv := Via_Unchecked;
+                  else
+                     Put_Line ("*** bad conversion");
+                     raise Err;
+                  end if;
+               else
+                  Conv := None;
+               end if;
+
+               Line := Get_Line (In_Iirs);
+               if not Match (Line, Function_Get_Pat) then
+                  Put_Line ("*** function expected");
+                  raise Err;
+               end if;
+
+               if False then
+                  Put_Line ("found function " & S (Ident));
+               end if;
+               Function_Pos := Function_Pos + 1;
+               F := Function_Pos;
+               Set (Function2pos, Ident, Integer (Function_Pos));
+               Func_Table.Set_Last (Function_Pos);
+               Func_Table.Table (Function_Pos) :=
+                 (Name => Ident,
+                  Field => Field_Type (Field_Pos),
+                  Uses => (others => False),
+                  Target_Name => new String'(To_String (Ident_2)),
+                  Target_Type => new String'(To_String (Ident_3)),
+                  Value_Name => null,
+                  Value_Type => new String'(To_String (Ident_4)),
+                  Conv => Conv);
+
+               Line := Get_Line (In_Iirs);
+               if Match (Line, Procedure_Set_Pat) then
+                  if Func_Table.Table (F).Target_Name.all /= Ident_2 then
+                     Put_Line ("*** procedure target name mismatch ("
+                               & Func_Table.Table (F).Target_Name.all
+                               & " vs " & S (Ident_2) &")");
+                     raise Err;
+                  end if;
+                  if Func_Table.Table (F).Target_Type.all /= Ident_3 then
+                     Put_Line ("*** procedure target type name mismatch");
+                     raise Err;
+                  end if;
+                  if Func_Table.Table (F).Value_Type.all /= Ident_5 then
+                     Put_Line ("*** procedure target type name mismatch");
+                     raise Err;
+                  end if;
+                  Func_Table.Table (F).Value_Name :=
+                    new String'(To_String (Ident_4));
+               else
+                  if not Match (Line, Rpos (0)) then
+                     Put_Line ("*** procedure or empty line expected");
+                     raise Err;
+                  end if;
+               end if;
+            end;
+         end if;
+      end loop;
+      Close (In_Iirs);
+      Set_Exit_Status (Success);
+   exception
+      when Err =>
+         Put_Line ("*** Fatal error at line"
+                   & Positive_Count'Image (Ada.Text_IO.Line (In_Iirs)));
+         Set_Exit_Status (Failure);
+         raise;
+   end Check_Iirs;
+
+   --  Start of node description.
+   Start_Of_Iir_Kind_Pat : Pattern := "   -- Start of Iir_Kind." & Rpos (0);
+   End_Of_Iir_Kind_Pat : Pattern := "   -- End of Iir_Kind." & Rpos (0);
+
+   --  Box ("----------") delimiters.
+   Box_Delim_Pat : Pattern := "   --" & Span ('-') & Rpos (0);
+
+   --  Inside a box ("-- XXX --").
+   Box_Inside_Pat : Pattern := "   --" & Arb & "--" & Rpos (0);
+
+   --  Get a iir_kind identifier.
+   Desc_Iir_Kind_Pat : Pattern :=
+     "   -- " & Getident_Pat
+     & ("" or ( " (" & Getident2_Pat & ")"))
+     & Rpos (0);
+
+   Subprogram_Pat : Pattern := "   --   Get" & ("_" or "/Set_") & Getident_Pat
+     & ((" " & Arb) or "") & Rpos (0);
+
+   Desc_Only_For_Pat : Pattern := "   -- Only for " & Getident_Pat & ":"
+     & Rpos (0);
+   Desc_Comment_Pat : Pattern := "   -- " & (Alnum_Pat or Any ("*_(.|"));
+   Desc_Empty_Pat : Pattern := "   --" & Rpos (0);
+   Desc_Subprogram_Pat : Pattern := "   --   " & ("function" or "procedure");
+
+   Field_Pat : Pattern := Arb & "(" & Getident_Pat & ")";
+   Alias_Field_Pat : Pattern := Arb & "(Alias " & Getident_Pat & ")";
+
+   Disp_Desc : Boolean := False;
+
+   --  Check descriptions.
+   procedure Read_Desc
+   is
+      --  iirs.ads file.
+      In_Iirs : File_Type;
+
+      --  Current line.
+      Line : VString;
+
+      --  IIR being described.
+      type Iir_Array is array (Natural range <>) of Iir_Type;
+      Iir_Desc : Iir_Array (1 .. 32);
+      Nbr_Desc : Natural := 0;
+
+      Only_For : Iir_Array (1 .. 16) := (others => No_Iir);
+      Nbr_Only_For : Natural := 0;
+
+      --  Just say IIR N is being described.
+      procedure Add_Desc (N : Iir_Type; Format : Format_Type) is
+      begin
+         if Iir_Table.Table (N).Described then
+            Put_Line ("*** iir already described");
+            raise Err;
+         end if;
+
+         Iir_Table.Table (N).Described := True;
+         Iir_Table.Table (N).Format := Format;
+         Nbr_Desc := Nbr_Desc + 1;
+         Iir_Desc (Nbr_Desc) := N;
+      end Add_Desc;
+
+   begin
+      --  Open the file.
+      Open (In_Iirs, In_File, "../iirs.ads");
+
+      Anchored_Mode := True;
+
+      if False then
+         --  List of fields.
+         Set (Field2pos, "Field1", 1);
+         Set (Field2pos, "Field2", 2);
+         Set (Field2pos, "Field3", 3);
+         Set (Field2pos, "Field4", 4);
+         Set (Field2pos, "Field5", 5);
+         Set (Field2pos, "Field6", 6);
+         Set (Field2pos, "Field7", 7);
+         Set (Field2pos, "Nbr2", 6);
+         Set (Field2pos, "Nbr3", 7);
+
+         Set (Field2pos, "Ident", 8);
+         Set (Field2pos, "Field0", 9);
+         Set (Field2pos, "Attr", 10);
+         Set (Field2pos, "Chain", 11);
+
+         Set (Field2pos, "Flag1", 12);
+         Set (Field2pos, "Flag2", 13);
+         Set (Field2pos, "Flag3", 14);
+         Set (Field2pos, "Flag4", 15);
+         Set (Field2pos, "Flag5", 16);
+         Set (Field2pos, "Odigit_1", 17);
+         Set (Field2pos, "Odigit_2", 18);
+         Set (Field2pos, "State1", 19);
+         Set (Field2pos, "Staticness_1", 20);
+         Set (Field2pos, "Staticness_2", 21);
+      end if;
+
+      --  Read lines until "-- Start of Iir_Kind."
+      loop
+         Line := Get_Line (In_Iirs);
+         exit when Match (Line, Start_Of_Iir_Kind_Pat);
+      end loop;
+
+      --Debug_Mode := True;
+
+      --  Read descriptions.
+      L1 : loop
+
+         --  Empty lines.
+         loop
+            Line := Get_Line (In_Iirs);
+            exit when not Match (Line, Rpos (0));
+         end loop;
+
+         if Match (Line, Box_Delim_Pat) then
+            --  A box.
+            Line := Get_Line (In_Iirs);
+            if not Match (Line, Box_Inside_Pat) then
+               raise Err;
+            end if;
+            Line := Get_Line (In_Iirs);
+            if not Match (Line, Box_Delim_Pat) then
+               raise Err;
+            end if;
+         else
+            --  A description.
+            if not Match (Line, "   -- Iir_Kind") then
+               if Match (Line, End_Of_Iir_Kind_Pat) then
+                  exit L1;
+               elsif Match (Line, "   -- For Iir_Kinds_") then
+                  null;
+               else
+                  raise Err;
+               end if;
+            end if;
+
+            --  Get iir_kind.
+            declare
+               P_Num : Integer;
+               Rng : Range_Type;
+               Format : Format_Type;
+            begin
+               --  No iir being described.
+               Nbr_Desc := 0;
+               loop
+                  Ident_2 := Nul;
+                  exit when not Match (Line, Desc_Iir_Kind_Pat);
+
+                  --  Check format.
+                  if Ident_2 = Nul then
+                     Put_Line ("*** no format for " & S (Ident));
+                     raise Err;
+                  end if;
+                  P_Num := Get (Format2pos, Ident_2);
+                  if P_Num < 0 then
+                     Put_Line ("*** unknown format");
+                     raise Err;
+                  end if;
+                  Format := Format_Type (P_Num);
+
+                  --  Handle nodes.
+                  P_Num := Get (Iir_Kind2pos, Ident);
+                  if P_Num >= 0 then
+                     Add_Desc (Iir_Type (P_Num), Format);
+                  else
+                     Rng := Get (Iir_Kinds2pos, Ident);
+                     if Rng = Null_Range then
+                        Put_Line ("*** " & S (Ident));
+                        raise Err;
+                     end if;
+                     for I in Rng.L .. Rng.H loop
+                        Add_Desc (I, Format);
+                     end loop;
+                  end if;
+
+                  if Disp_Desc then
+                     Put_Line ("desc for " & S (Ident));
+                  end if;
+
+                  Line := Get_Line (In_Iirs);
+               end loop;
+            end;
+
+            --Debug_Mode := True;
+
+            --  Read the functions.
+            loop
+               if not Match (Line, Comment_Pat) then
+                  if Match (Line, Rpos (0)) then
+                     exit;
+                  else
+                     raise Err;
+                  end if;
+               end if;
+               declare
+                  Func : Func_Type;
+                  Func_Num : Integer;
+                  Field : Field_Type;
+                  Field_Num : Integer;
+                  Is_Alias : Boolean;
+
+                  procedure Add_Field (N : Iir_Type) is
+                  begin
+                     if not Field_Table.Table (Field).
+                       Formats (Iir_Table.Table (N).Format)
+                     then
+                        Put_Line ("** no field for format");
+                        raise Err;
+                     end if;
+                     if Is_Alias then
+                        if Iir_Table.Table (N).Func (Field) = No_Func
+                        then
+                           Put_Line ("**  aliased field not yet used");
+                           raise Err;
+                        end if;
+                     else
+                        if Iir_Table.Table (N).Func (Field) /= No_Func
+                          --and then
+                          --Iir_Table.Table (N).Func (Field) /= Func
+                        then
+                           Put_Line ("**  Field already used");
+                           raise Err;
+                        end if;
+                        Iir_Table.Table (N).Func (Field) := Func;
+                     end if;
+                     Func_Table.Table (Func).Uses (N) := True;
+                  end Add_Field;
+               begin
+                  if Match (Line, Subprogram_Pat) then
+                     if Disp_Desc then
+                        Put ("subprg: " & S (Ident));
+                     end if;
+                     Func_Num := Get (Function2pos, Ident);
+                     if Func_Num < 0 then
+                        Put_Line (Standard_Error,
+                                  "*** function not found: " & S (Ident));
+                        raise Err;
+                     end if;
+                     Func := Func_Type (Func_Num);
+                     if Match (Line, Field_Pat) then
+                        Is_Alias := False;
+                     elsif Match (Line, Alias_Field_Pat) then
+                        Is_Alias := True;
+                     else
+                        raise Err;
+                     end if;
+                     if Disp_Desc then
+                        Put_Line ("  (" & S (Ident) & ")");
+                     end if;
+                     Field_Num := Get (Field2pos, Ident);
+                     if Field_Num < 0 then
+                        Put_Line ("*** unknown field: " & S (Ident));
+                        raise Err;
+                     end if;
+                     Field := Field_Type (Field_Num);
+                     if Func_Table.Table (Func).Field /= Field then
+                        if Func_Table.Table (Func).Field = No_Field then
+                           Func_Table.Table (Func).Field := Field;
+                        else
+                           --  Field redefined for the function.
+                           Put_Line ("**  field redefined for the function");
+                           raise Err;
+                        end if;
+                     end if;
+
+                     --  Check the field is not already used by another func.
+                     if Nbr_Only_For > 0 then
+                        for I in 1 .. Nbr_Only_For loop
+                           Add_Field (Only_For (I));
+                        end loop;
+                        Nbr_Only_For := 0;
+                     else
+                        for I in 1 .. Nbr_Desc loop
+                           Add_Field (Iir_Desc (I));
+                        end loop;
+                     end if;
+                  elsif Match (Line, Desc_Only_For_Pat) then
+                     declare
+                        P_Num : Integer;
+                        Rng : Range_Type;
+
+                        procedure Add_Only_For (N : Iir_Type) is
+                        begin
+                           for I in 1 .. Nbr_Desc loop
+                              if Iir_Desc (I) = N then
+                                 Nbr_Only_For := Nbr_Only_For + 1;
+                                 Only_For (Nbr_Only_For) := N;
+                                 return;
+                              end if;
+                           end loop;
+                           Put_Line ("**  not currently described");
+                           raise Err;
+                        end Add_Only_For;
+                     begin
+                        P_Num := Get (Iir_Kind2pos, Ident);
+                        if P_Num >= 0 then
+                           Add_Only_For (Iir_Type (P_Num));
+                        else
+                           Rng := Get (Iir_Kinds2pos, Ident);
+                           if Rng = Null_Range then
+                              Put_Line ("*** " & S (Ident));
+                              raise Err;
+                           end if;
+                           for I in Rng.L .. Rng.H loop
+                              Add_Only_For (I);
+                           end loop;
+                        end if;
+                     end;
+                  elsif Match (Line, "   -- Only") then
+                     Put_Line ("**  bad only for line");
+                     raise Err;
+                  elsif Match (Line, Desc_Comment_Pat) then
+                     null;
+                  elsif Match (Line, Desc_Empty_Pat) then
+                     null;
+                  elsif Match (Line, Desc_Subprogram_Pat) then
+                     null;
+                  else
+                     raise Err;
+                  end if;
+               end;
+               Line := Get_Line (In_Iirs);
+            end loop;
+         end if;
+      end loop L1;
+
+      --  Check each Iir was described.
+      for I in Iir_Table.First .. Iir_Table.Last loop
+         if not Iir_Table.Table (I).Described then
+            Put_Line ("*** not described: " & Iir_Table.Table (I).Name.all);
+            raise Err;
+         end if;
+      end loop;
+
+      Close (In_Iirs);
+   exception
+      when Err =>
+         Put_Line ("*** Fatal error at line"
+                   & Positive_Count'Image (Ada.Text_IO.Line (In_Iirs) - 1));
+         Put_Line ("*** Line is " & S (Line));
+         Set_Exit_Status (Failure);
+         raise;
+   end Read_Desc;
+
+   procedure Gen_Func
+   is
+      function Is_Used (F : Func_Type) return Boolean
+      is
+      begin
+         for I in Func_Table.Table (F).Uses'Range loop
+            if Func_Table.Table (F).Uses (I) then
+               return True;
+            end if;
+         end loop;
+         return False;
+      end Is_Used;
+      Is_First : Boolean;
+      Same_Name : Boolean;
+   begin
+      Put_Line ("   function Get_Format (Kind : Iir_Kind) "
+                & "return Format_Type is");
+      Put_Line ("   begin");
+      Put_Line ("      case Kind is");
+      for I in 1 .. Format_Pos loop
+         Is_First := True;
+         Put      ("         when ");
+         for J in Iir_Table.First .. Iir_Table.Last loop
+            if Iir_Table.Table (J).Format = I then
+               if not Is_First then
+                  New_Line;
+                  Put ("           | ");
+               end if;
+               Is_First := False;
+               Put (Iir_Table.Table (J).Name.all);
+            end if;
+         end loop;
+         Put_Line (" =>");
+         Put      ("            return Format_");
+         Put (Formats (I).Name.all);
+         Put_Line (";");
+      end loop;
+      Put_Line ("      end case;");
+      Put_Line ("   end Get_Format;");
+      New_Line;
+
+      --  Builder.
+      Put_Line ("   function Create_Iir (Kind : Iir_Kind) return Iir");
+      Put_Line ("   is");
+      Put_Line ("      Res : Iir;");
+      Put_Line ("      Format : Format_Type;");
+      Put_Line ("   begin");
+      Put_Line ("      Format := Get_Format (Kind);");
+      Put_Line ("      Res := Create_Node (Format);");
+      Put_Line ("      Set_Nkind (Res, Iir_Kind'Pos (Kind));");
+      Put_Line ("      return Res;");
+      Put_Line ("   end Create_Iir;");
+      New_Line;
+
+      for I in Func_Table.First .. Func_Table.Last loop
+         declare
+            F : Func_Info renames Func_Table.Table (I);
+         begin
+            --  Avoid bug get_parent.
+            if Is_Used (I) then
+               Same_Name := F.Name = Field_Table.Table (F.Field).Name.all;
+               if Flag_Checks then
+                  Put ("   procedure Check_Kind_For_");
+                  Put (F.Name);
+                  Put (" (Target : Iir) is");
+                  New_Line;
+                  Put_Line ("   begin");
+                  Put_Line ("      case Get_Kind (Target) is");
+                  Put ("         when ");
+                  Is_First := True;
+                  for J in F.Uses'Range loop
+                     if F.Uses (J) then
+                        if not Is_First then
+                           New_Line;
+                           Put ("           | ");
+                        else
+                           Is_First := False;
+                        end if;
+                        Put (Iir_Table.Table (J).Name.all);
+                     end if;
+                  end loop;
+                  Put_Line (" =>");
+                  Put_Line ("            null;");
+                  Put_Line ("         when others =>");
+                  Put ("            Failed (""");
+                  Put (F.Name);
+                  Put_Line (""", Target);");
+                  Put_Line ("      end case;");
+                  Put ("   end Check_Kind_For_");
+                  Put (F.Name);
+                  Put_Line (";");
+                  New_Line;
+               end if;
+
+               Put ("   function Get_");
+               Put (F.Name);
+               Put (" (");
+               Put (F.Target_Name.all);
+               Put (" : ");
+               Put (F.Target_Type.all);
+               Put (") return ");
+               Put (F.Value_Type.all);
+               if Col > 76 then
+                  New_Line;
+                  Put ("     ");
+               end if;
+               Put (" is");
+               New_Line;
+               Put_Line ("   begin");
+               if Flag_Checks then
+                  Put ("      Check_Kind_For_");
+                  Put (F.Name);
+                  Put (" (");
+                  Put (F.Target_Name.all);
+                  Put (");");
+                  New_Line;
+               end if;
+               Put ("      return ");
+               case F.Conv is
+                  when None =>
+                     null;
+                  when Via_Pos_Attr =>
+                     Put (F.Value_Type.all);
+                     Put ("'Val (");
+                  when Via_Unchecked =>
+                     Put (Field_Table.Table (F.Field).Ftype.all);
+                     Put ("_To_");
+                     Put (F.Value_Type.all);
+                     Put (" (");
+               end case;
+               if Same_Name then
+                  Put ("Nodes.");
+               end if;
+               Put ("Get_");
+               Put (Field_Table.Table (F.Field).Name.all);
+               Put (" (");
+               Put (F.Target_Name.all);
+               Put (")");
+               case F.Conv is
+                  when None =>
+                     null;
+                  when Via_Pos_Attr
+                    | Via_Unchecked =>
+                     Put (")");
+               end case;
+               Put (";");
+               New_Line;
+               Put ("   end Get_");
+               Put (F.Name);
+               Put (";");
+               New_Line;
+               New_Line;
+
+               if F.Value_Name /= null then
+                  Put ("   procedure Set_");
+                  Put (F.Name);
+                  Put (" (");
+                  Put (F.Target_Name.all);
+                  Put (" : ");
+                  Put (F.Target_Type.all);
+                  Put ("; ");
+                  Put (F.Value_Name.all);
+                  Put (" : ");
+                  Put (F.Value_Type.all);
+                  Put (")");
+                  if Col > 76 then
+                     New_Line;
+                     Put ("     ");
+                  end if;
+                  Put (" is");
+                  New_Line;
+                  Put_Line ("   begin");
+                  if Flag_Checks then
+                     Put ("      Check_Kind_For_");
+                     Put (F.Name);
+                     Put (" (");
+                     Put (F.Target_Name.all);
+                     Put (");");
+                     New_Line;
+                  end if;
+                  Put ("      ");
+                  if Same_Name then
+                     Put ("Nodes.");
+                  end if;
+                  Put ("Set_");
+                  Put (Field_Table.Table (F.Field).Name.all);
+                  Put (" (");
+                  Put (F.Target_Name.all);
+                  Put (", ");
+                  case F.Conv is
+                     when None =>
+                        null;
+                     when Via_Pos_Attr =>
+                        Put (F.Value_Type.all);
+                        Put ("'Pos (");
+                     when Via_Unchecked =>
+                        Put (F.Value_Type.all);
+                        Put ("_To_");
+                        Put (Field_Table.Table (F.Field).Ftype.all);
+                        Put (" (");
+                  end case;
+                  Put (F.Value_Name.all);
+                  case F.Conv is
+                     when None =>
+                        null;
+                     when Via_Pos_Attr
+                       | Via_Unchecked =>
+                        Put (")");
+                  end case;
+                  Put (");");
+                  New_Line;
+                  Put ("   end Set_");
+                  Put (F.Name);
+                  Put (";");
+                  New_Line;
+                  New_Line;
+               end if;
+            end if;
+         end;
+      end loop;
+   end Gen_Func;
+
+   procedure List_Free_Fields
+   is
+   begin
+      for I in Iir_Table.First .. Iir_Table.Last loop
+         declare
+            Info : Iir_Info renames Iir_Table.Table (I);
+         begin
+            Put_Line (Info.Name.all);
+            for J in 1 .. Field_Pos loop
+               if Info.Func (J) = No_Func
+                 and then Field_Table.Table (J).Formats (Info.Format)
+               then
+                  Put (" ");
+                  Put_Line (Field_Table.Table (J).Name.all);
+               end if;
+            end loop;
+         end;
+      end loop;
+   end List_Free_Fields;
+end Check_Iirs_Pkg;
+
diff --git a/xtools/check_iirs_pkg.ads b/xtools/check_iirs_pkg.ads
new file mode 100644
index 000000000..e03abab4a
--- /dev/null
+++ b/xtools/check_iirs_pkg.ads
@@ -0,0 +1,38 @@
+--  Tool to check the coherence of the iirs package.
+--  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 Check_Iirs_Pkg is
+   --  If set, disp all Iir kind.
+   Flag_Disp_Iir : Boolean := False;
+
+   --  If set, disp Iir_Kinds subtype.
+   Flag_Disp_Subtype : Boolean := False;
+
+   --  If set, generate checks.
+   Flag_Checks : Boolean := True;
+
+   procedure Read_Fields;
+
+   procedure Check_Iirs;
+
+   procedure Read_Desc;
+
+   procedure Gen_Func;
+
+   procedure List_Free_Fields;
+end Check_Iirs_Pkg;