--vcdz option added,

switched to gcc-4.0.2,
can be compiled with GNAT GPL 2005
ready for ada05 (interface identifier not used anymore)
bug fixes

53 files changed, 3699 insertions, 364 deletions

diff --git a/canon.adb b/canon.adb
index 1ac67b4e5..e9d80b6aa 100644
--- a/canon.adb
+++ b/canon.adb
@@ -534,7 +534,7 @@ package body Canon is
    is
       -- The canon list of association.
       N_Chain, Last : Iir;
-      Interface : Iir;
+      Inter : Iir;
       Assoc_El, Prev_Assoc_El, Next_Assoc_El : Iir;
       Assoc_Chain : Iir;
 
@@ -553,8 +553,8 @@ package body Canon is
 
       -- Reorder the list of association in the interface order.
       -- Add missing associations.
-      Interface := Interface_Chain;
-      while Interface /= Null_Iir loop
+      Inter := Interface_Chain;
+      while Inter /= Null_Iir loop
          --  Search associations with INTERFACE.
          Found := False;
          Assoc_El := Assoc_Chain;
@@ -562,9 +562,9 @@ package body Canon is
          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);
+               Set_Formal (Assoc_El, Inter);
             end if;
-            if Get_Associated_Formal (Assoc_El) = Interface then
+            if Get_Associated_Formal (Assoc_El) = Inter then
 
                --  Remove ASSOC_EL from ASSOC_CHAIN
                if Prev_Assoc_El /= Null_Iir then
@@ -606,11 +606,11 @@ package body Canon is
          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);
+         Set_Formal (Assoc_El, Inter);
          Sub_Chain_Append (N_Chain, Last, Assoc_El);
 
          << Done >> null;
-         Interface := Get_Chain (Interface);
+         Inter := Get_Chain (Inter);
       end loop;
       pragma Assert (Assoc_Chain = Null_Iir);
 
@@ -982,7 +982,7 @@ package body Canon is
       Assoc : Iir;
       Imp : Iir;
       Driver_List : Iir_Driver_List;
-      Interface : Iir;
+      Inter : Iir;
       Sensitivity_List : Iir_List;
       Is_Sensitized : Boolean;
    begin
@@ -1043,14 +1043,14 @@ package body Canon is
       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
+               Inter := Get_Associated_Formal (Assoc);
+               if Get_Mode (Inter) 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
+               if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration
+                 and then Get_Mode (Inter) in Iir_Out_Modes
                then
                   if Driver_List = Null_Iir_List then
                      Driver_List := Create_Iir_List;
diff --git a/disp_tree.adb b/disp_tree.adb
index 6b3203f33..8f4c967f4 100644
--- a/disp_tree.adb
+++ b/disp_tree.adb
@@ -16,8 +16,6 @@
 --  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;
@@ -32,27 +30,20 @@ package body Disp_Tree is
       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);
+      Res : String (1 .. 10);
+      Hex_Digits : constant array (Int32 range 0 .. 15) of Character
+        := "0123456789abcdef";
+      N : Int32 := Int32 (Node);
    begin
-      Put ('[' & Addr_Image (To_Addr (Node)) & ']');
+      for I in reverse 2 .. 9 loop
+         Res (I) := Hex_Digits (N mod 16);
+         N := N / 16;
+      end loop;
+      Res (1) := '[';
+      Res (10) := ']';
+      Put (Res);
    end Disp_Iir_Address;
 
    function Inc_Tab (Tab: Natural) return Natural is
diff --git a/disp_vhdl.adb b/disp_vhdl.adb
index 1976f0324..982977ff3 100644
--- a/disp_vhdl.adb
+++ b/disp_vhdl.adb
@@ -669,10 +669,11 @@ package body Disp_Vhdl is
       end case;
    end Disp_Signal_Kind;
 
-   procedure Disp_Interface_Declaration (Interface: Iir) is
+   procedure Disp_Interface_Declaration (Inter: Iir)
+   is
       Default: Iir;
    begin
-      case Get_Kind (Interface) is
+      case Get_Kind (Inter) is
          when Iir_Kind_Signal_Interface_Declaration =>
             Put ("signal ");
          when Iir_Kind_Variable_Interface_Declaration =>
@@ -680,16 +681,16 @@ package body Disp_Vhdl is
          when Iir_Kind_Constant_Interface_Declaration =>
             Put ("constant ");
          when others =>
-            Error_Kind ("disp_interface_declaration", Interface);
+            Error_Kind ("disp_interface_declaration", Inter);
       end case;
-      Disp_Name_Of (Interface);
+      Disp_Name_Of (Inter);
       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));
+      Disp_Mode (Get_Mode (Inter));
+      Disp_Type (Get_Type (Inter));
+      if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration then
+         Disp_Signal_Kind (Get_Signal_Kind (Inter));
       end if;
-      Default := Get_Default_Value (Interface);
+      Default := Get_Default_Value (Inter);
       if Default /= Null_Iir then
          Put (" := ");
          Disp_Expression (Default);
@@ -698,7 +699,7 @@ package body Disp_Vhdl is
 
    procedure Disp_Interface_Chain (Chain: Iir; Str: String)
    is
-      Interface: Iir;
+      Inter: Iir;
       Start: Count;
    begin
       if Chain = Null_Iir then
@@ -706,17 +707,17 @@ package body Disp_Vhdl is
       end if;
       Put (" (");
       Start := Col;
-      Interface := Chain;
-      while Interface /= Null_Iir loop
+      Inter := Chain;
+      while Inter /= Null_Iir loop
          Set_Col (Start);
-         Disp_Interface_Declaration (Interface);
-         if Get_Chain (Interface) /= Null_Iir then
+         Disp_Interface_Declaration (Inter);
+         if Get_Chain (Inter) /= Null_Iir then
             Put ("; ");
          else
             Put (')');
             Put (Str);
          end if;
-         Interface := Get_Chain (Interface);
+         Inter := Get_Chain (Inter);
       end loop;
    end Disp_Interface_Chain;
 
diff --git a/doc/ghdl.texi b/doc/ghdl.texi
index 4824cdf84..41785e505 100644
--- a/doc/ghdl.texi
+++ b/doc/ghdl.texi
@@ -1522,13 +1522,21 @@ Do not simulate, only elaborate.  This may be used with
 design.
 
 @item --vcd=@var{FILENAME}
+@item --vcdgz=@var{FILENAME}
 @cindex @option{--vcd} option
+@cindex @option{--vcdgz} 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.
+@option{--vcd} dumps 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.
+
+The @option{--vcdgz} option is the same as the @option{--vcd} option,
+but the output is compressed using the @code{zlib} (@code{gzip}
+compression).  However, you can't use the @samp{-} filename.
+Furthermore, only one VCD file can be written.
 
 @dfn{VCD} (value change dump) is a file format defined
 by the @code{verilog} standard and used by virtually any wave viewer.
diff --git a/evaluation.adb b/evaluation.adb
index c64eea451..85df7c3bc 100644
--- a/evaluation.adb
+++ b/evaluation.adb
@@ -1171,6 +1171,34 @@ package body Evaluation is
                               Natural (Get_Value (Get_Parameter (Attr)) - 1));
    end Eval_Array_Attribute;
 
+   function Eval_Integer_Image (Val : Iir_Int64; Orig : Iir) return Iir
+   is
+      use Str_Table;
+      Img : String (1 .. 24); --  23 is enough, 24 is rounded.
+      L : Natural;
+      V : Iir_Int64;
+      Id : String_Id;
+   begin
+      V := Val;
+      L := Img'Last;
+      loop
+         Img (L) := Character'Val (Character'Pos ('0') + abs (V rem 10));
+         V := V / 10;
+         L := L - 1;
+         exit when V = 0;
+      end loop;
+      if Val < 0 then
+         Img (L) := '-';
+         L := L - 1;
+      end if;
+      Id := Start;
+      for I in L + 1 .. Img'Last loop
+         Append (Img (I));
+      end loop;
+      Finish;
+      return Build_String (Id, Int32 (Img'Last - L), Orig);
+   end Eval_Integer_Image;
+
    function Eval_Incdec (Expr : Iir; N : Iir_Int64) return Iir
    is
       P : Iir_Int64;
@@ -1430,6 +1458,22 @@ package body Evaluation is
                   return Build_Discrete (Val, Expr);
                end if;
             end;
+         when Iir_Kind_Image_Attribute =>
+            declare
+               Param : Iir;
+               Param_Type : Iir;
+            begin
+               Param := Get_Parameter (Expr);
+               Param := Eval_Static_Expr (Param);
+               Set_Parameter (Expr, Param);
+               Param_Type := Get_Base_Type (Get_Type (Param));
+               case Get_Kind (Param_Type) is
+                  when Iir_Kind_Integer_Type_Definition =>
+                     return Eval_Integer_Image (Get_Value (Param), Expr);
+                  when others =>
+                     Error_Kind ("eval_static_expr('image)", Param_Type);
+               end case;
+            end;
 
          when Iir_Kind_Left_Type_Attribute =>
             return Build_Constant
diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile
new file mode 100644
index 000000000..69c99969d
--- /dev/null
+++ b/ortho/gcc/Makefile
@@ -0,0 +1,32 @@
+ortho_srcdir=..
+orthobe_srcdir=$(ortho_srcdir)/gcc
+agcc_objdir=.
+agcc_srcdir=$(ortho_srcdir)/gcc
+AGCC_GCCSRC_DIR:=$(HOME)/dist/gcc-4.0.1
+AGCC_GCCOBJ_DIR:=$(AGCC_GCCSRC_DIR)-objs
+SED=sed
+
+all: $(ortho_exec)
+
+include $(orthobe_srcdir)/Makefile.inc
+
+ORTHO_BASENAME=$(orthobe_srcdir)/ortho_gcc
+ORTHO_PACKAGE=Ortho_Gcc
+
+
+$(ortho_exec): $(AGCC_DEPS) $(ORTHO_BASENAME).ads force
+	gnatmake -m -o $@ -g -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/Makefile.inc b/ortho/gcc/Makefile.inc
new file mode 100644
index 000000000..33ac0f428
--- /dev/null
+++ b/ortho/gcc/Makefile.inc
@@ -0,0 +1,62 @@
+#  -*- Makefile -*- for the gcc implemantation of ortho.
+#  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.
+
+# 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 \
+ -I$(AGCC_GCCSRC_DIR)/libcpp/include
+AGCC_CFLAGS=-g -DIN_GCC $(AGCC_INC_FLAGS)
+
+AGCC_LOCAL_OBJS=ortho-lang.o gcc-version.o
+
+AGCC_DEPS := $(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)/libcpp/libcpp.a \
+	$(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a
+
+gcc-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>";' >> $@
+
+gcc-version.o: gcc-version.c
+	$(CC) -c -o $@ $< $(AGCC_CFLAGS)
+
+ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \
+ $(AGCC_GCCOBJ_DIR)/gcc/gtype-vhdl.h \
+ $(AGCC_GCCOBJ_DIR)/gcc/gt-vhdl-ortho-lang.h
+	$(CC) -c -o $@ $< $(AGCC_CFLAGS)
+
+agcc-clean: force
+	$(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/gcc/lang.opt b/ortho/gcc/lang.opt
new file mode 100644
index 000000000..2f945266b
--- /dev/null
+++ b/ortho/gcc/lang.opt
@@ -0,0 +1,70 @@
+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 function declarations override implicit one in use
+
+l
+vhdl Joined Separate
+-l<filename>	Put list of files for link in <filename>
diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c
new file mode 100644
index 000000000..609ec737e
--- /dev/null
+++ b/ortho/gcc/ortho-lang.c
@@ -0,0 +1,2052 @@
+#include <stddef.h>
+#include <math.h>
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "tm_p.h"
+#include "defaults.h"
+#include "ggc.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "toplev.h"
+#include "opts.h"
+#include "options.h"
+#include "real.h"
+#include "tree-gimple.h"
+#include "function.h"
+#include "cgraph.h"
+
+const int tree_identifier_size = sizeof (struct tree_identifier);
+
+struct binding_level GTY(())
+{
+  /*  The BIND_EXPR node for this binding.  */
+  tree bind;
+
+  /*  The BLOCK node for this binding.  */
+  tree block;
+
+  /*  If true, stack must be saved (alloca is used).  */
+  int save_stack;
+
+  /*  Parent binding level.  */
+  struct binding_level *prev;
+
+  /*  Decls in this binding.  */
+  tree first_decl;
+  tree last_decl;
+
+  /*  Blocks in this binding.  */
+  tree first_block;
+  tree last_block;
+};
+
+/*  The current binding level.  */
+static GTY(()) struct binding_level *cur_binding_level = NULL;
+
+/*  Chain of unused binding levels.  */
+static GTY(()) struct binding_level *old_binding_levels = NULL;
+
+static tree cur_stmts = NULL_TREE;
+
+static void
+push_binding (void)
+{
+  struct binding_level *res;
+
+  if (old_binding_levels == NULL)
+    res = (struct binding_level *) ggc_alloc (sizeof (struct binding_level));
+  else
+    {
+      res = old_binding_levels;
+      old_binding_levels = res->prev;
+    }
+
+  /* Init.  */
+  res->first_decl = NULL_TREE;
+  res->last_decl = NULL_TREE;
+
+  res->first_block = NULL_TREE;
+  res->last_block = NULL_TREE;
+
+  res->bind = make_node (BIND_EXPR);
+  res->block = make_node (BLOCK);
+  BIND_EXPR_BLOCK (res->bind) = res->block;
+  TREE_SIDE_EFFECTS (res->bind) = 1;
+  TREE_TYPE (res->bind) = void_type_node;
+  TREE_USED (res->block) = 1;
+
+  if (cur_binding_level != NULL)
+    {
+      /* Append the block created.  */
+      if (cur_binding_level->first_block == NULL)
+	cur_binding_level->first_block = res->block;
+      else
+	TREE_CHAIN (cur_binding_level->last_block) = res->block;
+      cur_binding_level->last_block = res->block;
+
+      BLOCK_SUPERCONTEXT (res->block) = cur_binding_level->block;
+    }
+
+  res->prev = cur_binding_level;
+  cur_binding_level = res;
+}
+
+static void
+push_decl (tree decl)
+{
+  DECL_CONTEXT (decl) = current_function_decl;
+
+  if (cur_binding_level->first_decl == NULL)
+    cur_binding_level->first_decl = decl;
+  else
+    TREE_CHAIN (cur_binding_level->last_decl) = decl;
+  cur_binding_level->last_decl = decl;
+}
+
+static tree
+pop_binding (void)
+{
+  tree res;
+  struct binding_level *cur;
+
+  cur = cur_binding_level;
+  res = cur->bind;
+
+  if (cur->save_stack)
+    {
+      tree tmp_var;
+      tree save;
+      tree save_call;
+      tree restore;
+      tree t;
+
+      /* Create an artificial var to save the stack pointer.  */
+      tmp_var = build_decl (VAR_DECL, NULL, ptr_type_node);
+      DECL_ARTIFICIAL (tmp_var) = 1;
+      DECL_IGNORED_P (tmp_var) = 1;
+      TREE_USED (tmp_var) = 1;
+      push_decl (tmp_var);
+
+      /* Create the save stmt.  */
+      save_call = build_function_call_expr
+	(implicit_built_in_decls[BUILT_IN_STACK_SAVE], NULL_TREE);
+      save = build (MODIFY_EXPR, ptr_type_node, tmp_var, save_call);
+
+      /* Create the restore stmt.  */
+      restore = build_function_call_expr
+	(implicit_built_in_decls[BUILT_IN_STACK_RESTORE],
+	 tree_cons (NULL_TREE, tmp_var, NULL_TREE));
+
+      /* Build a try-finally block.
+	 The statement list is the block of current statements.  */
+      t = build (TRY_FINALLY_EXPR, void_type_node, cur_stmts, NULL_TREE);
+      TREE_SIDE_EFFECTS (t) = 1;
+
+      /* The finally block is the restore stmt.  */
+      append_to_statement_list (restore, &TREE_OPERAND (t, 1));
+
+      /* The body of the BIND_BLOCK is the save stmt, followed by the
+	 try block.  */
+      BIND_EXPR_BODY (res) = NULL_TREE;
+      append_to_statement_list (save, &BIND_EXPR_BODY (res));
+      append_to_statement_list (t, &BIND_EXPR_BODY (res));
+    }
+  else
+    {
+      /* The body of the BIND_BLOCK is the statement block.  */
+      BIND_EXPR_BODY (res) = cur_stmts;
+    }
+  BIND_EXPR_VARS (res) = cur->first_decl;
+
+  BLOCK_SUBBLOCKS (cur->block) = cur->first_block;
+  BLOCK_VARS (cur->block) = cur->first_decl;
+
+  cur_binding_level = cur->prev;
+  cur->prev = old_binding_levels;
+  old_binding_levels = cur;
+
+  return res;
+}
+
+static void
+append_stmt (tree stmt)
+{
+  if (!EXPR_HAS_LOCATION (stmt))
+    SET_EXPR_LOCATION (stmt, input_location);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_to_statement_list (stmt, &cur_stmts);
+}
+
+static void
+push_stmts (tree stmts)
+{
+  TREE_CHAIN (stmts) = cur_stmts;
+  cur_stmts = stmts;
+}
+
+static void
+pop_stmts (void)
+{
+  tree prev;
+
+  prev = cur_stmts;
+  cur_stmts = TREE_CHAIN (prev);
+  TREE_CHAIN (prev) = NULL_TREE;
+}
+
+static GTY(()) tree top;
+
+static GTY(()) tree stack_alloc_function_ptr;
+extern void ortho_fe_init (void);
+
+static int
+global_bindings_p (void)
+{
+  return cur_binding_level->prev == NULL;
+}
+
+static void
+insert_block (tree b)
+{
+  abort ();
+}
+
+static tree
+pushdecl (tree t)
+{
+  abort ();
+}
+
+static tree
+builtin_function (const char *name,
+		  tree type,
+		  int function_code,
+		  enum built_in_class class,
+		  const char *library_name,
+		  tree attrs ATTRIBUTE_UNUSED);
+
+REAL_VALUE_TYPE fp_const_p5; /* 0.5 */
+REAL_VALUE_TYPE fp_const_m_p5; /* -0.5 */
+REAL_VALUE_TYPE fp_const_zero; /* 0.0 */
+
+static bool
+ortho_init (void)
+{
+  tree n;
+
+  input_location.line = 0;
+
+  /* Create a global binding.  */
+  push_binding ();
+
+  build_common_tree_nodes (0, 0);
+  n = build_decl (TYPE_DECL, get_identifier ("int"), integer_type_node);
+  push_decl (n);
+  n = build_decl (TYPE_DECL, get_identifier ("char"), char_type_node);
+  push_decl (n);
+  size_type_node = unsigned_type_node;
+  set_sizetype (unsigned_type_node);
+  build_common_tree_nodes_2 (0);
+
+  /* Create alloca builtin.  */
+  {
+    tree args_type = tree_cons (NULL_TREE, size_type_node, void_list_node);
+    tree func_type = build_function_type (ptr_type_node, args_type);
+       
+    implicit_built_in_decls[BUILT_IN_ALLOCA] = builtin_function
+      ("__builtin_alloca", func_type,
+       BUILT_IN_ALLOCA, BUILT_IN_NORMAL, NULL, NULL_TREE);
+    
+    stack_alloc_function_ptr = build1
+      (ADDR_EXPR, 
+       build_pointer_type (func_type),
+       implicit_built_in_decls[BUILT_IN_ALLOCA]);
+  }
+
+  {
+    tree ptr_ftype = build_function_type (ptr_type_node, NULL_TREE);
+
+    implicit_built_in_decls[BUILT_IN_STACK_SAVE] = builtin_function
+      ("__builtin_stack_save", ptr_ftype,
+       BUILT_IN_STACK_SAVE, BUILT_IN_NORMAL, NULL, NULL_TREE);
+  }
+
+  {
+    tree ftype_ptr;
+
+    ftype_ptr = build_function_type
+      (void_type_node,
+       tree_cons (NULL_TREE, ptr_type_node, NULL_TREE));
+
+    implicit_built_in_decls[BUILT_IN_STACK_RESTORE] = builtin_function
+      ("__builtin_stack_restore", ftype_ptr,
+       BUILT_IN_STACK_RESTORE, BUILT_IN_NORMAL, NULL, NULL_TREE);
+  }
+
+  {
+    REAL_VALUE_TYPE v;
+    
+    REAL_VALUE_FROM_INT (v, 1, 0, DFmode);
+    real_ldexp (&fp_const_p5, &v, -1);
+    
+    REAL_VALUE_FROM_INT (v, -1, -1, DFmode);
+    real_ldexp (&fp_const_m_p5, &v, -1);
+    
+    REAL_VALUE_FROM_INT (fp_const_zero, 0, 0, DFmode);
+  }
+
+  ortho_fe_init ();
+
+  return true;
+}
+
+static void
+ortho_finish (void)
+{
+}
+
+static unsigned int
+ortho_init_options (unsigned int argc, const char **argv)
+{
+  return CL_vhdl;
+}
+
+static bool
+ortho_post_options (const char **pfilename)
+{
+  if (*pfilename == NULL || strcmp (*pfilename, "-") == 0)
+    *pfilename = "*stdin*";
+
+  /* Run the back-end.  */
+  return false;
+}
+
+extern int lang_handle_option (const char *opt, const char *arg);
+
+static int
+ortho_handle_option (size_t code, const char *arg, int value)
+{
+  const char *opt;
+
+  opt = cl_options[code].opt_text;
+
+  switch (code)
+    {
+    case OPT__elab:
+    case OPT_l:
+    case OPT_c:
+    case OPT__anaelab:
+      /* Only a few options have a real arguments.  */
+      return lang_handle_option (opt, arg);
+    default:
+      /* The other options must have a joint argument.  */
+      if (arg != NULL)
+	{
+	  size_t len1;
+	  size_t len2;
+	  char *nopt;
+	  
+	  len1 = strlen (opt);
+	  len2 = strlen (arg);
+	  nopt = alloca (len1 + len2 + 1);
+	  memcpy (nopt, opt, len1);
+	  memcpy (nopt + len1, arg, len2);
+	  nopt[len1 + len2] = 0;
+	  opt = nopt;
+	}
+      return lang_handle_option (opt, NULL);
+    }
+}
+
+#if 0
+void
+linemap_init (void *s)
+{
+}
+#endif
+
+extern int lang_parse_file (const char *filename);
+
+static void
+ortho_parse_file (int debug)
+{
+  const char *filename;
+
+  if (num_in_fnames == 0)
+    filename = NULL;
+  else
+    filename = in_fnames[0];
+
+  if (!lang_parse_file (filename))
+    errorcount++;
+  else
+    {
+      cgraph_finalize_compilation_unit ();
+      cgraph_optimize ();
+    }
+}
+
+static void
+ortho_expand_function (tree fndecl)
+{
+  if (DECL_CONTEXT (fndecl) != NULL_TREE)
+    {
+      push_function_context ();
+      tree_rest_of_compilation (fndecl);
+      pop_function_context ();
+    }
+  else
+      tree_rest_of_compilation (fndecl);
+}
+
+/*  Called by the back-end or by the front-end when the address of EXP
+    must be taken.
+    This function should found the base object (if any), and mark it as
+    addressable (via TREE_ADDRESSABLE).  It may emit a warning if this
+    object cannot be addressable (front-end restriction).
+    Returns TRUE in case of success, FALSE in case of failure.
+    Note that the status is never checked by the back-end.  */
+static bool
+ortho_mark_addressable (tree exp)
+{
+  tree n;
+
+  n = exp;
+
+  while (1)
+    switch (TREE_CODE (n))
+      {
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+	TREE_ADDRESSABLE (n) = 1;
+	return true;
+
+      case COMPONENT_REF:
+      case ARRAY_REF:
+	n = TREE_OPERAND (n, 0);
+	break;
+
+      case FUNCTION_DECL:
+      case CONSTRUCTOR:
+	TREE_ADDRESSABLE (n) = 1;
+	return true;
+
+      case INDIRECT_REF:
+	return true;
+
+      default:
+	abort ();
+      }
+}
+
+static tree
+ortho_truthvalue_conversion (tree expr)
+{
+  tree expr_type;
+  tree t;
+  tree f;
+
+  expr_type = TREE_TYPE (expr);
+  if (TREE_CODE (expr_type) != BOOLEAN_TYPE)
+    {
+      t = integer_one_node;
+      f = integer_zero_node;
+    }
+  else
+    {
+      f = TYPE_MIN_VALUE (expr_type);
+      t = TYPE_MAX_VALUE (expr_type);
+    }
+
+
+  switch (TREE_CODE (expr))
+    {
+    case EQ_EXPR:
+    case NE_EXPR:
+    case LE_EXPR:
+    case GE_EXPR:
+    case LT_EXPR:
+    case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case ERROR_MARK:
+      return expr;
+
+    case INTEGER_CST:
+      /* Not 0 is true.  */
+      return integer_zerop (expr) ? f : t;
+
+    case REAL_CST:
+      return real_zerop (expr) ? f : t;
+
+    default:
+      abort ();
+    }
+}
+
+/* Return a definition for a builtin function named NAME and whose data type
+   is TYPE.  TYPE should be a function type with argument types.
+   FUNCTION_CODE tells later passes how to compile calls to this function.
+   See tree.h for its possible values.
+
+   If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+   the name to be called if we can't opencode the function.  If
+   ATTRS is nonzero, use that for the function's attribute list.  */
+static tree
+builtin_function (const char *name,
+		  tree type,
+		  int function_code,
+		  enum built_in_class class,
+		  const char *library_name,
+		  tree attrs ATTRIBUTE_UNUSED)
+{
+  tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  if (library_name)
+    SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
+  make_decl_rtl (decl);
+  DECL_BUILT_IN_CLASS (decl) = class;
+  DECL_FUNCTION_CODE (decl) = function_code;
+  return decl;
+}
+
+/*  This variable keeps a table for types for each precision so that we only
+    allocate each of them once. Signed and unsigned types are kept separate. 
+ */
+static GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
+
+/*  Return an integer type with the number of bits of precision given by
+    PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
+    it is a signed type.  */
+static tree
+type_for_size (unsigned int precision, int unsignedp)
+{
+  tree t;
+
+  if (precision <= MAX_BITS_PER_WORD
+      && signed_and_unsigned_types[precision][unsignedp] != NULL_TREE)
+    return signed_and_unsigned_types[precision][unsignedp];
+
+  if (unsignedp) 
+    t = make_unsigned_type (precision);
+  else
+    t = make_signed_type (precision);
+
+  if (precision <= MAX_BITS_PER_WORD)
+    signed_and_unsigned_types[precision][unsignedp] = t;
+
+  return t;
+}
+
+/*  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+    an unsigned type; otherwise a signed type is returned.  */
+static tree
+type_for_mode (enum machine_mode mode, int unsignedp)
+{
+  return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
+}
+
+/*  Return the unsigned version of a TYPE_NODE, a scalar type.  */
+static tree
+unsigned_type (tree type)
+{
+  return type_for_size (TYPE_PRECISION (type), 1);
+}
+
+/*  Return the signed version of a TYPE_NODE, a scalar type.  */
+static tree
+signed_type (tree type)
+{
+  return type_for_size (TYPE_PRECISION (type), 0);
+}
+
+/*  Return a type the same as TYPE except unsigned or signed according to
+    UNSIGNEDP.  */
+static tree
+signed_or_unsigned_type (int unsignedp, tree type)
+{
+  if (!INTEGRAL_TYPE_P (type)
+      || TYPE_UNSIGNED (type) == unsignedp)
+    return type;
+  else
+    return type_for_size (TYPE_PRECISION (type), unsignedp);
+}
+
+#undef LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME "vhdl"
+#undef LANG_HOOKS_IDENTIFIER_SIZE
+#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
+#undef LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT ortho_init
+#undef LANG_HOOKS_FINISH
+#define LANG_HOOKS_FINISH ortho_finish
+#undef LANG_HOOKS_INIT_OPTIONS
+#define LANG_HOOKS_INIT_OPTIONS ortho_init_options
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION ortho_handle_option
+#undef LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS ortho_post_options
+#undef LANG_HOOKS_HONOR_READONLY
+#define LANG_HOOKS_HONOR_READONLY true
+#undef LANG_HOOKS_TRUTHVALUE_CONVERSION
+#define LANG_HOOKS_TRUTHVALUE_CONVERSION ortho_truthvalue_conversion
+#undef LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE ortho_mark_addressable
+#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
+#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION ortho_expand_function
+
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE type_for_mode
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE type_for_size
+#undef LANG_HOOKS_SIGNED_TYPE
+#define LANG_HOOKS_SIGNED_TYPE signed_type
+#undef LANG_HOOKS_UNSIGNED_TYPE
+#define LANG_HOOKS_UNSIGNED_TYPE unsigned_type
+#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
+#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE signed_or_unsigned_type
+#undef LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE ortho_parse_file
+
+#define pushlevel lhd_do_nothing_i
+#define poplevel lhd_do_nothing_iii_return_null_tree
+#define set_block lhd_do_nothing_t
+#undef LANG_HOOKS_GETDECLS
+#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
+
+const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+/* Tree code classes.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
+
+const enum tree_code_class 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 (())
+{
+};
+
+struct chain_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+chain_init (struct chain_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+chain_append (struct chain_constr_type *constr, tree el)
+{
+  if (constr->first == NULL_TREE)
+    {
+      if (constr->last != NULL_TREE)
+	abort ();
+      constr->first = el;
+    }
+  else
+    TREE_CHAIN (constr->last) = el;
+  constr->last = el;
+}
+
+struct list_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+list_init (struct list_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+ortho_list_append (struct list_constr_type *constr, tree el)
+{
+  tree res;
+
+  res = tree_cons (NULL_TREE, el, NULL_TREE);
+  if (constr->first == NULL_TREE)
+    constr->first = res;
+  else
+    TREE_CHAIN (constr->last) = res;
+  constr->last = res;
+}
+
+enum ON_op_kind {
+  /*  Not an operation; invalid.  */
+  ON_Nil,
+
+  /*  Dyadic operations.  */
+  ON_Add_Ov,
+  ON_Sub_Ov,
+  ON_Mul_Ov,
+  ON_Div_Ov,
+  ON_Rem_Ov,
+  ON_Mod_Ov,
+
+  /*  Binary operations.  */
+  ON_And,
+  ON_Or, 
+  ON_Xor,
+  ON_And_Then,
+  ON_Or_Else,
+
+  /*  Monadic operations.  */
+  ON_Not,
+  ON_Neg_Ov,
+  ON_Abs_Ov,
+
+  /*  Comparaisons  */
+  ON_Eq,
+  ON_Neq,
+  ON_Le,
+  ON_Lt,
+  ON_Ge,
+  ON_Gt,
+
+  ON_LAST
+};
+
+
+static enum tree_code ON_op_to_TREE_CODE[ON_LAST] = {
+  ERROR_MARK,
+
+  PLUS_EXPR,
+  MINUS_EXPR,
+  MULT_EXPR,
+  ERROR_MARK,
+  TRUNC_MOD_EXPR,
+  FLOOR_MOD_EXPR,
+
+  TRUTH_AND_EXPR,
+  TRUTH_OR_EXPR,
+  TRUTH_XOR_EXPR,
+  TRUTH_ANDIF_EXPR,
+  TRUTH_ORIF_EXPR,
+
+  TRUTH_NOT_EXPR,
+  NEGATE_EXPR,
+  ABS_EXPR,
+
+  EQ_EXPR,
+  NE_EXPR,
+  LE_EXPR,
+  LT_EXPR,
+  GE_EXPR,
+  GT_EXPR,
+};
+
+tree
+new_dyadic_op (enum ON_op_kind kind, tree left, tree right)
+{
+  tree left_type;
+  enum tree_code code;
+
+  left_type = TREE_TYPE (left);
+  if (left_type != TREE_TYPE (right))
+    abort ();
+
+  switch (kind)
+    {
+    case ON_Div_Ov:
+      if (TREE_CODE (left_type) == REAL_TYPE)
+	code = RDIV_EXPR;
+      else
+	code = TRUNC_DIV_EXPR;
+      break;
+    default:
+      code = ON_op_to_TREE_CODE[kind];
+      break;
+    }
+  return build2 (code, left_type, left, right);
+}
+
+tree
+new_monadic_op (enum ON_op_kind kind, tree operand)
+{
+  return build1 (ON_op_to_TREE_CODE[kind], TREE_TYPE (operand), operand);
+}
+
+tree
+new_compare_op (enum ON_op_kind kind, tree left, tree right, tree ntype)
+{
+  if (TREE_CODE (ntype) != BOOLEAN_TYPE)
+    abort ();
+  if (TREE_TYPE (left) != TREE_TYPE (right))
+    abort ();
+  return build2 (ON_op_to_TREE_CODE[kind], ntype, left, right);
+}
+
+tree
+new_convert_ov (tree val, tree rtype)
+{
+  tree val_type;
+  enum tree_code val_code;
+  enum tree_code rtype_code;
+  enum tree_code code;
+
+  val_type = TREE_TYPE (val);
+  if (val_type == rtype)
+    return val;
+
+  /*  FIXME: check conversions.  */
+  val_code = TREE_CODE (val_type);
+  rtype_code = TREE_CODE (rtype);
+  if (val_code == POINTER_TYPE && rtype_code == POINTER_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == INTEGER_TYPE)
+    {
+      /*  REAL to INTEGER
+          Gcc only handles FIX_TRUNC_EXPR, but we need rounding.  */
+      tree m_p5;
+      tree p5;
+      tree zero;
+      tree saved;
+      tree comp;
+      tree adj;
+      tree res;
+
+      m_p5 = build_real (val_type, fp_const_m_p5);
+      p5 = build_real (val_type, fp_const_p5);
+      zero = build_real (val_type, fp_const_zero);
+      saved = save_expr (val);
+      comp = build2 (GE_EXPR, integer_type_node, saved, zero);
+      /*  FIXME: instead of res = res + (comp ? .5 : -.5)
+	  do: res = res (comp ? + : -) .5  */
+      adj = build3 (COND_EXPR, val_type, comp, p5, m_p5);
+      res = build2 (PLUS_EXPR, val_type, saved, adj);
+      res = build1 (FIX_TRUNC_EXPR, rtype, res);
+      return res;
+    }
+  else if (val_code == INTEGER_TYPE && rtype_code == ENUMERAL_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == ENUMERAL_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == REAL_TYPE)
+    code = FLOAT_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == REAL_TYPE)
+    code = NOP_EXPR;
+  else
+    abort ();
+
+  return build1 (code, rtype, val);
+}
+
+tree
+new_alloca (tree rtype, tree size)
+{
+  tree res;
+  tree args;
+
+  /* Must save stack.  */
+  cur_binding_level->save_stack = 1;
+
+  args = tree_cons (NULL_TREE, fold_convert (size_type_node, size), NULL_TREE);
+  res = build3 (CALL_EXPR, ptr_type_node, stack_alloc_function_ptr,
+		 args, NULL_TREE);
+  return fold_convert (rtype, res);
+}
+
+tree
+new_signed_literal (tree ltype, long long value)
+{
+  tree res;
+
+  res = build_int_cst_wide (ltype,
+			    value, value >> (8 * sizeof (HOST_WIDE_INT)));
+  return res;
+}
+
+tree
+new_unsigned_literal (tree ltype, unsigned long long value)
+{
+  tree res;
+
+  res = build_int_cst_wide (ltype,
+			    value, value >> (8 * sizeof (HOST_WIDE_INT)));
+  return res;
+}
+
+tree
+new_null_access (tree ltype)
+{
+  tree res;
+
+  res = build_int_cst_wide (ltype, 0, 0);
+  return res;
+}
+
+tree
+new_float_literal (tree ltype, double value)
+{
+  signed long long s;
+  double frac;
+  int ex;
+  REAL_VALUE_TYPE r_sign;
+  REAL_VALUE_TYPE r_exp;
+  REAL_VALUE_TYPE r;
+  tree res;
+
+  frac = frexp (value, &ex);
+  
+  s = ldexp (frac, 60);
+  REAL_VALUE_FROM_INT (r_sign,
+		       (HOST_WIDE_INT) s,
+		       (HOST_WIDE_INT) (s >> (8 * sizeof (HOST_WIDE_INT))),
+		       DFmode);
+  real_2expN (&r_exp, ex - 60);
+  real_arithmetic (&r, MULT_EXPR, &r_sign, &r_exp);
+  res = build_real (ltype, r);
+  return res;
+}
+
+struct o_element_list
+{
+  tree res;
+  struct chain_constr_type chain;
+};
+
+void
+new_uncomplete_record_type (tree *res)
+{
+  *res = make_node (RECORD_TYPE);
+}
+
+void
+start_record_type (struct o_element_list *elements)
+{
+  elements->res = make_node (RECORD_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+start_uncomplete_record_type (tree res, struct o_element_list *elements)
+{
+  elements->res = res;
+  chain_init (&elements->chain);
+}
+
+static void
+new_record_union_field (struct o_element_list *list,
+			tree *el,
+			tree ident,
+			tree etype)
+{
+  tree res;
+
+  res = build_decl (FIELD_DECL, ident, etype);
+  DECL_CONTEXT (res) = list->res;
+  chain_append (&list->chain, res);
+  *el = res;
+}
+
+void
+new_record_field (struct o_element_list *list,
+		  tree *el,
+		  tree ident,
+		  tree etype)
+{
+  return new_record_union_field (list, el, ident, etype);
+}
+
+void
+finish_record_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+
+  if (TYPE_NAME (elements->res) != NULL_TREE)
+    {
+      /*  The type was completed.  */
+      rest_of_type_compilation (elements->res, 1);
+    }
+}
+
+
+void
+start_union_type (struct o_element_list *elements)
+{
+  elements->res =  make_node (UNION_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+new_union_field (struct o_element_list *elements,
+		 tree *el,
+		 tree ident,
+		 tree etype)
+{
+  return new_record_union_field (elements, el, ident, etype);
+}
+
+void
+finish_union_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+}
+
+tree
+new_unsigned_type (int size)
+{
+  return make_unsigned_type (size);
+}
+
+tree
+new_signed_type (int size)
+{
+  return make_signed_type (size);
+}
+
+tree
+new_float_type (void)
+{
+  tree res;
+
+  res = make_node (REAL_TYPE);
+  TYPE_PRECISION (res) = DOUBLE_TYPE_SIZE;
+  layout_type (res);
+  return res;
+}
+
+tree
+new_access_type (tree dtype)
+{
+  tree res;
+
+  if (dtype == NULL_TREE)
+    {
+      res = make_node (POINTER_TYPE);
+      TREE_TYPE (res) = NULL_TREE;
+      /* Seems necessary.  */
+      TYPE_MODE (res) = Pmode;
+      layout_type (res);
+      return res;
+    }
+  else
+    return build_pointer_type (dtype);
+}
+
+void
+finish_access_type (tree atype, tree dtype)
+{
+  if (TREE_CODE (atype) != POINTER_TYPE
+      || TREE_TYPE (atype) != NULL_TREE)
+    abort ();
+
+  TREE_TYPE (atype) = dtype;
+}
+
+tree
+new_array_type (tree el_type, tree index_type)
+{
+  return build_array_type (el_type, index_type);
+}
+
+
+tree
+new_constrained_array_type (tree atype, tree length)
+{
+  tree range_type;
+  tree index_type;
+  tree len;
+  tree one;
+
+  index_type = TYPE_DOMAIN (atype);
+  if (integer_zerop (length))
+    {
+      /*  Handle null array, by creating a one-length array...  */
+      len = size_zero_node;
+    }
+  else
+    {
+      one = build_int_cstu (index_type, 1);
+      len = build2 (MINUS_EXPR, index_type, length, one);
+      len = fold (len);
+    }
+
+  range_type = build_range_type (index_type, size_zero_node, len);
+  return build_array_type (TREE_TYPE (atype), range_type);
+}
+
+void
+new_boolean_type (tree *res,
+		  tree false_id, tree *false_e,
+		  tree true_id, tree *true_e)
+{
+  *res = make_node (BOOLEAN_TYPE);
+  TYPE_PRECISION (*res) = 1;
+  fixup_unsigned_type (*res);
+  *false_e = TYPE_MIN_VALUE (*res);
+  *true_e = TYPE_MAX_VALUE (*res);
+}
+
+struct o_enum_list
+{
+  tree res;
+  struct chain_constr_type chain;
+  int num;
+  int size;
+};
+
+void
+start_enum_type (struct o_enum_list *list, int size)
+{
+  list->res = make_node (ENUMERAL_TYPE);
+  chain_init (&list->chain);
+  list->num = 0;
+  list->size = size;
+}
+
+void
+new_enum_literal (struct o_enum_list *list, tree ident, tree *res)
+{
+  *res = build_int_cstu (list->res, list->num);
+  chain_append (&list->chain, tree_cons (ident, *res, NULL_TREE));
+  list->num++;
+}
+
+void
+finish_enum_type (struct o_enum_list *list, tree *res)
+{
+  *res = list->res;
+  TYPE_VALUES (*res) = list->chain.first;
+  TYPE_MIN_VALUE (*res) = TREE_VALUE (list->chain.first);
+  TYPE_MAX_VALUE (*res) = TREE_VALUE (list->chain.last);
+  TYPE_UNSIGNED (*res) = 1;
+  TYPE_PRECISION (*res) = list->size;
+  layout_type (*res);
+}
+
+struct o_record_aggr_list
+{
+  tree atype;
+  struct chain_constr_type chain;
+};
+
+void
+start_record_aggr (struct o_record_aggr_list *list, tree atype)
+{
+  list->atype = atype;
+  chain_init (&list->chain);
+}
+
+void
+new_record_aggr_el (struct o_record_aggr_list *list, tree value)
+{
+  chain_append (&list->chain, build_tree_list (NULL_TREE, value));
+}
+
+void
+finish_record_aggr (struct o_record_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->chain.first);
+}
+ 
+
+struct o_array_aggr_list
+{
+  tree atype;
+  struct chain_constr_type chain;
+};
+
+void
+start_array_aggr (struct o_array_aggr_list *list, tree atype)
+{
+  list->atype = atype;
+  chain_init (&list->chain);
+}
+
+void
+new_array_aggr_el (struct o_array_aggr_list *list, tree value)
+{
+  chain_append (&list->chain, build_tree_list (NULL_TREE, value));
+}
+ 
+void
+finish_array_aggr (struct o_array_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->chain.first);
+}
+
+
+tree
+new_union_aggr (tree atype, tree field, tree value)
+{
+  tree el;
+  tree res;
+
+  el = build_tree_list (field, value);
+  res = build_constructor (atype, el);
+  TREE_CONSTANT (res) = 1;
+  return res;
+}
+
+tree
+new_indexed_element (tree arr, tree index)
+{
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (arr)),
+		 arr, index, NULL_TREE, NULL_TREE);
+}
+
+tree
+new_slice (tree arr, tree res_type, tree index)
+{
+  tree res;
+  tree el_ptr_type;
+  tree el_type;
+  tree res_ptr_type;
+
+  /*  *((RES_TYPE *)(&ARR[INDEX]))
+      convert ARR to a pointer, add index, and reconvert to array ?  */
+  if (TREE_CODE (res_type) != ARRAY_TYPE)
+    abort ();
+
+  ortho_mark_addressable (arr);
+  el_type = TREE_TYPE (TREE_TYPE (arr));
+  el_ptr_type = build_pointer_type (el_type);
+
+  res = build4 (ARRAY_REF, el_type, arr, index, NULL_TREE, NULL_TREE);
+  res = build1 (ADDR_EXPR, el_ptr_type, res);
+  res_ptr_type = build_pointer_type (res_type);
+  res = build1 (NOP_EXPR, res_ptr_type, res);
+  res = build1 (INDIRECT_REF, res_type, res);
+  return res;
+}
+
+tree
+new_selected_element (tree rec, tree el)
+{
+  tree res;
+
+  if (TREE_CODE (TREE_TYPE (rec)) != RECORD_TYPE)
+    abort ();
+
+  res = build3 (COMPONENT_REF, TREE_TYPE (el), rec, el, NULL_TREE);
+  return res;
+}
+
+tree
+new_access_element (tree acc)
+{
+  tree acc_type;
+
+  acc_type = TREE_TYPE (acc);
+  if (TREE_CODE (acc_type) != POINTER_TYPE)
+    abort ();
+
+  return build1 (INDIRECT_REF, TREE_TYPE (acc_type), acc);
+}
+
+tree
+new_offsetof (tree field, tree rtype)
+{
+  tree off;
+  tree bit_off;
+  HOST_WIDE_INT pos;
+  tree res;
+
+  off = DECL_FIELD_OFFSET (field);
+  if (!host_integerp (off, 1))
+    {
+      /*  The offset must be a constant.  */
+      abort ();
+    }
+
+  bit_off = DECL_FIELD_BIT_OFFSET (field);
+  if (!host_integerp (bit_off, 1))
+    {
+      /*  The offset must be a constant.  */
+      abort ();
+    }
+
+  pos = TREE_INT_CST_LOW (off)
+        + (TREE_INT_CST_LOW (bit_off) / BITS_PER_UNIT);
+  res = build_int_cstu (rtype, pos);
+  return res;
+}
+
+tree
+new_sizeof (tree atype, tree rtype)
+{
+ tree size;
+
+ size = TYPE_SIZE_UNIT (atype);
+
+ return fold (build1 (NOP_EXPR, rtype, size));
+}
+
+#if 0
+static tree
+ortho_build_addr (tree operand, tree atype)
+{
+  tree base = exp;
+
+  while (handled_component_p (base))
+    base = TREE_OPERAND (base, 0);
+
+  if (DECL_P (base))
+    TREE_ADDRESSABLE (base) = 1;
+
+  return build1 (ADDR_EXPR, atype, exp);
+}
+#endif
+
+tree
+new_unchecked_address (tree lvalue, tree atype)
+{
+  tree res;
+
+  if (TREE_CODE (lvalue) == INDIRECT_REF)
+    {
+      res = TREE_OPERAND (lvalue, 0);
+    }
+  else
+    {
+      ortho_mark_addressable (lvalue);
+
+      if (TREE_TYPE (lvalue) != TREE_TYPE (atype))
+	{
+	  tree ptr;
+	  ptr = build_pointer_type (TREE_TYPE (lvalue));
+	  res = build1 (ADDR_EXPR, ptr, lvalue);
+	}
+      else
+	res = build1 (ADDR_EXPR, atype, lvalue);
+    }
+
+  if (TREE_TYPE (res) != atype)
+    res = fold (build1 (NOP_EXPR, atype, res));
+
+  return res;
+
+#if 0
+  /* res = build_addr (lvalue, atype); */
+  if (TREE_TYPE (res) != atype)
+    {
+      if (TREE_CODE (TREE_TYPE (res)) != POINTER_TYPE)
+	abort ();
+      res = build1 (NOP_EXPR, atype, res);
+    }
+  return res;
+#endif
+}
+
+tree
+new_address (tree lvalue, tree atype)
+{
+  return new_unchecked_address (lvalue, atype);
+}
+
+tree
+new_global_address (tree lvalue, tree atype)
+{
+  return new_unchecked_address (lvalue, atype);
+}
+
+tree
+new_global_unchecked_address (tree lvalue, tree atype)
+{
+  return new_unchecked_address (lvalue, atype);
+}
+
+/*  Return a pointer to function FUNC. */
+static tree
+build_function_ptr (tree func)
+{
+  return build1 (ADDR_EXPR,
+		 build_pointer_type (TREE_TYPE (func)), func);
+}
+
+tree
+new_subprogram_address (tree subprg, tree atype)
+{
+  return fold (build1 (NOP_EXPR, atype, build_function_ptr (subprg)));
+}
+
+tree
+new_value (tree lvalue)
+{
+  return lvalue;
+}
+
+void
+new_debug_line_decl (int line)
+{
+  input_location.line = line;
+}
+
+void
+new_type_decl (tree ident, tree atype)
+{
+  tree decl;
+
+  TYPE_NAME (atype) = ident;
+  decl = build_decl (TYPE_DECL, ident, atype);
+  TYPE_STUB_DECL (atype) = decl;
+  push_decl (decl);
+  /*
+      if Get_TYPE_SIZE (Ttype) /= NULL_TREE then
+         --  Do not generate debug info for uncompleted types.
+         Rest_Of_Type_Compilation (Ttype, C_True);
+      end if;
+  */
+}
+
+enum o_storage { o_storage_external,
+		 o_storage_public,
+		 o_storage_private,
+		 o_storage_local };
+
+static void
+set_storage (tree Node, enum o_storage storage)
+{
+  switch (storage)
+    {
+    case o_storage_external:
+      DECL_EXTERNAL (Node) = 1;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 0;
+      break;
+    case o_storage_public:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_private:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_local:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 0;
+      break;
+    }
+}
+
+void
+new_const_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree cst;
+
+  cst = build_decl (VAR_DECL, ident, atype);
+  set_storage (cst, storage);
+  TREE_READONLY (cst) = 1;
+  push_decl (cst);
+  switch (storage)
+    {
+    case o_storage_local:
+      abort ();
+    case o_storage_external:
+      /*  We are at top level if Current_Function_Decl is null.  */
+      rest_of_decl_compilation
+	(cst, current_function_decl == NULL_TREE, 0);
+      break;
+    case o_storage_public:
+    case o_storage_private:
+      break;
+    }
+  *res = cst;
+}
+
+void
+start_const_value (tree *cst)
+{
+}
+
+void
+finish_const_value (tree *cst, tree val)
+{
+  DECL_INITIAL (*cst) = val;
+  TREE_CONSTANT (val) = 1;
+  rest_of_decl_compilation
+        (*cst, current_function_decl == NULL_TREE, 0);
+}
+
+void
+new_var_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree var;
+
+  var = build_decl (VAR_DECL, ident, atype);
+  if (current_function_decl != NULL_TREE)
+    {    
+      /*  Local variable. */
+      TREE_STATIC (var) = 0;
+      DECL_EXTERNAL (var) = 0;
+      TREE_PUBLIC (var) = 0;
+    }
+  else
+    set_storage (var, storage);
+
+  push_decl (var);
+
+  if (current_function_decl == NULL_TREE)
+    rest_of_decl_compilation (var, 1, 0);
+
+  *res = var;
+}
+
+struct o_inter_list
+{
+  tree ident;
+  enum o_storage storage;
+
+  /*  Return type.  */
+  tree rtype;
+
+  /*  List of parameter types.  */
+  struct list_constr_type param_list;
+
+  /*  Chain of parameters declarations.  */
+  struct chain_constr_type param_chain;
+};
+
+void
+start_function_decl (struct o_inter_list *interfaces,
+		     tree ident,
+		     enum o_storage storage,
+		     tree rtype)
+{
+  interfaces->ident = ident;
+  interfaces->storage = storage;
+  interfaces->rtype = rtype;
+  chain_init (&interfaces->param_chain);
+  list_init (&interfaces->param_list);
+}
+
+void
+start_procedure_decl (struct o_inter_list *interfaces,
+		      tree ident,
+		      enum o_storage storage)
+{
+  start_function_decl (interfaces, ident, storage, void_type_node);
+}
+
+void
+new_interface_decl (struct o_inter_list *interfaces,
+		    tree *res,
+		    tree ident,
+		    tree atype)
+{
+  tree r;
+
+  r = build_decl (PARM_DECL, ident, atype);
+  /* DECL_CONTEXT (Res, Xxx); */
+
+  /*  Do type conversion: convert boolean and enums to int  */
+  switch (TREE_CODE (atype))
+    {
+    case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
+      DECL_ARG_TYPE (r) = integer_type_node;
+    default:
+      DECL_ARG_TYPE (r) = atype;
+    }
+
+  chain_append (&interfaces->param_chain, r);
+  ortho_list_append (&interfaces->param_list, atype);
+  *res = r;
+}
+
+/*  Current function nest level, or the number of parents.  */
+/* static int function_nest_level; */
+
+
+void
+finish_subprogram_decl (struct o_inter_list *interfaces, tree *res)
+{
+  tree decl;
+  tree result;
+  tree parm;
+  int is_global;
+
+  decl = build_decl (FUNCTION_DECL, interfaces->ident,
+		     build_function_type (interfaces->rtype,
+					  interfaces->param_list.first));
+  is_global = current_function_decl == NULL_TREE
+    || interfaces->storage == o_storage_external;
+  if (is_global)
+    set_storage (decl, interfaces->storage);
+  else
+    {
+      /*  A nested subprogram.  */
+      DECL_EXTERNAL (decl) = 0;
+      TREE_PUBLIC (decl) = 0;
+    }
+  /*  The function exist in static storage. */
+  TREE_STATIC (decl) = 1;
+  DECL_INITIAL (decl) = error_mark_node;
+  TREE_ADDRESSABLE (decl) = 1;
+
+  /*  Declare the result.
+      FIXME: should be moved in start_function_body. */
+  result = build_decl (RESULT_DECL, NULL_TREE, interfaces->rtype);
+  DECL_RESULT (decl) = result;
+  DECL_CONTEXT (result) = decl;
+
+  DECL_ARGUMENTS (decl) = interfaces->param_chain.first;
+  /* Set DECL_CONTEXT of parameters.  */
+  for (parm = interfaces->param_chain.first;
+       parm != NULL_TREE;
+       parm = TREE_CHAIN (parm))
+    DECL_CONTEXT (parm) = decl;
+
+  push_decl (decl);
+
+  /* External functions are never nested.
+     Remove their context, which is set by push_decl.  */
+  if (interfaces->storage == o_storage_external)
+    DECL_CONTEXT (decl) = NULL_TREE;
+
+  if (is_global)
+    rest_of_decl_compilation (decl, 1, 0);
+
+  *res = decl;
+}
+
+void
+start_subprogram_body (tree func)
+{
+  if (current_function_decl != DECL_CONTEXT (func))
+    abort ();
+  current_function_decl = func;
+
+  /* The function is not anymore external.  */
+  DECL_EXTERNAL (func) = 0;
+
+  push_stmts (alloc_stmt_list ());
+  push_binding ();
+}
+
+void
+finish_subprogram_body (void)
+{
+  tree bind;
+  tree func;
+  tree parent;
+
+  bind = pop_binding ();
+  pop_stmts ();
+
+  func = current_function_decl;
+  DECL_INITIAL (func) = BIND_EXPR_BLOCK (bind);
+  DECL_SAVED_TREE (func) = bind;
+
+  /* Initialize the RTL code for the function.  */
+  allocate_struct_function (func);
+
+  /* Store the end of the function.  */
+  cfun->function_end_locus = input_location;
+  
+  /* This function is being processed in whole-function mode.  */
+  /* cfun->x_whole_function_mode_p = 1; */
+
+  gimplify_function_tree (func);
+
+  parent = DECL_CONTEXT (func);
+
+  if (parent != NULL)
+    cgraph_node (func);
+  else
+    cgraph_finalize_function (func, false);
+
+  current_function_decl = parent;
+  cfun = NULL;
+}
+
+
+void
+new_debug_line_stmt (int line)
+{
+  input_location.line = line;
+}
+
+void
+start_declare_stmt (void)
+{
+  push_stmts (alloc_stmt_list ());
+  push_binding ();
+}
+
+void
+finish_declare_stmt (void)
+{
+  tree bind;
+
+  bind = pop_binding ();
+  pop_stmts ();
+  append_stmt (bind);
+}
+
+
+struct o_assoc_list
+{
+  tree subprg;
+  struct list_constr_type list;
+};
+
+void
+start_association (struct o_assoc_list *assocs, tree subprg)
+{
+  assocs->subprg = subprg;
+  list_init (&assocs->list);
+}
+
+void
+new_association (struct o_assoc_list *assocs, tree val)
+{
+  ortho_list_append (&assocs->list, val);
+}
+
+tree
+new_function_call (struct o_assoc_list *assocs)
+{
+  return build3 (CALL_EXPR,
+		 TREE_TYPE (TREE_TYPE (assocs->subprg)),
+		 build_function_ptr (assocs->subprg),
+		 assocs->list.first, NULL_TREE);
+}
+
+void
+new_procedure_call (struct o_assoc_list *assocs)
+{
+  tree res;
+
+  res = build3 (CALL_EXPR,
+		TREE_TYPE (TREE_TYPE (assocs->subprg)),
+		build_function_ptr (assocs->subprg),
+		assocs->list.first, NULL_TREE);
+  TREE_SIDE_EFFECTS (res) = 1;
+  append_stmt (res);
+}
+
+void
+new_assign_stmt (tree target, tree value)
+{
+  tree n;
+
+  n = build2 (MODIFY_EXPR, TREE_TYPE (target), target, value);
+  TREE_SIDE_EFFECTS (n) = 1;
+  append_stmt (n);
+}
+
+void
+new_func_return_stmt (tree value)
+{
+  tree assign;
+  tree stmt;
+  tree res;
+
+  res = DECL_RESULT (current_function_decl);
+  assign = build2 (MODIFY_EXPR, TREE_TYPE (value), res, value);
+  TREE_SIDE_EFFECTS (assign) = 1;
+  stmt = build1 (RETURN_EXPR, TREE_TYPE (value), assign);
+  append_stmt (stmt);
+}
+
+void
+new_proc_return_stmt (void)
+{
+  tree stmt;
+
+  stmt = build1 (RETURN_EXPR, void_type_node, NULL_TREE);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+
+struct o_if_block
+{
+  tree stmt;
+};
+
+void
+start_if_stmt (struct o_if_block *block, tree cond)
+{
+  tree stmt;
+  tree stmts;
+
+  stmts = alloc_stmt_list ();
+  stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
+  block->stmt = stmt;
+  append_stmt (stmt);
+  push_stmts (stmts);
+}
+
+void
+new_elsif_stmt (struct o_if_block *block, tree cond)
+{
+  tree stmts;
+  tree stmt;
+
+  pop_stmts ();
+  stmts = alloc_stmt_list ();
+  stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
+  COND_EXPR_ELSE (block->stmt) = stmt;
+  block->stmt = stmt;
+  push_stmts (stmts);
+}
+
+void
+new_else_stmt (struct o_if_block *block)
+{
+  tree stmts;
+
+  pop_stmts ();
+  stmts = alloc_stmt_list ();
+  COND_EXPR_ELSE (block->stmt) = stmts;
+  push_stmts (stmts);
+}
+
+void
+finish_if_stmt (struct o_if_block *block)
+{
+  pop_stmts ();
+}
+
+
+struct o_loop_block
+{
+  tree beg_label;
+  tree end_label;
+};
+
+struct o_snode
+{
+  tree beg_label;
+  tree end_label;
+};
+
+/* Create an artificial label.  */
+static tree
+build_label (void)
+{
+  tree res;
+
+  res = build_decl (LABEL_DECL, NULL_TREE, void_type_node);
+  DECL_CONTEXT (res) = current_function_decl;
+  DECL_ARTIFICIAL (res) = 1;
+  return res;
+}
+
+void
+start_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  label->beg_label = build_label ();
+
+  stmt = build1 (LABEL_EXPR, void_type_node, label->beg_label);
+  append_stmt (stmt);
+
+  label->end_label = build_label ();
+}
+
+void
+finish_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, label->beg_label);
+  TREE_USED (label->beg_label) = 1;
+  append_stmt (stmt);
+  /*  Emit the end label only if there is a goto to it.
+      (Return may be used to exit from the loop).  */
+  if (TREE_USED (label->end_label))
+    {
+      stmt = build1 (LABEL_EXPR, void_type_node, label->end_label);
+      append_stmt (stmt);
+    }
+}
+
+void
+new_exit_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->end_label);
+  append_stmt (stmt);
+  TREE_USED (l->end_label) = 1;
+}
+
+void
+new_next_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->beg_label);
+  TREE_USED (l->beg_label) = 1;
+  append_stmt (stmt);
+}
+
+struct o_case_block
+{
+  tree end_label;
+  int add_break;
+};
+
+void
+start_case_stmt (struct o_case_block *block, tree value)
+{
+  tree stmt;
+  tree stmts;
+
+  block->end_label = build_label ();
+  block->add_break = 0;
+  stmts = alloc_stmt_list ();
+  stmt = build3 (SWITCH_EXPR, void_type_node, value, stmts, NULL_TREE);
+  append_stmt (stmt);
+  push_stmts (stmts);
+}
+
+void
+start_choice (struct o_case_block *block)
+{
+  tree stmt;
+
+  if (block->add_break)
+    {
+      stmt = build1 (GOTO_EXPR, void_type_node, block->end_label);
+      append_stmt (stmt);
+
+      block->add_break = 0;
+    }
+}
+
+void
+new_expr_choice (struct o_case_block *block, tree expr)
+{
+  tree stmt;
+  
+  stmt = build3 (CASE_LABEL_EXPR, void_type_node,
+		 expr, NULL_TREE, create_artificial_label ());
+  append_stmt (stmt);
+}
+
+void
+new_range_choice (struct o_case_block *block, tree low, tree high)
+{
+  tree stmt;
+
+  stmt = build3 (CASE_LABEL_EXPR, void_type_node,
+		 low, high, create_artificial_label ());
+  append_stmt (stmt);
+}
+
+void
+new_default_choice (struct o_case_block *block)
+{
+  tree stmt;
+
+  stmt = build3 (CASE_LABEL_EXPR, void_type_node,
+		 NULL_TREE, NULL_TREE, create_artificial_label ());
+  append_stmt (stmt);
+}
+
+void
+finish_choice (struct o_case_block *block)
+{
+  block->add_break = 1;
+}
+
+void
+finish_case_stmt (struct o_case_block *block)
+{
+  tree stmt;
+
+  pop_stmts ();
+  stmt = build1 (LABEL_EXPR, void_type_node, block->end_label);
+  append_stmt (stmt);
+}
+
+bool
+compare_identifier_string (tree id, const char *str, size_t len)
+{
+  if (IDENTIFIER_LENGTH (id) != len)
+    return false;
+  if (!memcmp (IDENTIFIER_POINTER (id), str, len))
+    return true;
+  else
+    return false;
+}
+
+void
+get_identifier_string (tree id, const char **str, int *len)
+{
+  *len = IDENTIFIER_LENGTH (id);
+  *str = IDENTIFIER_POINTER (id);
+}
+
+#include "debug.h"
+#include "gt-vhdl-ortho-lang.h"
+#include "gtype-vhdl.h"
diff --git a/ortho/gcc/ortho_gcc-main.adb b/ortho/gcc/ortho_gcc-main.adb
new file mode 100644
index 000000000..5a71aacb4
--- /dev/null
+++ b/ortho/gcc/ortho_gcc-main.adb
@@ -0,0 +1,26 @@
+with System;
+with Ortho_Gcc_Front;
+with Ada.Command_Line; use Ada.Command_Line;
+
+procedure Ortho_Gcc.Main
+is
+   gnat_argc : Integer;
+   gnat_argv : System.Address;
+   gnat_envp : System.Address;
+
+   pragma Import (C, gnat_argc);
+   pragma Import (C, gnat_argv);
+   pragma Import (C, gnat_envp);
+
+   function Toplev_Main (Argc : Integer; Argv : System.Address)
+                        return Integer;
+   pragma Import (C, Toplev_Main);
+
+   Status : Exit_Status;
+begin
+   Ortho_Gcc_Front.Init;
+
+   --  Note: GCC set signal handlers...
+   Status := Exit_Status (Toplev_Main (gnat_argc, gnat_argv));
+   Set_Exit_Status (Status);
+end Ortho_Gcc.Main;
diff --git a/ortho/gcc/ortho_gcc-main.ads b/ortho/gcc/ortho_gcc-main.ads
new file mode 100644
index 000000000..4bd73a1b6
--- /dev/null
+++ b/ortho/gcc/ortho_gcc-main.ads
@@ -0,0 +1 @@
+procedure Ortho_Gcc.Main;
diff --git a/ortho/gcc/ortho_gcc.adb b/ortho/gcc/ortho_gcc.adb
new file mode 100644
index 000000000..c5234fc9c
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.adb
@@ -0,0 +1,110 @@
+with Ada.Unchecked_Deallocation;
+with Ortho_Gcc_Front; use Ortho_Gcc_Front;
+
+package body Ortho_Gcc is
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode (Lit);
+   end New_Lit;
+
+   function New_Obj (Decl : O_Dnode) return O_Lnode is
+   begin
+      return O_Lnode (Decl);
+   end New_Obj;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return O_Enode (Obj);
+   end New_Obj_Value;
+
+   procedure Init
+   is
+   begin
+      null;
+   end Init;
+
+   procedure New_Debug_Filename_Decl (Filename : String) is
+   begin
+      null;
+   end New_Debug_Filename_Decl;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   --  Representation of a C String: this is an access to a bounded string.
+   --  Therefore, with GNAT, such an access is a thin pointer.
+   subtype Fat_C_String is String (Positive);
+   type C_String is access all Fat_C_String;
+   pragma Convention (C, C_String);
+
+   C_String_Null : constant C_String := null;
+
+   --  Return the length of a C String (ie, the number of characters before
+   --  the Nul).
+   function C_String_Len (Str : C_String) return Natural;
+   pragma Import (C, C_String_Len, "strlen");
+
+   function Lang_Handle_Option (Opt : C_String; Arg : C_String)
+                               return Integer;
+   pragma Export (C, Lang_Handle_Option);
+
+   function Lang_Parse_File (Filename : C_String) return Integer;
+   pragma Export (C, Lang_Parse_File);
+
+   function Lang_Handle_Option (Opt : C_String; Arg : C_String)
+     return Integer
+   is
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Name => String_Acc, Object => String);
+
+      Res : Natural;
+      Ada_Opt : String_Acc;
+      Ada_Arg : String_Acc;
+      Len : Natural;
+   begin
+      Len := C_String_Len (Opt);
+      Ada_Opt := new String'(Opt (1 .. Len));
+      if Arg /= C_String_Null then
+         Len := C_String_Len (Arg);
+         Ada_Arg := new String'(Arg (1 .. Len));
+      else
+         Ada_Arg := null;
+      end if;
+      Res := Ortho_Gcc_Front.Decode_Option (Ada_Opt, Ada_Arg);
+      Unchecked_Deallocation (Ada_Opt);
+      Unchecked_Deallocation (Ada_Arg);
+      return Res;
+   end Lang_Handle_Option;
+
+   function Lang_Parse_File (Filename : C_String) return Integer
+   is
+      Len : Natural;
+      File : String_Acc;
+   begin
+      if Filename = C_String_Null then
+         File := null;
+      else
+         Len := C_String_Len (Filename);
+         File := new String'(Filename.all (1 .. Len));
+      end if;
+
+      if Ortho_Gcc_Front.Parse (File) then
+         return 1;
+      else
+         return 0;
+      end if;
+   end Lang_Parse_File;
+
+end Ortho_Gcc;
diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads
new file mode 100644
index 000000000..a718f932a
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.ads
@@ -0,0 +1,649 @@
+with System;
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  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_Enode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Fnode is private;
+   type O_Dnode is private;
+   type O_Snode is private;
+
+   --  Must be called during initialization, before use of any subprograms.
+   procedure Init;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Enode_Null : constant O_Enode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Tnode_Null : constant O_Tnode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Snode_Null : constant O_Snode;
+   O_Dnode_Null : constant O_Dnode;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   -------------------
+   --  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
+      );
+
+   pragma Convention (C, ON_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);
+   pragma Convention (C, O_Storage);
+   --  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;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+   pragma Inline (New_Lit);
+
+   --  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;
+
+   --  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;
+
+   type O_Inter_List is limited private;
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_Loop_Block is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the 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 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;
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : 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 value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   --  Get the value of an object.
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+   pragma Inline (New_Obj_Value);
+
+   --  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.
+   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);
+
+   function New_Obj (Decl : O_Dnode) return O_Lnode;
+   pragma Inline (New_Obj);
+
+   --  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 (Block : 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);
+   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
+   subtype Tree is System.Address;
+   NULL_TREE : constant Tree := System.Null_Address;
+   type O_Cnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Snode is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Snode);
+
+   pragma Export (C, Init, "ortho_fe_init");
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+
+   --  Efficiently append element EL to a chain.
+   --  FIRST is the first element of the chain (must NULL_TREE if the chain
+   --   is empty),
+   --  LAST is the last element of the chain (idem).
+   type Chain_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, Chain_Constr_Type);
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   pragma Import (C, Chain_Init);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+   pragma Import (C, Chain_Append);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, List_Constr_Type);
+   procedure List_Init (Constr : out List_Constr_Type);
+   pragma Import (C, List_Init);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+   pragma Import (C, List_Append, "ortho_list_append");
+
+   type O_Loop_Block is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Loop_Block);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      --  Return type.
+      Rtype : O_Tnode;
+      --  List of parameter types.
+      Param_List : List_Constr_Type;
+      --  Chain of parameters declarations.
+      Param_Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Inter_List);
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Element_List);
+
+   type O_Case_Block is record
+      End_Label : Tree;
+      Add_Break : Integer;
+   end record;
+   pragma Convention (C, O_Case_Block);
+
+   type O_If_Block is record
+      Stmt : Tree;
+   end record;
+   pragma Convention (C, O_If_Block);
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is new O_Aggr_List;
+   pragma Convention (C, O_Record_Aggr_List);
+   type O_Array_Aggr_List is new O_Aggr_List;
+   pragma Convention (C, O_Array_Aggr_List);
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+   pragma Convention (C, O_Assoc_List);
+
+   type O_Enum_List is record
+      --  The enumeral_type node.
+      Res : Tree;
+      --  Chain of literals.
+      Chain : Chain_Constr_Type;
+      --  Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+      Num : Natural;
+      --  Size of the enumeration type.
+      Size : Natural;
+   end record;
+   pragma Convention (C, O_Enum_List);
+
+   pragma Import (C, New_Dyadic_Op);
+   pragma Import (C, New_Monadic_Op);
+   pragma Import (C, New_Compare_Op);
+
+   pragma Import (C, New_Convert_Ov);
+   pragma Import (C, New_Alloca);
+
+   pragma Import (C, New_Signed_Literal);
+   pragma Import (C, New_Unsigned_Literal);
+   pragma Import (C, New_Float_Literal);
+   pragma Import (C, New_Null_Access);
+
+   pragma Import (C, Start_Record_Type);
+   pragma Import (C, New_Record_Field);
+   pragma Import (C, Finish_Record_Type);
+   pragma Import (C, New_Uncomplete_Record_Type);
+   pragma Import (C, Start_Uncomplete_Record_Type);
+
+   pragma Import (C, Start_Union_Type);
+   pragma Import (C, New_Union_Field);
+   pragma Import (C, Finish_Union_Type);
+
+   pragma Import (C, New_Unsigned_Type);
+   pragma Import (C, New_Signed_Type);
+   pragma Import (C, New_Float_Type);
+
+   pragma Import (C, New_Access_Type);
+   pragma Import (C, Finish_Access_Type);
+
+   pragma Import (C, New_Array_Type);
+   pragma Import (C, New_Constrained_Array_Type);
+
+   pragma Import (C, New_Boolean_Type);
+   pragma Import (C, Start_Enum_Type);
+   pragma Import (C, New_Enum_Literal);
+   pragma Import (C, Finish_Enum_Type);
+
+   pragma Import (C, Start_Record_Aggr);
+   pragma Import (C, New_Record_Aggr_El);
+   pragma Import (C, Finish_Record_Aggr);
+   pragma Import (C, Start_Array_Aggr);
+   pragma Import (C, New_Array_Aggr_El);
+   pragma Import (C, Finish_Array_Aggr);
+   pragma Import (C, New_Union_Aggr);
+
+   pragma Import (C, New_Indexed_Element);
+   pragma Import (C, New_Slice);
+   pragma Import (C, New_Selected_Element);
+   pragma Import (C, New_Access_Element);
+
+   pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Offsetof);
+
+   pragma Import (C, New_Address);
+   pragma Import (C, New_Global_Address);
+   pragma Import (C, New_Unchecked_Address);
+   pragma Import (C, New_Global_Unchecked_Address);
+   pragma Import (C, New_Subprogram_Address);
+
+   pragma Import (C, New_Value);
+
+   pragma Import (C, New_Type_Decl);
+   pragma Import (C, New_Debug_Line_Decl);
+   pragma Import (C, New_Const_Decl);
+   pragma Import (C, New_Var_Decl);
+
+   pragma Import (C, Start_Const_Value);
+   pragma Import (C, Finish_Const_Value);
+
+   pragma Import (C, Start_Function_Decl);
+   pragma Import (C, Start_Procedure_Decl);
+   pragma Import (C, New_Interface_Decl);
+   pragma Import (C, Finish_Subprogram_Decl);
+
+   pragma Import (C, Start_Subprogram_Body);
+   pragma Import (C, Finish_Subprogram_Body);
+
+   pragma Import (C, New_Debug_Line_Stmt);
+   pragma Import (C, Start_Declare_Stmt);
+   pragma Import (C, Finish_Declare_Stmt);
+   pragma Import (C, Start_Association);
+   pragma Import (C, New_Association);
+   pragma Import (C, New_Function_Call);
+   pragma Import (C, New_Procedure_Call);
+
+   pragma Import (C, New_Assign_Stmt);
+
+   pragma Import (C, Start_If_Stmt);
+   pragma Import (C, New_Elsif_Stmt);
+   pragma Import (C, New_Else_Stmt);
+   pragma Import (C, Finish_If_Stmt);
+
+   pragma Import (C, New_Return_Stmt);
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_func_return_stmt", (O_Enode));
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_proc_return_stmt", null);
+
+   pragma Import (C, Start_Loop_Stmt);
+   pragma Import (C, Finish_Loop_Stmt);
+   pragma Import (C, New_Exit_Stmt);
+   pragma Import (C, New_Next_Stmt);
+
+   pragma Import (C, Start_Case_Stmt);
+   pragma Import (C, Start_Choice);
+   pragma Import (C, New_Expr_Choice);
+   pragma Import (C, New_Range_Choice);
+   pragma Import (C, New_Default_Choice);
+   pragma Import (C, Finish_Choice);
+   pragma Import (C, Finish_Case_Stmt);
+end Ortho_Gcc;
diff --git a/ortho/gcc/ortho_gcc_front.ads b/ortho/gcc/ortho_gcc_front.ads
new file mode 100644
index 000000000..553057b20
--- /dev/null
+++ b/ortho/gcc/ortho_gcc_front.ads
@@ -0,0 +1,2 @@
+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..c8acd58c5
--- /dev/null
+++ b/ortho/gcc/ortho_ident.adb
@@ -0,0 +1,36 @@
+package body Ortho_Ident is
+   function Get_Identifier_With_Length (Str : Address; Size : Integer)
+                                       return O_Ident;
+   pragma Import (C, Get_Identifier_With_Length);
+
+   function Compare_Identifier_String
+     (Id : O_Ident; Str : Address; Size : Integer)
+     return Boolean;
+   pragma Import (C, Compare_Identifier_String);
+
+   function Get_Identifier (Str : String) return O_Ident is
+   begin
+      return Get_Identifier_With_Length (Str'Address, Str'Length);
+   end Get_Identifier;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean is
+   begin
+      return Compare_Identifier_String (Id, Str'Address, Str'Length);
+   end Is_Equal;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      procedure Get_Identifier_String
+        (Id : O_Ident; Str_Ptr : Address; Len_Ptr : Address);
+      pragma Import (C, Get_Identifier_String);
+
+      Len : Natural;
+      type Str_Acc is access String (Positive);
+      Str : Str_Acc;
+   begin
+      Get_Identifier_String (Id, Str'Address, Len'Address);
+      return Str (1 .. Len);
+   end Get_String;
+
+end Ortho_Ident;
+
diff --git a/ortho/gcc/ortho_ident.ads b/ortho/gcc/ortho_ident.ads
new file mode 100644
index 000000000..4675bc43c
--- /dev/null
+++ b/ortho/gcc/ortho_ident.ads
@@ -0,0 +1,12 @@
+with System; use System;
+
+package Ortho_Ident is
+   subtype O_Ident is Address;
+   function Get_Identifier (Str : String) return O_Ident;
+   function Get_String (Id : O_Ident) return String;
+   function Is_Equal (L, R : O_Ident) return Boolean renames System."=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   O_Ident_Nul : constant O_Ident;
+private
+   O_Ident_Nul : constant O_Ident := Null_Address;
+end Ortho_Ident;
diff --git a/ortho/gcc/ortho_nodes.ads b/ortho/gcc/ortho_nodes.ads
new file mode 100644
index 000000000..7c6c4a076
--- /dev/null
+++ b/ortho/gcc/ortho_nodes.ads
@@ -0,0 +1,3 @@
+with Ortho_Gcc;
+
+package Ortho_Nodes renames Ortho_Gcc;
diff --git a/parse.adb b/parse.adb
index 8364b29c3..68fcae508 100644
--- a/parse.adb
+++ b/parse.adb
@@ -900,7 +900,7 @@ package body Parse is
    is
       Res, Last : Iir;
       First, Prev_First : Iir;
-      Interface: Iir;
+      Inter: Iir;
       Is_Default : Boolean;
       Interface_Mode: Iir_Mode;
       Interface_Type: Iir;
@@ -918,20 +918,18 @@ package body Parse is
          Scan.Scan;
          case Current_Token is
             when Tok_Identifier =>
-               Interface := Create_Iir (Default);
+               Inter := Create_Iir (Default);
             when Tok_Signal =>
-               Interface := Create_Iir (Iir_Kind_Signal_Interface_Declaration);
+               Inter := Create_Iir (Iir_Kind_Signal_Interface_Declaration);
             when Tok_Variable =>
-               Interface :=
-                 Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+               Inter := Create_Iir (Iir_Kind_Variable_Interface_Declaration);
             when Tok_Constant =>
-               Interface :=
-                 Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+               Inter := 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);
+               Inter := Create_Iir (Iir_Kind_File_Interface_Declaration);
             when Tok_Right_Paren =>
                Error_Msg_Parse
                  ("extra ';' at end of interface list", Prev_Loc);
@@ -941,8 +939,7 @@ package body Parse is
                  ("'signal', 'constant', 'variable', 'file' "
                   & "or identifier expected");
                --  Use a variable interface as a fall-back.
-               Interface :=
-                 Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+               Inter := Create_Iir (Iir_Kind_Variable_Interface_Declaration);
          end case;
          if Current_Token = Tok_Identifier then
             Is_Default := True;
@@ -954,26 +951,26 @@ package body Parse is
          end if;
 
          Prev_First := Last;
-         First := Interface;
+         First := Inter;
          loop
             if Current_Token /= Tok_Identifier then
                Expect (Tok_Identifier);
             end if;
-            Set_Identifier (Interface, Current_Identifier);
-            Set_Location (Interface);
+            Set_Identifier (Inter, Current_Identifier);
+            Set_Location (Inter);
 
             if Res = Null_Iir then
-               Res := Interface;
+               Res := Inter;
             else
-               Set_Chain (Last, Interface);
+               Set_Chain (Last, Inter);
             end if;
-            Last := Interface;
+            Last := Inter;
 
             Scan.Scan;
             exit when Current_Token = Tok_Colon;
             Expect (Tok_Comma, "',' or ':' after an identifier");
             Scan.Scan;
-            Interface := Create_Iir (Get_Kind (Interface));
+            Inter := Create_Iir (Get_Kind (Inter));
          end loop;
 
          Expect (Tok_Colon,
@@ -1009,11 +1006,11 @@ package body Parse is
                      First := N_Interface;
                   end if;
                   Last := N_Interface;
-                  Interface := Get_Chain (O_Interface);
+                  Inter := Get_Chain (O_Interface);
                   Free_Iir (O_Interface);
-                  O_Interface := Interface;
+                  O_Interface := Inter;
                end loop;
-               Interface := First;
+               Inter := First;
             end;
          end if;
 
@@ -1028,7 +1025,7 @@ package body Parse is
                null;
          end case;
 
-         case Get_Kind (Interface) is
+         case Get_Kind (Inter) is
             when Iir_Kind_File_Interface_Declaration =>
                if Parse_Mode (Iir_Unknown_Mode) /= Iir_Unknown_Mode then
                   Error_Msg_Parse
@@ -1052,14 +1049,14 @@ package body Parse is
          end case;
 
          Interface_Type := Parse_Subtype_Indication;
-         if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration then
+         if Get_Kind (Inter) = 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
+            if Get_Kind (Inter) = Iir_Kind_File_Interface_Declaration then
                Error_Msg_Parse
                  ("default expression not allowed for an interface file");
             end if;
@@ -1069,32 +1066,30 @@ package body Parse is
             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,
+         Inter := First;
+         while Inter /= Null_Iir loop
+            Set_Mode (Inter, Interface_Mode);
+            Set_Parent (Inter, Parent);
+            if Inter = Last then
+               Set_Lexical_Layout (Inter,
                                    Lexical_Layout or Iir_Lexical_Has_Type);
             else
-               Set_Lexical_Layout (Interface, Lexical_Layout);
+               Set_Lexical_Layout (Inter, 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);
+            if Inter = First then
+               Set_Type (Inter, Interface_Type);
+               if Get_Kind (Inter) /= Iir_Kind_File_Interface_Declaration then
+                  Set_Default_Value (Inter, Default_Value);
                end if;
             else
                Proxy := Create_Iir (Iir_Kind_Proxy);
                Set_Proxy (Proxy, First);
-               Set_Type (Interface, Proxy);
+               Set_Type (Inter, Proxy);
             end if;
-            if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration
-            then
-               Set_Signal_Kind (Interface, Signal_Kind);
+            if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration then
+               Set_Signal_Kind (Inter, Signal_Kind);
             end if;
-            Interface := Get_Chain (Interface);
+            Inter := Get_Chain (Inter);
          end loop;
          exit when Current_Token /= Tok_Semi_Colon;
       end loop;
diff --git a/sem_assocs.adb b/sem_assocs.adb
index d85774675..40695838d 100644
--- a/sem_assocs.adb
+++ b/sem_assocs.adb
@@ -119,7 +119,7 @@ package body Sem_Assocs is
    is
       Assoc : Iir;
       Formal : Iir;
-      Interface : Iir;
+      Formal_Inter : Iir;
       Actual : Iir;
       Prefix : Iir;
       Object : Iir;
@@ -131,18 +131,18 @@ package body Sem_Assocs is
          Formal := Get_Formal (Assoc);
          if Formal = Null_Iir then
             --  Association by position.
-            Interface := Inter;
+            Formal_Inter := Inter;
             Inter := Get_Chain (Inter);
          else
             --  Association by name.
-            Interface := Get_Base_Name (Formal);
+            Formal_Inter := 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
+               if Get_Default_Value (Formal_Inter) = Null_Iir then
                   Error_Msg_Sem
-                    ("no parameter for " & Disp_Node (Interface), Assoc);
+                    ("no parameter for " & Disp_Node (Formal_Inter), Assoc);
                end if;
             when Iir_Kind_Association_Element_By_Expression =>
                Actual := Get_Actual (Assoc);
@@ -153,7 +153,7 @@ package body Sem_Assocs is
                   Prefix := Actual;
                end if;
 
-               case Get_Kind (Interface) is
+               case Get_Kind (Formal_Inter) is
                   when Iir_Kind_Signal_Interface_Declaration =>
                      --  LRM93 2.1.1
                      --  In a subprogram call, the actual designator
@@ -175,7 +175,7 @@ package body Sem_Assocs is
                            else
                               --  Inherit has_active_flag.
                               Set_Has_Active_Flag
-                                (Prefix, Get_Has_Active_Flag (Interface));
+                                (Prefix, Get_Has_Active_Flag (Formal_Inter));
                            end if;
                         when others =>
                            Error_Msg_Sem
@@ -186,20 +186,20 @@ package body Sem_Assocs is
                      case Get_Kind (Prefix) is
                         when Iir_Kind_Signal_Interface_Declaration =>
                            Check_Parameter_Association_Restriction
-                             (Interface, Prefix, Assoc);
+                             (Formal_Inter, Prefix, Assoc);
                         when Iir_Kind_Guard_Signal_Declaration =>
-                           if Get_Mode (Interface) /= Iir_In_Mode then
+                           if Get_Mode (Formal_Inter) /= Iir_In_Mode then
                               Error_Msg_Sem
                                 ("cannot associate a guard signal with "
-                                 & Get_Mode_Name (Get_Mode (Interface)) & " "
-                                 & Disp_Node (Interface), Assoc);
+                                 & Get_Mode_Name (Get_Mode (Formal_Inter))
+                                 & " " & Disp_Node (Formal_Inter), Assoc);
                            end if;
                         when Iir_Kinds_Signal_Attribute =>
-                           if Get_Mode (Interface) /= Iir_In_Mode then
+                           if Get_Mode (Formal_Inter) /= Iir_In_Mode then
                               Error_Msg_Sem
                                 ("cannot associate a signal attribute with "
-                                 & Get_Mode_Name (Get_Mode (Interface)) & " "
-                                 & Disp_Node (Interface), Assoc);
+                                 & Get_Mode_Name (Get_Mode (Formal_Inter))
+                                 & " " & Disp_Node (Formal_Inter), Assoc);
                            end if;
                         when others =>
                            null;
@@ -223,7 +223,7 @@ package body Sem_Assocs is
                      case Get_Kind (Prefix) is
                         when Iir_Kind_Variable_Interface_Declaration =>
                            Check_Parameter_Association_Restriction
-                             (Interface, Prefix, Assoc);
+                             (Formal_Inter, Prefix, Assoc);
                         when Iir_Kind_Variable_Declaration
                           | Iir_Kind_Dereference
                           | Iir_Kind_Implicit_Dereference =>
@@ -277,7 +277,8 @@ package body Sem_Assocs is
                      --  class constant must be an expression.
                      Check_Read (Actual);
                   when others =>
-                     Error_Kind ("check_subprogram_association(3)", Interface);
+                     Error_Kind
+                       ("check_subprogram_association(3)", Formal_Inter);
                end case;
             when Iir_Kind_Association_Element_By_Individual =>
                null;
@@ -928,7 +929,7 @@ package body Sem_Assocs is
    --  to the type of NAME.
    --  In case of failure, set NAME_TYPE to NULL_IIR.
    procedure Sem_Formal_Name (Name : Iir;
-                              Interface : Iir;
+                              Inter : Iir;
                               Prefix : out Iir;
                               Name_Type : out Iir)
    is
@@ -937,16 +938,15 @@ package body Sem_Assocs is
    begin
       case Get_Kind (Name) is
          when Iir_Kind_Simple_Name =>
-            if Get_Identifier (Name) = Get_Identifier (Interface) then
+            if Get_Identifier (Name) = Get_Identifier (Inter) then
                Prefix := Name;
-               Name_Type := Get_Type (Interface);
+               Name_Type := Get_Type (Inter);
             else
                Name_Type := Null_Iir;
             end if;
             return;
          when Iir_Kind_Selected_Name =>
-            Sem_Formal_Name
-              (Get_Prefix (Name), Interface, Prefix, Name_Type);
+            Sem_Formal_Name (Get_Prefix (Name), Inter, Prefix, Name_Type);
             if Name_Type = Null_Iir then
                return;
             end if;
@@ -966,8 +966,7 @@ package body Sem_Assocs is
             return;
          when Iir_Kind_Parenthesis_Name =>
             --  More difficult: slice or indexed array.
-            Sem_Formal_Name
-              (Get_Prefix (Name), Interface, Prefix, Name_Type);
+            Sem_Formal_Name (Get_Prefix (Name), Inter, Prefix, Name_Type);
             if Name_Type = Null_Iir then
                return;
             end if;
@@ -1033,7 +1032,7 @@ package body Sem_Assocs is
 
    type Param_Assoc_Type is (None, Open, Individual, Whole);
 
-   function Sem_Formal (Formal : Iir; Interface : Iir) return Param_Assoc_Type
+   function Sem_Formal (Formal : Iir; Inter : Iir) return Param_Assoc_Type
    is
       Prefix : Iir;
       Formal_Type : Iir;
@@ -1042,9 +1041,9 @@ package body Sem_Assocs 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);
+            if Get_Identifier (Formal) = Get_Identifier (Inter) then
+               Formal_Type := Get_Type (Inter);
+               Set_Named_Entity (Formal, Inter);
                Set_Type (Formal, Formal_Type);
                --Xrefs.Xref_Name (Formal);
                return Whole;
@@ -1059,10 +1058,10 @@ package body Sem_Assocs is
             Error_Kind ("sem_formal", Formal);
       end case;
       --  Check for a sub-element.
-      Sem_Formal_Name (Formal, Interface, Prefix, Formal_Type);
+      Sem_Formal_Name (Formal, Inter, Prefix, Formal_Type);
       if Formal_Type /= Null_Iir then
          Set_Type (Formal, Formal_Type);
-         Set_Named_Entity (Prefix, Interface);
+         Set_Named_Entity (Prefix, Inter);
          return Individual;
       else
          return None;
@@ -1214,7 +1213,7 @@ package body Sem_Assocs is
    --  This sets RES.
    procedure Sem_Association
      (Assoc : Iir;
-      Interface : Iir;
+      Inter : Iir;
       Finish : Boolean;
       Match : out Boolean)
    is
@@ -1232,7 +1231,7 @@ package body Sem_Assocs is
 
       if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
          if Formal /= Null_Iir then
-            Assoc_Kind := Sem_Formal (Formal, Interface);
+            Assoc_Kind := Sem_Formal (Formal, Inter);
             if Assoc_Kind = None then
                Match := False;
                return;
@@ -1257,7 +1256,7 @@ package body Sem_Assocs is
       end if;
 
       if Formal /= Null_Iir then
-         Assoc_Kind := Sem_Formal (Formal, Interface);
+         Assoc_Kind := Sem_Formal (Formal, Inter);
          if Assoc_Kind = None then
             Match := False;
             return;
@@ -1269,7 +1268,7 @@ package body Sem_Assocs is
       else
          Set_Whole_Association_Flag (Assoc, True);
          Out_Conv := Null_Iir;
-         Formal := Interface;
+         Formal := Inter;
       end if;
       Formal_Type := Get_Type (Formal);
 
@@ -1281,7 +1280,7 @@ package body Sem_Assocs is
          Match := False;
          return;
       end if;
-      if Get_Kind (Interface) /= Iir_Kind_Constant_Interface_Declaration then
+      if Get_Kind (Inter) /= Iir_Kind_Constant_Interface_Declaration then
          case Get_Kind (Actual) is
             when Iir_Kind_Function_Call =>
                Expr := Get_Parameter_Association_Chain (Actual);
@@ -1325,13 +1324,13 @@ package body Sem_Assocs is
          if Finish then
             Error_Msg_Sem
               ("can't associate " & Disp_Node (Actual) & " with "
-               & Disp_Node (Interface), Assoc);
+               & Disp_Node (Inter), Assoc);
             Error_Msg_Sem
               ("(type of " & Disp_Node (Actual) & " is "
                & Disp_Type_Of (Actual) & ")", Assoc);
             Error_Msg_Sem
-              ("(type of " & Disp_Node (Interface) & " is "
-               & Disp_Type_Of (Interface) & ")", Interface);
+              ("(type of " & Disp_Node (Inter) & " is "
+               & Disp_Type_Of (Inter) & ")", Inter);
          end if;
          return;
       end if;
@@ -1404,28 +1403,28 @@ package body Sem_Assocs is
    is
       --  Set POS and INTERFACE to *the* matching interface if any of ASSOC.
       procedure Search_Interface (Assoc : Iir;
-                                  Interface : out Iir;
+                                  Inter : out Iir;
                                   Pos : out Integer)
       is
          I_Match : Boolean;
       begin
-         Interface := Interface_Chain;
+         Inter := Interface_Chain;
          Pos := 0;
-         while Interface /= Null_Iir loop
+         while Inter /= Null_Iir loop
             -- Formal assoc is not necessarily a simple name, it may
             -- be a conversion function, or even an indexed or
             -- selected name.
-            Sem_Association (Assoc, Interface, False, I_Match);
+            Sem_Association (Assoc, Inter, False, I_Match);
             if I_Match then
                return;
             end if;
-            Interface := Get_Chain (Interface);
+            Inter := Get_Chain (Inter);
             Pos := Pos + 1;
          end loop;
       end Search_Interface;
 
       Assoc: Iir;
-      Interface: Iir;
+      Inter: Iir;
 
       type Bool_Array is array (Natural range <>) of Param_Assoc_Type;
       Nbr_Arg: constant Natural := Get_Chain_Length (Interface_Chain);
@@ -1444,7 +1443,7 @@ package body Sem_Assocs is
       Has_Individual := False;
 
       -- Loop on every assoc element, try to match it.
-      Interface := Interface_Chain;
+      Inter := Interface_Chain;
       Last_Individual := Null_Iir;
       Pos := 0;
 
@@ -1462,7 +1461,7 @@ package body Sem_Assocs is
                return;
             end if;
             -- Try to match actual of ASSOC with the interface.
-            if Interface = Null_Iir then
+            if Inter = Null_Iir then
                if Finish then
                   Error_Msg_Sem
                     ("too many arguments for " & Disp_Node (Loc), Assoc);
@@ -1470,7 +1469,7 @@ package body Sem_Assocs is
                Match := False;
                return;
             end if;
-            Sem_Association (Assoc, Interface, Finish, Match);
+            Sem_Association (Assoc, Inter, Finish, Match);
             if not Match then
                return;
             end if;
@@ -1480,7 +1479,7 @@ package body Sem_Assocs is
                Arg_Matched (Pos) := Whole;
             end if;
             Set_Whole_Association_Flag (Assoc, True);
-            Interface := Get_Chain (Interface);
+            Inter := Get_Chain (Inter);
             Pos := Pos + 1;
          else
             -- FIXME: directly search the formal if finish is true.
@@ -1503,10 +1502,10 @@ package body Sem_Assocs is
                         Assoc_1 := Null_Iir;
                      end if;
                   end if;
-                  Search_Interface (Assoc, Interface, Pos);
-                  if Interface = Null_Iir then
+                  Search_Interface (Assoc, Inter, Pos);
+                  if Inter = Null_Iir then
                      if Assoc_1 /= Null_Iir then
-                        Interface := Interface_1;
+                        Inter := Interface_1;
                         Pos := Pos_1;
                         Set_Formal (Assoc, Get_Formal (Assoc_1));
                         Set_Out_Conversion
@@ -1521,10 +1520,10 @@ package body Sem_Assocs is
                      end if;
                   end if;
                when others =>
-                  Search_Interface (Assoc, Interface, Pos);
+                  Search_Interface (Assoc, Inter, Pos);
             end case;
 
-            if Interface /= Null_Iir then
+            if Inter /= Null_Iir then
                if Get_Whole_Association_Flag (Assoc) then
                   --  Whole association.
                   Last_Individual := Null_Iir;
@@ -1538,8 +1537,7 @@ package body Sem_Assocs is
                   else
                      if Finish then
                         Error_Msg_Sem
-                          (Disp_Node (Interface) & " already associated",
-                           Assoc);
+                          (Disp_Node (Inter) & " already associated", Assoc);
                         Match := False;
                         return;
                      end if;
@@ -1550,29 +1548,27 @@ package body Sem_Assocs is
                   if Arg_Matched (Pos) /= Whole then
                      if Finish
                        and then Arg_Matched (Pos) = Individual
-                       and then Last_Individual /= Interface
+                       and then Last_Individual /= Inter
                      then
                         Error_Msg_Sem
                           ("non consecutive individual association for "
-                           & Disp_Node (Interface),
-                           Assoc);
+                           & Disp_Node (Inter), Assoc);
                         Match := False;
                         return;
                      end if;
-                     Last_Individual := Interface;
+                     Last_Individual := Inter;
                      Arg_Matched (Pos) := Individual;
                   else
                      if Finish then
                         Error_Msg_Sem
-                          (Disp_Node (Interface) & " already associated",
-                           Assoc);
+                          (Disp_Node (Inter) & " already associated", Assoc);
                         Match := False;
                         return;
                      end if;
                   end if;
                end if;
                if Finish then
-                  Sem_Association (Assoc, Interface, True, Match);
+                  Sem_Association (Assoc, Inter, True, Match);
                   if not Match then
                      raise Internal_Error;
                   end if;
@@ -1623,28 +1619,27 @@ package body Sem_Assocs is
       --  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;
+      Inter := Interface_Chain;
       Pos := 0;
-      while Interface /= Null_Iir loop
+      while Inter /= Null_Iir loop
          if Arg_Matched (Pos) <= Open
-           and then Get_Default_Value (Interface) = Null_Iir
+           and then Get_Default_Value (Inter) = Null_Iir
          then
             case Missing is
                when Missing_Parameter
                  | Missing_Generic =>
                   if Finish then
-                     Error_Msg_Sem
-                       ("no actual for " & Disp_Node (Interface), Loc);
+                     Error_Msg_Sem ("no actual for " & Disp_Node (Inter), Loc);
                   end if;
                   Match := False;
                   return;
                when Missing_Port =>
-                  case Get_Mode (Interface) is
+                  case Get_Mode (Inter) is
                      when Iir_In_Mode =>
                         if not Finish then
                            raise Internal_Error;
                         end if;
-                        Error_Msg_Sem (Disp_Node (Interface)
+                        Error_Msg_Sem (Disp_Node (Inter)
                                        & " of mode IN must be connected", Loc);
                         Match := False;
                         return;
@@ -1655,11 +1650,10 @@ package body Sem_Assocs is
                         if not Finish then
                            raise Internal_Error;
                         end if;
-                        if Is_Unconstrained_Type_Definition
-                          (Get_Type (Interface))
+                        if Is_Unconstrained_Type_Definition (Get_Type (Inter))
                         then
                            Error_Msg_Sem
-                             ("unconstrained " & Disp_Node (Interface)
+                             ("unconstrained " & Disp_Node (Inter)
                               & " must be connected", Loc);
                            Match := False;
                            return;
@@ -1671,7 +1665,7 @@ package body Sem_Assocs is
                   null;
             end case;
          end if;
-         Interface := Get_Chain (Interface);
+         Inter := Get_Chain (Inter);
          Pos := Pos + 1;
       end loop;
       return;
diff --git a/sem_decls.adb b/sem_decls.adb
index 3fe32aa86..ac34389f6 100644
--- a/sem_decls.adb
+++ b/sem_decls.adb
@@ -338,7 +338,7 @@ package body Sem_Decls is
       Type_Mark: Iir;
       Proc: Iir_Implicit_Procedure_Declaration;
       Func: Iir_Implicit_Function_Declaration;
-      Interface: Iir;
+      Inter: Iir;
       Loc : Location_Type;
       File_Interface_Kind : Iir_Kind;
       Last_Interface : Iir;
@@ -365,42 +365,42 @@ package body Sem_Decls is
                   Set_Implicit_Definition (Proc,
                                            Iir_Predefined_File_Open_Status);
                   --  status : out file_open_status.
-                  Interface :=
+                  Inter :=
                     Create_Iir (Iir_Kind_Variable_Interface_Declaration);
-                  Set_Location (Interface, Loc);
-                  Set_Identifier (Interface, Std_Names.Name_Status);
-                  Set_Type (Interface,
+                  Set_Location (Inter, Loc);
+                  Set_Identifier (Inter, Std_Names.Name_Status);
+                  Set_Type (Inter,
                             Std_Package.File_Open_Status_Type_Definition);
-                  Set_Mode (Interface, Iir_Out_Mode);
-                  Set_Base_Name (Interface, Interface);
-                  Append (Last_Interface, Proc, Interface);
+                  Set_Mode (Inter, Iir_Out_Mode);
+                  Set_Base_Name (Inter, Inter);
+                  Append (Last_Interface, Proc, Inter);
             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);
+            Inter := Create_Iir (Iir_Kind_File_Interface_Declaration);
+            Set_Location (Inter, Loc);
+            Set_Identifier (Inter, Std_Names.Name_F);
+            Set_Type (Inter, Type_Definition);
+            Set_Mode (Inter, Iir_Inout_Mode);
+            Set_Base_Name (Inter, Inter);
+            Append (Last_Interface, Proc, Inter);
             --  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);
+            Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+            Set_Location (Inter, Loc);
+            Set_Identifier (Inter, Std_Names.Name_External_Name);
+            Set_Type (Inter, Std_Package.String_Type_Definition);
+            Set_Mode (Inter, Iir_In_Mode);
+            Set_Base_Name (Inter, Inter);
+            Append (Last_Interface, Proc, Inter);
             --  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,
+            Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+            Set_Location (Inter, Loc);
+            Set_Identifier (Inter, Std_Names.Name_Open_Kind);
+            Set_Type (Inter, Std_Package.File_Open_Kind_Type_Definition);
+            Set_Mode (Inter, Iir_In_Mode);
+            Set_Base_Name (Inter, Inter);
+            Set_Default_Value (Inter,
                                Std_Package.File_Open_Kind_Read_Mode);
-            Append (Last_Interface, Proc, Interface);
+            Append (Last_Interface, Proc, Inter);
             Compute_Subprogram_Hash (Proc);
             -- Add it to the list.
             Insert_Incr (Last, Proc);
@@ -414,13 +414,13 @@ package body Sem_Decls is
          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);
+         Inter := Create_Iir (Iir_Kind_File_Interface_Declaration);
+         Set_Identifier (Inter, Std_Names.Name_F);
+         Set_Location (Inter, Loc);
+         Set_Type (Inter, Type_Definition);
+         Set_Mode (Inter, Iir_Inout_Mode);
+         Set_Base_Name (Inter, Inter);
+         Append (Last_Interface, Proc, Inter);
          Compute_Subprogram_Hash (Proc);
          -- Add it to the list.
          Insert_Incr (Last, Proc);
@@ -439,30 +439,30 @@ package body Sem_Decls is
       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);
+      Inter := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Inter, Std_Names.Name_F);
+      Set_Location (Inter, Loc);
+      Set_Type (Inter, Type_Definition);
+      Set_Mode (Inter, Iir_In_Mode);
+      Set_Base_Name (Inter, Inter);
+      Append (Last_Interface, Proc, Inter);
+      Inter := Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+      Set_Identifier (Inter, Std_Names.Name_Value);
+      Set_Location (Inter, Loc);
+      Set_Type (Inter, Type_Mark);
+      Set_Mode (Inter, Iir_Out_Mode);
+      Set_Base_Name (Inter, Inter);
+      Append (Last_Interface, Proc, Inter);
       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);
+            Inter := Create_Iir (Iir_Kind_Variable_Interface_Declaration);
+            Set_Identifier (Inter, Std_Names.Name_Length);
+            Set_Location (Inter, Loc);
+            Set_Type (Inter, Std_Package.Natural_Subtype_Definition);
+            Set_Mode (Inter, Iir_Out_Mode);
+            Set_Base_Name (Inter, Inter);
+            Append (Last_Interface, Proc, Inter);
             Set_Implicit_Definition (Proc, Iir_Predefined_Read_Length);
          when others =>
             Set_Implicit_Definition (Proc, Iir_Predefined_Read);
@@ -478,22 +478,22 @@ package body Sem_Decls is
       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);
+      Inter := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Inter, Std_Names.Name_F);
+      Set_Location (Inter, Loc);
+      Set_Type (Inter, Type_Definition);
+      Set_Mode (Inter, Iir_Out_Mode);
+      Set_Base_Name (Inter, Inter);
+      Set_Name_Staticness (Inter, Locally);
+      Set_Expr_Staticness (Inter, None);
+      Append (Last_Interface, Proc, Inter);
+      Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+      Set_Identifier (Inter, Std_Names.Name_Value);
+      Set_Location (Inter, Loc);
+      Set_Type (Inter, Type_Mark);
+      Set_Mode (Inter, Iir_In_Mode);
+      Set_Base_Name (Inter, Inter);
+      Append (Last_Interface, Proc, Inter);
       Set_Implicit_Definition (Proc, Iir_Predefined_Write);
       Compute_Subprogram_Hash (Proc);
       -- Add it to the list.
@@ -506,13 +506,13 @@ package body Sem_Decls is
       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);
+      Inter := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Inter, Std_Names.Name_F);
+      Set_Location (Inter, Loc);
+      Set_Type (Inter, Type_Definition);
+      Set_Mode (Inter, Iir_In_Mode);
+      Set_Base_Name (Inter, Inter);
+      Append (Last_Interface, Func, Inter);
       Set_Return_Type (Func, Std_Package.Boolean_Type_Definition);
       Set_Implicit_Definition (Func, Iir_Predefined_Endfile);
       Compute_Subprogram_Hash (Func);
@@ -523,15 +523,15 @@ package body Sem_Decls is
    function Create_Anonymous_Interface (Atype : Iir)
      return Iir_Constant_Interface_Declaration
    is
-      Interface : Iir_Constant_Interface_Declaration;
+      Inter : 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;
+      Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration);
+      Location_Copy (Inter, Atype);
+      Set_Identifier (Inter, Null_Identifier);
+      Set_Mode (Inter, Iir_In_Mode);
+      Set_Type (Inter, Atype);
+      Set_Base_Name (Inter, Inter);
+      return Inter;
    end Create_Anonymous_Interface;
 
    procedure Create_Implicit_Operations
diff --git a/sem_expr.adb b/sem_expr.adb
index 36f4b8005..77735b424 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -149,7 +149,7 @@ package body Sem_Expr is
       return Are_Types_Compatible (Get_Type (Left), Get_Type (Right));
    end Are_Nodes_Compatible;
 
-   function Check_Is_Expression (Expr : Iir) return Iir
+   function Check_Is_Expression (Expr : Iir; Loc : Iir) return Iir
    is
    begin
       if Expr = Null_Iir then
@@ -169,7 +169,7 @@ package body Sem_Expr is
            | Iir_Kind_Component_Declaration
            | Iir_Kinds_Procedure_Declaration =>
             Error_Msg_Sem (Disp_Node (Expr)
-                           & " not allowed in an expression", Expr);
+                           & " not allowed in an expression", Loc);
             return Null_Iir;
          when Iir_Kinds_Function_Declaration =>
             return Expr;
@@ -3713,7 +3713,7 @@ package body Sem_Expr is
       Res: Iir;
       Expr_Type : Iir;
    begin
-      if Check_Is_Expression (Expr) = Null_Iir then
+      if Check_Is_Expression (Expr, Expr) = Null_Iir then
          return Null_Iir;
       end if;
 
diff --git a/sem_expr.ads b/sem_expr.ads
index 97722bb1b..0ab384758 100644
--- a/sem_expr.ads
+++ b/sem_expr.ads
@@ -77,9 +77,10 @@ package Sem_Expr is
      return Iir;
 
    --  If EXPR is a node for an expression, then return EXPR.
-   --  Otherwise, emit an error message and return NULL_IIR.
+   --  Otherwise, emit an error message using LOC as location
+   --   and return NULL_IIR.
    --  If EXPR is NULL_IIR, NULL_IIR is silently returned.
-   function Check_Is_Expression (Expr : Iir) return Iir;
+   function Check_Is_Expression (Expr : Iir; Loc : Iir) return Iir;
 
    -- LEFT are RIGHT must be really a type (not a subtype).
    function Are_Basetypes_Compatible (Left: Iir; Right: Iir)
diff --git a/sem_names.adb b/sem_names.adb
index 25484e406..1cd3635fd 100644
--- a/sem_names.adb
+++ b/sem_names.adb
@@ -489,7 +489,7 @@ package body Sem_Names is
          exit when Index_Subtype = Null_Iir;
          Index := Get_Nth_Element (Index_List, I);
          -- The index_subtype can be an unconstrained index type.
-         Index := Check_Is_Expression (Index);
+         Index := Check_Is_Expression (Index, Index);
          if Index /= Null_Iir then
             Index := Sem_Expression (Index, Get_Base_Type (Index_Subtype));
          end if;
@@ -3053,7 +3053,7 @@ package body Sem_Names is
       if Get_Kind (Expr) = Iir_Kind_Error then
          return Null_Iir;
       end if;
-      if Check_Is_Expression (Expr) = Null_Iir then
+      if Check_Is_Expression (Expr, Name) = Null_Iir then
          return Null_Iir;
       end if;
 
diff --git a/translate/gcc/Make-lang.in b/translate/gcc/Make-lang.in
index 2aa27a1e0..cb7335c49 100644
--- a/translate/gcc/Make-lang.in
+++ b/translate/gcc/Make-lang.in
@@ -68,7 +68,7 @@ agcc_objdir=.
 AGCC_GCCSRC_DIR=$(srcdir)/..
 AGCC_GCCOBJ_DIR=..
 
-####agcc Makefile.inc
+####gcc Makefile.inc
 
 # The compiler proper.
 # It is compiled into the vhdl/ subdirectory to avoid file name clashes but
diff --git a/translate/gcc/Makefile.in b/translate/gcc/Makefile.in
index f459e6a09..2757b907c 100644
--- a/translate/gcc/Makefile.in
+++ b/translate/gcc/Makefile.in
@@ -176,7 +176,7 @@ drvdir/default_pathes.ads: drvdir Makefile
 	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 $@
+	$(srcdir)/../../move-if-change tmp-dpathes.ads $@
 
 ../ghdl$(exeext): drvdir drvdir/default_pathes.ads force
 	CURDIR=`pwd`; cd $(srcdir); SRCDIR=`pwd`; cd $$CURDIR/drvdir; \
diff --git a/translate/gcc/README b/translate/gcc/README
index a3df511af..d7bab3281 100644
--- a/translate/gcc/README
+++ b/translate/gcc/README
@@ -29,7 +29,7 @@ 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).
+* the Ada95 GNAT compiler (GNAT v3.15p and GNAT GPL 2005 are known to work).
 * GNU/Linux for ix86 (pc systems) (porting is necessary for other systems)
 
 Procedure:
diff --git a/translate/gcc/config-lang.in b/translate/gcc/config-lang.in
index 393d2277f..7010b1127 100644
--- a/translate/gcc/config-lang.in
+++ b/translate/gcc/config-lang.in
@@ -35,4 +35,4 @@ stagestuff="ghdl\$(exeext) ghdl1\$(exeext)"
 
 outputs=vhdl/Makefile
 
-gtfiles="\$(srcdir)/vhdl/agcc-bindings.c"
+gtfiles="\$(srcdir)/vhdl/ortho-lang.c"
diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh
index a946e4602..c2cd8f16f 100755
--- a/translate/gcc/dist.sh
+++ b/translate/gcc/dist.sh
@@ -38,14 +38,14 @@
 
 set -e
 
-VERSION=`sed -n -e 's/.*GHDL \([0-9.]*\) (.*/\1/p' ../../version.ads`
+VERSION=`sed -n -e 's/.*GHDL \([0-9.a-z]*\) (.*/\1/p' ../../version.ads`
 
 CWD=`pwd`
 
 distdir=ghdl-$VERSION
 tarfile=$distdir.tar
 
-GCCVERSION=3.4.3
+GCCVERSION=4.0.2
 DISTDIR=/home/gingold/dist
 GCCDIST=$DISTDIR/gcc-$GCCVERSION
 GCCDISTOBJ=$GCCDIST-objs
@@ -80,7 +80,7 @@ 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" \
+  sed -e "/^####gcc Makefile.inc/r ../../ortho/gcc/Makefile.inc" \
      < Make-lang.in > $VHDLDIR/Make-lang.in
 }
 
@@ -194,55 +194,22 @@ 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-lang.c
 ortho_gcc-main.adb
 ortho_gcc-main.ads
+ortho_gcc.adb
 ortho_gcc.ads
-ortho_gcc.adb"
+ortho_gcc_front.ads
+ortho_ident.adb
+ortho_ident.ads
+ortho_nodes.ads
+"
 
 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
@@ -347,12 +314,16 @@ grt-stack2.adb
 grt-stack2.ads
 grt-stacks.adb
 grt-stacks.ads
+grt-c.ads
+grt-zlib.ads
 grt-stdio.ads
 grt-astdio.ads
 grt-astdio.adb
 grt-types.ads
 grt-vcd.adb
 grt-vcd.ads
+grt-vcdz.adb
+grt-vcdz.ads
 grt-vital_annotate.adb
 grt-vital_annotate.ads
 grt-vpi.adb
@@ -497,7 +468,7 @@ do_tar_dist ()
   rm -rf $bindirname
   mkdir $bindirname
   sed -e "s/@TARFILE@/$dir.tar/" < INSTALL > $bindirname/INSTALL
-  ln COPYING $bindirname
+  ln ../../COPYING $bindirname
   ln $TARINSTALL $bindirname
   tar cvf $bindirname.tar $bindirname
 }
diff --git a/translate/grt/ghwlib.c b/translate/grt/ghwlib.c
index 827e69851..984729246 100644
--- a/translate/grt/ghwlib.c
+++ b/translate/grt/ghwlib.c
@@ -1147,10 +1147,10 @@ ghw_read_cycle_cont (struct ghw_handler *h, int *list)
   list_p = list;
   while (1)
     {
-      int32_t d;
+      uint32_t d;
       
       /* Read delta to next signal.  */
-      if (ghw_read_sleb128 (h, &d) < 0)
+      if (ghw_read_uleb128 (h, &d) < 0)
 	return -1;
       if (d == 0)
 	{
diff --git a/translate/grt/grt-astdio.adb b/translate/grt/grt-astdio.adb
index 3c19cc851..de28094d1 100644
--- a/translate/grt/grt-astdio.adb
+++ b/translate/grt/grt-astdio.adb
@@ -15,6 +15,8 @@
 --  along with 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.C; use Grt.C;
+
 package body Grt.Astdio is
    procedure Put (Stream : FILEs; Str : String)
    is
diff --git a/translate/grt/grt-c.ads b/translate/grt/grt-c.ads
new file mode 100644
index 000000000..33fb36cef
--- /dev/null
+++ b/translate/grt/grt-c.ads
@@ -0,0 +1,36 @@
+--  GHDL Run Time (GRT) - C interface.
+--  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.
+
+--  This package declares C types.
+--  It is a really stripped down version of interfaces.C!
+with System;
+
+package Grt.C is
+   pragma Preelaborate (Grt.C);
+
+   --  Type void * and char *.
+   subtype voids is System.Address;
+   subtype chars is System.Address;
+   subtype long is Long_Integer;
+
+   --  Type size_t.
+   type size_t is mod 2 ** Standard'Address_Size;
+
+   --  Type int.  It is an alias on Integer for simplicity.
+   subtype int is Integer;
+end Grt.C;
diff --git a/translate/grt/grt-disp.adb b/translate/grt/grt-disp.adb
index 9bd803534..a40f0edfe 100644
--- a/translate/grt/grt-disp.adb
+++ b/translate/grt/grt-disp.adb
@@ -15,6 +15,7 @@
 --  along with GCC; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Types; use Grt.Types;
 with Grt.Signals; use Grt.Signals;
 with Grt.Astdio; use Grt.Astdio;
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index 47e5ac6ce..28ad75db5 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -21,7 +21,6 @@ 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;
 
@@ -649,7 +648,8 @@ package body Grt.Disp_Rti is
       Put (" := ");
 
       --  FIXME: put this into a function.
-      if Obj_Type.Kind = Ghdl_Rtik_Subtype_Array
+      if (Obj_Type.Kind = Ghdl_Rtik_Subtype_Array
+          or Obj_Type.Kind = Ghdl_Rtik_Type_Record)
         and then Obj_Type.Mode = 1
       then
          Addr := To_Addr_Acc (Addr).all;
diff --git a/translate/grt/grt-disp_signals.adb b/translate/grt/grt-disp_signals.adb
index ab73b2d24..0fdf01d23 100644
--- a/translate/grt/grt-disp_signals.adb
+++ b/translate/grt/grt-disp_signals.adb
@@ -16,6 +16,7 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
 with Ada.Unchecked_Conversion;
 with Grt.Types; use Grt.Types;
 with Grt.Rtis; use Grt.Rtis;
diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb
index d0063226a..151549712 100644
--- a/translate/grt/grt-files.adb
+++ b/translate/grt/grt-files.adb
@@ -17,6 +17,7 @@
 --  02111-1307, USA.
 with Grt.Errors; use Grt.Errors;
 with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
 with GNAT.Table;
 with System; use System;
 
diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb
index 8b85d59ec..e322f4775 100644
--- a/translate/grt/grt-images.adb
+++ b/translate/grt/grt-images.adb
@@ -16,6 +16,7 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
 with Ada.Unchecked_Conversion;
 with Grt.Processes; use Grt.Processes;
 with Grt.Vstrings; use Grt.Vstrings;
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
index db57dc81c..99ac86ca8 100644
--- a/translate/grt/grt-main.adb
+++ b/translate/grt/grt-main.adb
@@ -15,9 +15,11 @@
 --  along with GCC; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Types; use Grt.Types;
 with Grt.Errors;
 with Grt.Vcd;
+with Grt.Vcdz;
 with Grt.Vpi;
 with Grt.Waves;
 with Grt.Stacks;
@@ -83,6 +85,7 @@ package body Grt.Main is
    begin
       --  List of modules to be registered.
       Grt.Vcd.Register;
+      Grt.Vcdz.Register;
       Grt.Waves.Register;
       Grt.Vpi.Register;
       Grt.Vital_Annotate.Register;
diff --git a/translate/grt/grt-names.adb b/translate/grt/grt-names.adb
index be4fc8665..46ed04e2d 100644
--- a/translate/grt/grt-names.adb
+++ b/translate/grt/grt-names.adb
@@ -17,6 +17,7 @@
 --  02111-1307, USA.
 --with Grt.Errors; use Grt.Errors;
 with Ada.Unchecked_Conversion;
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Processes; use Grt.Processes;
 with Grt.Rtis_Addr; use Grt.Rtis_Addr;
 with Grt.Rtis_Utils; use Grt.Rtis_Utils;
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index a4e269bf9..c0dee2bcb 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -18,6 +18,7 @@
 with GNAT.Table;
 with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Stack2; use Grt.Stack2;
 with Grt.Disp;
 with Grt.Astdio;
diff --git a/translate/grt/grt-sdf.adb b/translate/grt/grt-sdf.adb
index 9d329781c..c7391ccb4 100644
--- a/translate/grt/grt-sdf.adb
+++ b/translate/grt/grt-sdf.adb
@@ -15,8 +15,10 @@
 --  along with GCC; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Types; use Grt.Types;
 with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
 with Grt.Errors; use Grt.Errors;
 with Ada.Characters.Latin_1;
 with Ada.Unchecked_Deallocation;
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index 9ed8a3227..638c37572 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -16,6 +16,7 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
 with Ada.Unchecked_Deallocation;
 with Ada.Unchecked_Conversion;
 with Grt.Errors; use Grt.Errors;
diff --git a/translate/grt/grt-stats.adb b/translate/grt/grt-stats.adb
index 9e3259cd0..284cc6a91 100644
--- a/translate/grt/grt-stats.adb
+++ b/translate/grt/grt-stats.adb
@@ -16,6 +16,7 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Stdio; use Grt.Stdio;
 with Grt.Astdio; use Grt.Astdio;
 with Grt.Signals;
diff --git a/translate/grt/grt-stdio.ads b/translate/grt/grt-stdio.ads
index fad33226b..b600416f2 100644
--- a/translate/grt/grt-stdio.ads
+++ b/translate/grt/grt-stdio.ads
@@ -16,6 +16,7 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with System;
+with Grt.C; use Grt.C;
 
 --  This package provides a thin binding to the stdio.h of the C library.
 --  It mimics GNAT package Interfaces.C_Streams.
@@ -35,17 +36,6 @@ package Grt.Stdio is
    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;
diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb
index 66f248c5d..f9fd174d2 100644
--- a/translate/grt/grt-vcd.adb
+++ b/translate/grt/grt-vcd.adb
@@ -18,22 +18,52 @@
 with Interfaces;
 with Grt.Stdio; use Grt.Stdio;
 with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
 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.C; use Grt.C;
 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;
+with Grt.Vstrings;
 
 package body Grt.Vcd is
+   type Vcd_IO_Simple is new Vcd_IO_Handler with record
+      Stream : FILEs;
+   end record;
+   type IO_Simple_Acc is access Vcd_IO_Simple;
+   procedure Vcd_Put (Handler : access Vcd_IO_Simple; Str : String);
+   procedure Vcd_Putc (Handler : access Vcd_IO_Simple; C : Character);
+   procedure Vcd_Close (Handler : access Vcd_IO_Simple);
+
+   procedure Vcd_Put (Handler : access Vcd_IO_Simple; Str : String)
+   is
+      R : size_t;
+   begin
+      R := fwrite (Str'Address, Str'Length, 1, Handler.Stream);
+   end Vcd_Put;
+
+   procedure Vcd_Putc (Handler : access Vcd_IO_Simple; C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), Handler.Stream);
+   end Vcd_Putc;
+
+   procedure Vcd_Close (Handler : access Vcd_IO_Simple) is
+   begin
+      fclose (Handler.Stream);
+      Handler.Stream := NULL_Stream;
+   end Vcd_Close;
+
    --  VCD filename.
-   Vcd_Filename : String_Access := null;
    --  Stream corresponding to the VCD filename.
-   Vcd_Stream : FILEs;
+   --Vcd_Stream : FILEs;
 
    --  Index type of the table of vcd variables to dump.
    type Vcd_Index_Type is new Integer;
@@ -42,15 +72,37 @@ package body Grt.Vcd is
    function Vcd_Option (Opt : String) return Boolean
    is
       F : Natural := Opt'First;
+      Mode : constant String := "wt" & NUL;
+      Handler : IO_Simple_Acc;
+      Vcd_Filename : String_Access;
    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
+         if H /= null then
+            Error ("--vcd: file already set");
+            return True;
+         end if;
+
          --  Add an extra NUL character.
          Vcd_Filename := new String (1 .. Opt'Length - 6 + 1);
          Vcd_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last);
          Vcd_Filename (Vcd_Filename'Last) := NUL;
+
+         Handler := new Vcd_IO_Simple;
+         if Vcd_Filename.all = "-" & NUL then
+            Handler.Stream := stdout;
+         else
+            Handler.Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
+            if Handler.Stream = NULL_Stream then
+               Error_C ("cannot open ");
+               Error_E (Vcd_Filename (Vcd_Filename'First
+                                      .. Vcd_Filename'Last - 1));
+               return True;
+            end if;
+         end if;
+         H := Handler_Acc (Handler);
          return True;
       else
          return False;
@@ -62,28 +114,24 @@ package body Grt.Vcd is
       Put_Line (" --vcd=FILENAME     dump signal values into a VCD file");
    end Vcd_Help;
 
-   procedure Vcd_Put (Str : String)
-   is
-      R : size_t;
+   procedure Vcd_Put (Str : String) is
    begin
-      R := fwrite (Str'Address, Str'Length, 1, Vcd_Stream);
+      Vcd_Put (H, Str);
    end Vcd_Put;
 
-   procedure Vcd_Putc (C : Character)
-   is
-      R : int;
+   procedure Vcd_Putc (C : Character) is
    begin
-      R := fputc (Character'Pos (C), Vcd_Stream);
+      Vcd_Putc (H, C);
    end Vcd_Putc;
 
    procedure Vcd_Newline is
    begin
-      Vcd_Putc (Nl);
+      Vcd_Putc (H, Nl);
    end Vcd_Newline;
 
    procedure Vcd_Putline (Str : String) is
    begin
-      Vcd_Put (Str);
+      Vcd_Put (H, Str);
       Vcd_Newline;
    end Vcd_Putline;
 
@@ -95,8 +143,11 @@ package body Grt.Vcd is
 
    procedure Vcd_Put_I32 (V : Ghdl_I32)
    is
+      Str : String (1 .. 11);
+      First : Natural;
    begin
-      Put_I32 (Vcd_Stream, V);
+      Vstrings.To_String (Str, First, V);
+      Vcd_Put (Str (First .. Str'Last));
    end Vcd_Put_I32;
 
    procedure Vcd_Put_Idcode (N : Vcd_Index_Type)
@@ -139,23 +190,10 @@ package body Grt.Vcd is
    --  Called before elaboration.
    procedure Vcd_Init
    is
-      Mode : constant String := "wt" & NUL;
    begin
-      if Vcd_Filename = null then
-         Vcd_Stream := NULL_Stream;
+      if H = null then
          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
@@ -165,13 +203,17 @@ package body Grt.Vcd is
          function time (Addr : Address) return time_t;
          pragma Import (C, time);
 
-         function ctime (Timep: Address) return chars;
+         function ctime (Timep: Address) return Ghdl_C_String;
          pragma Import (C, ctime);
 
-         R : int;
+         Ct : Ghdl_C_String;
       begin
          Cur_Time := time (Null_Address);
-         R := fputs (ctime (Cur_Time'Address), Vcd_Stream);
+         Ct := ctime (Cur_Time'Address);
+         for I in Positive loop
+            exit when Ct (I) = NUL;
+            Vcd_Putc (Ct (I));
+         end loop;
          -- Note: ctime already append a LF.
       end;
       Vcd_Put_End;
@@ -639,9 +681,12 @@ package body Grt.Vcd is
 
    procedure Vcd_Put_Time
    is
+      Str : String (1 .. 21);
+      First : Natural;
    begin
       Vcd_Putc ('#');
-      Put_I64 (Vcd_Stream, Ghdl_I64 (Cycle_Time));
+      Vstrings.To_String (Str, First, Ghdl_I64 (Cycle_Time));
+      Vcd_Put (Str (First .. Str'Last));
       Vcd_Newline;
    end Vcd_Put_Time;
 
@@ -653,7 +698,7 @@ package body Grt.Vcd is
       Root : VhpiHandleT;
    begin
       --  Do nothing if there is no VCD file to generate.
-      if Vcd_Stream = NULL_Stream then
+      if H = null then
          return;
       end if;
 
@@ -674,11 +719,6 @@ package body Grt.Vcd is
    --  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
@@ -699,7 +739,9 @@ package body Grt.Vcd is
    --  Called at the end of the simulation.
    procedure Vcd_End is
    begin
-      null;
+      if H /= null then
+         Vcd_Close (H);
+      end if;
    end Vcd_End;
 
    Vcd_Hooks : aliased constant Hooks_Type :=
diff --git a/translate/grt/grt-vcd.ads b/translate/grt/grt-vcd.ads
index 40b9d8c5e..a6d79b402 100644
--- a/translate/grt/grt-vcd.ads
+++ b/translate/grt/grt-vcd.ads
@@ -20,6 +20,18 @@ with Grt.Types; use Grt.Types;
 with Grt.Avhpi; use Grt.Avhpi;
 
 package Grt.Vcd is
+   --  Abstract type for IO.
+   type Vcd_IO_Handler is abstract tagged null record;
+   procedure Vcd_Put (Handler : access Vcd_IO_Handler; Str : String)
+      is abstract;
+   procedure Vcd_Putc (Handler : access Vcd_IO_Handler; C : Character)
+      is abstract;
+   procedure Vcd_Close (Handler : access Vcd_IO_Handler)
+      is abstract;
+
+   type Handler_Acc is access all Vcd_IO_Handler'Class;
+   H : Handler_Acc := null;
+
    type Vcd_Var_Kind is (Vcd_Bad,
                          Vcd_Bool,
                          Vcd_Integer32,
diff --git a/translate/grt/grt-vcdz.adb b/translate/grt/grt-vcdz.adb
new file mode 100644
index 000000000..7b5144ee2
--- /dev/null
+++ b/translate/grt/grt-vcdz.adb
@@ -0,0 +1,112 @@
+--  GHDL Run Time (GRT) - VCD .gz module.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System.Storage_Elements; --  Work around GNAT bug.
+with Grt.Vcd; use Grt.Vcd;
+with Grt.Errors; use Grt.Errors;
+with Grt.Types; use Grt.Types;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Zlib; use Grt.Zlib;
+with Grt.C; use Grt.C;
+
+package body Grt.Vcdz is
+   type Vcd_IO_Gzip is new Vcd_IO_Handler with record
+      Stream : gzFile;
+   end record;
+   type IO_Gzip_Acc is access Vcd_IO_Gzip;
+   procedure Vcd_Put (Handler : access Vcd_IO_Gzip; Str : String);
+   procedure Vcd_Putc (Handler : access Vcd_IO_Gzip; C : Character);
+   procedure Vcd_Close (Handler : access Vcd_IO_Gzip);
+
+   procedure Vcd_Put (Handler : access Vcd_IO_Gzip; Str : String)
+   is
+      R : int;
+   begin
+      R := gzwrite (Handler.Stream, Str'Address, Str'Length);
+   end Vcd_Put;
+
+   procedure Vcd_Putc (Handler : access Vcd_IO_Gzip; C : Character)
+   is
+      R : int;
+   begin
+      R := gzputc (Handler.Stream, Character'Pos (C));
+   end Vcd_Putc;
+
+   procedure Vcd_Close (Handler : access Vcd_IO_Gzip) is
+   begin
+      gzclose (Handler.Stream);
+      Handler.Stream := NULL_gzFile;
+   end Vcd_Close;
+
+   --  VCD filename.
+
+   --  Return TRUE if OPT is an option for VCD.
+   function Vcdz_Option (Opt : String) return Boolean
+   is
+      F : Natural := Opt'First;
+      Vcd_Filename : String_Access := null;
+      Handler : IO_Gzip_Acc;
+      Mode : constant String := "wb" & NUL;
+   begin
+      if Opt'Length < 7 or else Opt (F .. F + 6) /= "--vcdgz" then
+         return False;
+      end if;
+      if Opt'Length > 7 and then Opt (F + 7) = '=' then
+         if H /= null then
+            Error ("--vcdz: file already set");
+            return True;
+         end if;
+
+         --  Add an extra NUL character.
+         Vcd_Filename := new String (1 .. Opt'Length - 8 + 1);
+         Vcd_Filename (1 .. Opt'Length - 8) := Opt (F + 8 .. Opt'Last);
+         Vcd_Filename (Vcd_Filename'Last) := NUL;
+
+         Handler := new Vcd_IO_Gzip;
+         Handler.Stream := gzopen (Vcd_Filename.all'Address, Mode'Address);
+         if Handler.Stream = NULL_gzFile then
+            Error_C ("cannot open ");
+            Error_E (Vcd_Filename (Vcd_Filename'First
+                                   .. Vcd_Filename'Last - 1));
+            return True;
+         end if;
+         H := Handler_Acc (Handler);
+         return True;
+      else
+         return False;
+      end if;
+   end Vcdz_Option;
+
+   procedure Vcdz_Help is
+   begin
+      Put_Line
+        (" --vcdgz=FILENAME   dump signal values into a VCD gzip'ed file");
+   end Vcdz_Help;
+
+   Vcdz_Hooks : aliased constant Hooks_Type :=
+     (Option => Vcdz_Option'Access,
+      Help => Vcdz_Help'Access,
+      Init => Proc_Hook_Nil'Access,
+      Start => Proc_Hook_Nil'Access,
+      Finish => Proc_Hook_Nil'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Vcdz_Hooks'Access);
+   end Register;
+end Grt.Vcdz;
diff --git a/translate/grt/grt-vcdz.ads b/translate/grt/grt-vcdz.ads
new file mode 100644
index 000000000..c213efb16
--- /dev/null
+++ b/translate/grt/grt-vcdz.ads
@@ -0,0 +1,21 @@
+--  GHDL Run Time (GRT) - VCD .gz module.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Grt.Vcdz is
+   procedure Register;
+end Grt.Vcdz;
diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb
index 0609d466c..f6c5c56ad 100644
--- a/translate/grt/grt-vpi.adb
+++ b/translate/grt/grt-vpi.adb
@@ -39,7 +39,9 @@
 -------------------------------------------------------------------------------
 
 with Ada.Unchecked_Deallocation;
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
 with Grt.Signals; use Grt.Signals;
 with GNAT.Table;
 with Grt.Astdio; use Grt.Astdio;
diff --git a/translate/grt/grt-vstrings.adb b/translate/grt/grt-vstrings.adb
index 17c64e3da..d17cc87ea 100644
--- a/translate/grt/grt-vstrings.adb
+++ b/translate/grt/grt-vstrings.adb
@@ -15,7 +15,9 @@
 --  along with GCC; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Errors; use Grt.Errors;
+with Grt.C; use Grt.C;
 
 package body Grt.Vstrings is
    procedure Free (Fs : Fat_String_Acc);
diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb
index 93f217e82..c571cfabf 100644
--- a/translate/grt/grt-waves.adb
+++ b/translate/grt/grt-waves.adb
@@ -18,9 +18,11 @@
 with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 with Interfaces; use Interfaces;
+with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Types; use Grt.Types;
 with Grt.Avhpi; use Grt.Avhpi;
 with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
 with Grt.Errors; use Grt.Errors;
 with Grt.Types; use Grt.Types;
 with Grt.Astdio; use Grt.Astdio;
diff --git a/translate/grt/grt-zlib.ads b/translate/grt/grt-zlib.ads
new file mode 100644
index 000000000..6b674ca03
--- /dev/null
+++ b/translate/grt/grt-zlib.ads
@@ -0,0 +1,40 @@
+--  GHDL Run Time (GRT) - Zlib binding.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with System; use System;
+with Grt.C; use Grt.C;
+
+package Grt.Zlib is
+   pragma Linker_Options ("-lz");
+
+   type gzFile is new System.Address;
+
+   NULL_gzFile : constant gzFile := gzFile (System'To_Address (0));
+
+   function gzputc (File : gzFile; C : int) return int;
+   pragma Import (C, gzputc);
+
+   function gzwrite (File : gzFile; Buf : voids; Len : int) return int;
+   pragma Import (C, gzwrite);
+
+   function gzopen (Path : chars; Mode : chars) return gzFile;
+   pragma Import (C, gzopen);
+
+   procedure gzclose (File : gzFile);
+   pragma Import (C, gzclose);
+end Grt.Zlib;
diff --git a/translate/translation.adb b/translate/translation.adb
index 8f3c66172..9e1f3a444 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -13961,7 +13961,7 @@ package body Translation is
          Right_Type : Iir;
          Res_Otype : O_Tnode;
          Op : ON_Op_Kind;
-         Interface : Iir;
+         Inter : Iir;
          Res : O_Enode;
       begin
          Kind := Get_Implicit_Definition (Imp);
@@ -13970,18 +13970,18 @@ package body Translation is
          end if;
 
          Res_Otype := Get_Ortho_Type (Res_Type, Mode_Value);
-         Interface := Get_Interface_Declaration_Chain (Imp);
+         Inter := Get_Interface_Declaration_Chain (Imp);
          if Left = Null_Iir then
             Left_Tree := O_Enode_Null;
          else
-            Left_Type := Get_Type (Interface);
+            Left_Type := Get_Type (Inter);
             Left_Tree := Translate_Expression (Left, Left_Type);
          end if;
 
          if Right = Null_Iir then
             Right_Tree := O_Enode_Null;
          else
-            Right_Type := Get_Type (Get_Chain (Interface));
+            Right_Type := Get_Type (Get_Chain (Inter));
             Right_Tree := Translate_Expression (Right, Right_Type);
          end if;
 
diff --git a/version.ads b/version.ads
index 09a16d71d..e459f8e8d 100644
--- a/version.ads
+++ b/version.ads
@@ -1,3 +1,4 @@
 package Version is
-   Ghdl_Version : constant String := "GHDL 0.20dev (20050924) [Sokcho edition]";
+   Ghdl_Version : constant String :=
+      "GHDL 0.20dev (20050926) [Sokcho edition]";
 end Version;