First import from sources

44 files changed, 7328 insertions, 0 deletions

diff --git a/ortho/Makefile.inc b/ortho/Makefile.inc
new file mode 100644
index 000000000..683600017
--- /dev/null
+++ b/ortho/Makefile.inc
@@ -0,0 +1,41 @@
+#  Common -*- Makefile -*- for ortho implementations.
+#  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+#
+#  GHDL is free software; you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free
+#  Software Foundation; either version 2, or (at your option) any later
+#  version.
+#
+#  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#  for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with GCC; see the file COPYING.  If not, write to the Free
+#  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+#  02111-1307, USA.
+
+# Variable to be defined:
+#   SED: sed the stream editor
+#   ORTHO_BASENAME
+
+$(ORTHO_BASENAME).ads: $(ortho_srcdir)/ortho_nodes.common.ads \
+  $(ORTHO_BASENAME).private.ads
+	$(SED) -e '/^package/,$$d' \
+	  < $(ORTHO_BASENAME).private.ads \
+	  > tmp.prv.hdr
+	$(SED) -e '1,/^private/d' -e '/^end/d' \
+	  < $(ORTHO_BASENAME).private.ads \
+	  > tmp.prv.dcl
+	$(SED) -e '1,/^package/d' -e '/^private/,$$d' \
+	  < $(ORTHO_BASENAME).private.ads \
+	  > tmp.prv.pub
+	$(SED) \
+	  -e '/^   --- PRIVATE/r tmp.prv.dcl' \
+	  -e '/^--- PRIVATE CONTEXT CLAUSES/r tmp.prv.hdr' \
+	  -e '/^   --- PUBLIC DECLARATIONS/r tmp.prv.pub' \
+	  -e '/--- PRIVATE/d' \
+	  -e 's/ORTHO_NODES/$(ORTHO_PACKAGE)/g' < $< > $@
+	$(RM) -f tmp.prv.dcl tmp.prv.hdr tmp.prv.pub
+
diff --git a/ortho/agcc/Makefile.inc b/ortho/agcc/Makefile.inc
new file mode 100644
index 000000000..b5da6f088
--- /dev/null
+++ b/ortho/agcc/Makefile.inc
@@ -0,0 +1,112 @@
+#  -*- Makefile -*- for agcc, the Ada binding for GCC internals.
+#  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+#
+#  GHDL is free software; you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free
+#  Software Foundation; either version 2, or (at your option) any later
+#  version.
+#
+#  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#  for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with GCC; see the file COPYING.  If not, write to the Free
+#  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+#  02111-1307, USA.
+
+# Variable used:
+# AGCC_GCCSRC_DIR: the gcc source base directory (ie gcc-X.Y.Z-objs/)
+# AGCC_GCCOBJ_DIR: the gcc objects base directory
+# agcc_srcdir: the agcc source directory
+# agcc_objdir: the agcc object directory
+
+AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \
+ -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config
+AGCC_CFLAGS=-g -DIN_GCC $(AGCC_INC_FLAGS)
+
+AGCC_LOCAL_OBJS=agcc-bindings.o agcc-version.o
+
+AGCC_DEPS := $(agcc_srcdir)/agcc-trees.ads \
+  $(agcc_srcdir)/agcc-hwint.ads \
+  $(agcc_srcdir)/agcc-hconfig.ads \
+  $(agcc_srcdir)/agcc-real.ads \
+  $(agcc_srcdir)/agcc-machmode.ads \
+  $(agcc_srcdir)/agcc-tm.ads \
+  $(agcc_srcdir)/agcc-options.ads \
+  $(AGCC_LOCAL_OBJS)
+AGCC_OBJS := $(AGCC_LOCAL_OBJS) \
+	$(AGCC_GCCOBJ_DIR)/gcc/toplev.o \
+	$(AGCC_GCCOBJ_DIR)/gcc/c-convert.o \
+	$(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \
+	$(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a
+
+# Set rights to prevent editing.
+GENERATE_VIA_GEN_TREE=\
+  $(RM) -f $@ && \
+  $(agcc_objdir)/gen_tree -C $(AGCC_GCCOBJ_DIR)/gcc - < $< > $@ && \
+  chmod a-w $@
+
+$(agcc_srcdir)/agcc-trees.ads: $(agcc_srcdir)/agcc-trees.ads.in \
+   $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-hwint.ads: $(agcc_srcdir)/agcc-hwint.ads.in \
+   $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-hconfig.ads: $(agcc_srcdir)/agcc-hconfig.ads.in \
+   $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-real.ads: $(agcc_srcdir)/agcc-real.ads.in \
+   $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-machmode.ads: $(agcc_srcdir)/agcc-machmode.ads.in \
+   $(agcc_objdir)/gen_tree \
+   $(AGCC_GCCOBJ_DIR)/gcc/insn-modes.h
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-tm.ads: $(agcc_srcdir)/agcc-tm.ads.in \
+ $(agcc_objdir)/gen_tree
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_srcdir)/agcc-options.ads: $(agcc_srcdir)/agcc-options.ads.in \
+ $(agcc_objdir)/gen_tree \
+ $(AGCC_GCCOBJ_DIR)/gcc/options.h
+	$(GENERATE_VIA_GEN_TREE)
+
+$(agcc_objdir)/gen_tree: $(agcc_objdir)/gen_tree.o
+	$(CC) -o $@ $<
+
+$(agcc_objdir)/gen_tree.o: $(agcc_srcdir)/gen_tree.c \
+  $(AGCC_GCCSRC_DIR)/gcc/tree.def $(AGCC_GCCSRC_DIR)/gcc/tree.h \
+  $(AGCC_GCCOBJ_DIR)/gcc/tree-check.h
+	$(CC) -c -o $@ $< $(AGCC_CFLAGS)
+
+agcc-bindings.o: $(agcc_srcdir)/agcc-bindings.c \
+ $(AGCC_GCCOBJ_DIR)/gcc/gtype-vhdl.h \
+ $(AGCC_GCCOBJ_DIR)/gcc/gt-vhdl-agcc-bindings.h
+	$(CC) -c -o $@ $< $(AGCC_CFLAGS)
+
+agcc-version.c: $(AGCC_GCCSRC_DIR)/gcc/version.c
+	-$(RM) -f $@
+	echo '#include "version.h"' > $@
+	sed  -n -e '/version_string/ s/";/ (ghdl)";/p' < $< >> $@
+	echo 'const char bug_report_url[] = "<URL:mailto:ghdl@free.fr>";' >> $@
+
+agcc-version.o: agcc-version.c
+	$(CC) -c -o $@ $< $(AGCC_CFLAGS)
+
+agcc-clean: force
+	$(RM) -f $(agcc_objdir)/gen_tree $(agcc_objdir)/gen_tree.o
+	$(RM) -f $(agcc_objdir)/*.o
+	$(RM) -f $(agcc_srcdir)/*~
+
+agcc-maintainer-clean: force
+	$(RM) -f $(AGCC_DEPS)
+
+
+.PHONY: agcc-clean agcc-maintainer-clean
diff --git a/ortho/agcc/agcc-autils.adb b/ortho/agcc/agcc-autils.adb
new file mode 100644
index 000000000..30eb1e622
--- /dev/null
+++ b/ortho/agcc/agcc-autils.adb
@@ -0,0 +1,93 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+with Agcc.Hconfig; use Agcc.Hconfig;
+with Agcc.Machmode; use Agcc.Machmode;
+
+package body Agcc.Autils is
+   Arr_Len : constant Natural := Unsigned_64'Size / HOST_WIDE_INT'Size;
+   type Arr_Conv is array (Natural range 0 .. Arr_Len - 1) of HOST_WIDE_INT;
+
+   subtype Assert_Type is Boolean range True .. True;
+   Assert_Arr_Len_Is_1_Or_2 : constant Assert_Type :=
+     Arr_Len = 1 or Arr_Len = 2;
+   pragma Unreferenced (Assert_Arr_Len_Is_1_Or_2);
+
+   procedure To_Host_Wide_Int (V : Unsigned_64; L, H : out HOST_WIDE_INT) is
+      function Unchecked_Conversion is new Ada.Unchecked_Conversion
+        (Source => Unsigned_64, Target => Arr_Conv);
+      Res : Arr_Conv;
+   begin
+      Res := Unchecked_Conversion (V);
+      if Arr_Len = 1 then
+         H := 0;
+         L := Res (0);
+      else
+         if HOST_WORDS_BIG_ENDIAN then
+            L := Res (1);
+            H := Res (0);
+         else
+            L := Res (0);
+            H := Res (1);
+         end if;
+      end if;
+   end To_Host_Wide_Int;
+
+   procedure To_Host_Wide_Int (V : Integer_64; L, H : out HOST_WIDE_INT) is
+      function Unchecked_Conversion is new Ada.Unchecked_Conversion
+        (Source => Integer_64, Target => Arr_Conv);
+      Res : Arr_Conv;
+   begin
+      Res := Unchecked_Conversion (V);
+      if Arr_Len = 1 then
+         if V < 0 then
+            H := -1;
+         else
+            H := 0;
+         end if;
+         L := Res (0);
+      else
+         if HOST_WORDS_BIG_ENDIAN then
+            L := Res (1);
+            H := Res (0);
+         else
+            L := Res (0);
+            H := Res (1);
+         end if;
+      end if;
+   end To_Host_Wide_Int;
+
+   function To_Real_Value_Type (V : IEEE_Float_64) return REAL_VALUE_TYPE
+   is
+      Mant_Size : constant Natural := 60;
+      Rfract : IEEE_Float_64;
+      Fract : Integer_64;
+      Exp : Integer;
+      L, H : HOST_WIDE_INT;
+      Mantisse : REAL_VALUE_TYPE;
+   begin
+      --  Note: this works only when REAL_ARITHMETIC is defined!!!
+      Exp := IEEE_Float_64'Exponent (V);
+      Rfract := IEEE_Float_64'Fraction (V);
+      Rfract := IEEE_Float_64'Scaling (Rfract, Mant_Size);
+      Fract := Integer_64 (Rfract);
+      To_Host_Wide_Int (Fract, L, H);
+      REAL_VALUE_FROM_INT (Mantisse'Address, L, H, DFmode);
+      return REAL_VALUE_LDEXP (Mantisse, Exp - Mant_Size);
+   end To_Real_Value_Type;
+end Agcc.Autils;
diff --git a/ortho/agcc/agcc-autils.ads b/ortho/agcc/agcc-autils.ads
new file mode 100644
index 000000000..8ca7da446
--- /dev/null
+++ b/ortho/agcc/agcc-autils.ads
@@ -0,0 +1,28 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Real; use Agcc.Real;
+with Interfaces; use Interfaces;
+
+--  Additional utils.
+package Agcc.Autils is
+   procedure To_Host_Wide_Int (V : Unsigned_64; L, H : out HOST_WIDE_INT);
+   procedure To_Host_Wide_Int (V : Integer_64; L, H : out HOST_WIDE_INT);
+   function To_Real_Value_Type (V : IEEE_Float_64) return REAL_VALUE_TYPE;
+end Agcc.Autils;
+
diff --git a/ortho/agcc/agcc-bindings.c b/ortho/agcc/agcc-bindings.c
new file mode 100644
index 000000000..2dbe33b21
--- /dev/null
+++ b/ortho/agcc/agcc-bindings.c
@@ -0,0 +1,738 @@
+/*  Ada bindings for GCC internals - Bindings for Ada.
+    Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+
+    GHDL is free software; you can redistribute it and/or modify it under
+    the terms of the GNU General Public License as published by the Free
+    Software Foundation; either version 2, or (at your option) any later
+    version.
+
+    GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+    WARRANTY; without even the implied warranty of MERCHANTABILITY or
+    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+    for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with GCC; see the file COPYING.  If not, write to the Free
+    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+*/
+#include <stddef.h>
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "tm_p.h"
+#include "defaults.h"
+#include "ggc.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "real.h"
+#include "toplev.h"
+
+enum tree_code
+get_tree_code (tree t)
+{
+  return TREE_CODE (t);
+}
+
+void
+set_tree_constant (tree t, int flag)
+{
+  TREE_CONSTANT (t) = flag;
+}
+
+int
+get_tree_constant (tree t)
+{
+  return TREE_CONSTANT (t);
+}
+
+void
+set_tree_public (tree t, int flag)
+{
+  TREE_PUBLIC (t) = flag;
+}
+
+void
+set_tree_static (tree t, int flag)
+{
+  TREE_STATIC (t) = flag;
+}
+
+void
+set_tree_type (tree t, tree val)
+{
+  TREE_TYPE (t) = val;
+}
+
+tree
+get_tree_type (tree t)
+{
+  return TREE_TYPE (t);
+}
+
+void
+set_tree_chain (tree t, tree chain)
+{
+  TREE_CHAIN (t) = chain;
+}
+
+tree
+get_tree_chain (tree t)
+{
+  return TREE_CHAIN (t);
+}
+
+void
+set_tree_unsigned (tree t, int flag)
+{
+  TREE_UNSIGNED (t) = flag;
+}
+
+int
+get_tree_unsigned (tree t)
+{
+  return TREE_UNSIGNED (t);
+}
+
+void
+set_tree_addressable (tree t, int flag)
+{
+  TREE_ADDRESSABLE (t) = flag;
+}
+
+int
+get_tree_addressable (tree t)
+{
+  return TREE_ADDRESSABLE (t);
+}
+
+void
+set_tree_side_effects (tree t, int flag)
+{
+  TREE_SIDE_EFFECTS (t) = flag;
+}
+
+void
+set_tree_readonly (tree t, int flag)
+{
+  TREE_READONLY (t) = flag;
+}
+
+void
+set_tree_operand (tree t, unsigned int n, tree val)
+{
+  TREE_OPERAND (t, n) = val;
+}
+
+tree
+get_tree_operand (tree t, unsigned int n)
+{
+  return TREE_OPERAND (t, n);
+}
+
+int
+get_tree_this_volatile (tree t)
+{
+  return TREE_THIS_VOLATILE (t);
+}
+
+int
+set_tree_this_volatile (tree t, int val)
+{
+  TREE_THIS_VOLATILE (t) = val;
+}
+
+tree
+get_tree_purpose (tree l)
+{
+  return TREE_PURPOSE (l);
+}
+
+tree
+get_tree_value (tree l)
+{
+  return TREE_VALUE (l);
+}
+
+int
+get_tree_used (tree n)
+{
+  return TREE_USED (n);
+}
+
+void
+set_tree_used (tree n, int flag)
+{
+  TREE_USED (n) = flag;
+}
+
+HOST_WIDE_INT
+get_tree_int_cst_low (tree node)
+{
+  return TREE_INT_CST_LOW (node);
+}
+
+HOST_WIDE_INT
+get_tree_int_cst_high (tree node)
+{
+  return TREE_INT_CST_HIGH (node);
+}
+
+tree
+get_constructor_elts (tree c)
+{
+  return CONSTRUCTOR_ELTS (c);
+}
+
+tree
+(build_int_2) (HOST_WIDE_INT lo, HOST_WIDE_INT hi)
+{
+  return build_int_2 (lo, hi);
+}
+
+void
+set_decl_arg_type (tree decl, tree val)
+{
+  DECL_ARG_TYPE (decl) = val;
+}
+
+void
+set_decl_external (tree decl, int val)
+{
+  DECL_EXTERNAL (decl) = val;
+}
+
+int
+get_decl_external (tree decl)
+{
+  return DECL_EXTERNAL (decl);
+}
+
+void
+set_decl_arguments (tree decl, tree args)
+{
+  DECL_ARGUMENTS (decl) = args;
+}
+
+tree
+get_decl_arguments (tree decl)
+{
+  return DECL_ARGUMENTS (decl);
+}
+
+void
+set_decl_result (tree decl, tree res)
+{
+  DECL_RESULT (decl) = res;
+}
+
+tree
+get_decl_result (tree decl)
+{
+  return DECL_RESULT (decl);
+}
+
+void
+set_decl_context (tree decl, tree context)
+{
+  DECL_CONTEXT (decl) = context;
+}
+
+tree
+get_decl_context (tree decl)
+{
+  return DECL_CONTEXT (decl);
+}
+
+void
+set_decl_initial (tree decl, tree res)
+{
+  DECL_INITIAL (decl) = res;
+}
+
+tree
+get_decl_initial (tree decl)
+{
+  return DECL_INITIAL (decl);
+}
+
+tree
+get_decl_name (tree decl)
+{
+  return DECL_NAME (decl);
+}
+
+tree
+get_decl_assembler_name (tree decl)
+{
+  return DECL_ASSEMBLER_NAME (decl);
+}
+
+void
+set_DECL_ASSEMBLER_NAME (tree decl, tree name)
+{
+  SET_DECL_ASSEMBLER_NAME (decl, name);
+}
+
+void
+set_decl_built_in_class (tree decl, enum built_in_class class)
+{
+  DECL_BUILT_IN_CLASS (decl) = class;
+}
+
+void
+set_decl_function_code (tree decl, int code)
+{
+  DECL_FUNCTION_CODE (decl) = code;
+}
+
+tree
+get_decl_field_offset (tree decl)
+{
+  return DECL_FIELD_OFFSET (decl);
+}
+
+tree
+get_decl_field_bit_offset (tree decl)
+{
+  return DECL_FIELD_BIT_OFFSET (decl);
+}
+
+int
+integral_type_p (tree type)
+{
+  return INTEGRAL_TYPE_P (type);
+}
+
+void
+set_type_values (tree type, tree values)
+{
+  TYPE_VALUES (type) = values;
+}
+
+void
+set_type_name (tree type, tree name)
+{
+  TYPE_NAME (type) = name;
+}
+
+tree
+get_type_name (tree type)
+{
+  return TYPE_NAME (type);
+}
+
+void
+set_type_min_value (tree type, tree val)
+{
+  TYPE_MIN_VALUE (type) = val;
+}
+
+tree
+get_type_min_value (tree type)
+{
+  return TYPE_MIN_VALUE (type);
+}
+
+void
+set_type_max_value (tree type, tree val)
+{
+  TYPE_MAX_VALUE (type) = val;
+}
+
+tree
+get_type_max_value (tree type)
+{
+  return TYPE_MAX_VALUE (type);
+}
+
+void
+set_type_size (tree type, tree size)
+{
+  TYPE_SIZE (type) = size;
+}
+
+tree
+get_type_size (tree type)
+{
+  return TYPE_SIZE (type);
+}
+
+void
+set_type_precision (tree type, int precision)
+{
+  TYPE_PRECISION (type) = precision;
+}
+
+int
+get_type_precision (tree type)
+{
+  return TYPE_PRECISION (type);
+}
+
+void
+set_type_fields (tree type, tree fields)
+{
+  TYPE_FIELDS (type) = fields;
+}
+
+tree
+get_type_fields (tree type)
+{
+  return TYPE_FIELDS (type);
+}
+
+void
+set_type_stub_decl (tree type, tree decl)
+{
+  TYPE_STUB_DECL (type) = decl;
+}
+
+tree
+get_type_domain (tree type)
+{
+  return TYPE_DOMAIN (type);
+}
+
+void
+set_type_domain (tree type, tree domain)
+{
+  TYPE_DOMAIN (type) = domain;
+}
+
+void *
+get_type_lang_specific (tree node)
+{
+  return TYPE_LANG_SPECIFIC (node);
+}
+
+void
+set_type_lang_specific (tree node, void *val)
+{
+  TYPE_LANG_SPECIFIC (node) = val;
+}
+
+int
+get_type_is_sizetype (tree node)
+{
+  return TYPE_IS_SIZETYPE (node);
+}
+
+void
+set_type_pointer_to (tree node, tree dnode)
+{
+  TYPE_POINTER_TO (node) = dnode;
+}
+
+tree
+get_type_pointer_to (tree node)
+{
+  return TYPE_POINTER_TO (node);
+}
+
+enum machine_mode
+get_type_mode (tree node)
+{
+  return TYPE_MODE (node);
+}
+
+void
+set_type_mode (tree node, enum machine_mode mode)
+{
+  TYPE_MODE (node) = mode;
+}
+
+void
+set_current_function_decl (tree decl)
+{
+  current_function_decl = decl;
+}
+
+tree
+get_current_function_decl (void)
+{
+  return current_function_decl;
+}
+
+int
+double_type_size (void)
+{
+  return DOUBLE_TYPE_SIZE;
+}
+
+int
+bits_per_unit (void)
+{
+  return BITS_PER_UNIT;
+}
+
+tree
+(size_int) (HOST_WIDE_INT number)
+{
+  return size_int (number);
+}
+
+tree
+get_type_size_unit (tree node)
+{
+  return TYPE_SIZE_UNIT (node);
+}
+
+/* For agcc.real:  */
+REAL_VALUE_TYPE
+get_REAL_VALUE_ATOF (const char *s, enum machine_mode mode)
+{
+  return REAL_VALUE_ATOF (s, mode);
+}
+
+REAL_VALUE_TYPE
+get_REAL_VALUE_LDEXP (REAL_VALUE_TYPE x, int n)
+{
+  REAL_VALUE_TYPE res;
+  real_ldexp (&res, &x, n);
+  return res;
+}
+
+void
+get_REAL_VALUE_FROM_INT (REAL_VALUE_TYPE *d, HOST_WIDE_INT l, HOST_WIDE_INT h,
+			 enum machine_mode mode)
+{
+  REAL_VALUE_FROM_INT (*d, l, h, mode);
+}
+
+int
+get_identifier_length (tree node)
+{
+  return IDENTIFIER_LENGTH (node);
+}
+
+const char *
+get_identifier_pointer (tree node)
+{
+  return IDENTIFIER_POINTER (node);
+}
+
+tree
+get_block_supercontext (tree node)
+{
+  return BLOCK_SUPERCONTEXT (node);
+}
+
+void
+set_block_supercontext (tree block, tree sc)
+{
+  BLOCK_SUPERCONTEXT (block) = sc;
+}
+
+void
+set_block_vars (tree block, tree vars)
+{
+  BLOCK_VARS (block) = vars;
+}
+
+const int tree_identifier_size = sizeof (struct tree_identifier);
+
+#if 0
+static void
+ggc_mark_tree_ptr (void *elt)
+{
+  ggc_mark_tree (*(tree *) elt);
+}
+#endif
+
+#undef ggc_mark_tree
+void
+ggc_mark_tree (tree expr)
+{
+  gt_ggc_m_9tree_node (expr);
+}
+
+#if 0
+void
+ggc_add_tree_root (void *base, int nelt)
+{
+  ggc_add_root (base, nelt, sizeof (tree), ggc_mark_tree_ptr);
+}
+#endif
+
+int
+get_mode_bitsize (enum machine_mode mode)
+{
+  return GET_MODE_BITSIZE (mode);
+}
+
+int
+get_errorcount (void)
+{
+  return errorcount;
+}
+
+void
+set_errorcount (int c)
+{
+  errorcount = c;
+}
+
+
+/* Defined in agcc.fe  */
+extern const char language_name[];
+extern bool lang_init (void);
+extern void lang_finish (void);
+extern unsigned int lang_init_options (unsigned int argc, const char **argv);
+extern int lang_handle_option (size_t code, const char *argc, int value);
+extern bool lang_post_options (const char **);
+extern HOST_WIDE_INT lang_get_alias_set (tree t);
+extern bool mark_addressable (tree t);
+
+extern int global_bindings_p (void);
+extern int kept_level_p (void);
+extern tree getdecls (void);
+extern void pushlevel (int);
+extern tree poplevel (int, int, int);
+extern void insert_block (tree);
+extern void set_block (tree);
+extern tree pushdecl (tree);
+
+extern tree type_for_mode (enum machine_mode, int);
+extern tree type_for_size (unsigned int, int);
+extern tree unsigned_type (tree);
+extern tree signed_type (tree);
+extern tree signed_or_unsigned_type (int, tree);
+extern tree truthvalue_conversion (tree);
+extern void lang_parse_file (int);
+
+#undef LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME language_name
+#undef LANG_HOOKS_IDENTIFIER_SIZE
+#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
+#undef LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT lang_init
+#undef LANG_HOOKS_FINISH
+#define LANG_HOOKS_FINISH lang_finish
+#undef LANG_HOOKS_INIT_OPTIONS
+#define LANG_HOOKS_INIT_OPTIONS lang_init_options
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION lang_handle_option
+#undef LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS lang_post_options
+#undef LANG_HOOKS_GET_ALIAS_SET
+#define LANG_HOOKS_GET_ALIAS_SET lang_get_alias_set
+#undef LANG_HOOKS_HONOR_READONLY
+#define LANG_HOOKS_HONOR_READONLY true
+#undef LANG_HOOKS_TRUTHVALUE_CONVERSION
+#define LANG_HOOKS_TRUTHVALUE_CONVERSION truthvalue_conversion
+#undef LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE mark_addressable
+
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE type_for_mode
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE type_for_size
+#undef LANG_HOOKS_SIGNED_TYPE
+#define LANG_HOOKS_SIGNED_TYPE signed_type
+#undef LANG_HOOKS_UNSIGNED_TYPE
+#define LANG_HOOKS_UNSIGNED_TYPE unsigned_type
+#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
+#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE signed_or_unsigned_type
+#undef LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE lang_parse_file
+
+const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+/* Tree code classes.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
+
+const char tree_code_type[] = {
+#include "tree.def"
+  'x'
+};
+#undef DEFTREECODE
+
+/* Table indexed by tree code giving number of expression
+   operands beyond the fixed part of the node structure.
+   Not used for types or decls.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
+
+const unsigned char tree_code_length[] = {
+#include "tree.def"
+  0
+};
+#undef DEFTREECODE
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) NAME,
+const char * const tree_code_name[] = {
+#include "tree.def"
+  "@@dummy"
+};
+#undef DEFTREECODE
+
+union lang_tree_node 
+  GTY((desc ("0"),
+       chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+{
+  union tree_node GTY ((tag ("0"), 
+			desc ("tree_node_structure (&%h)"))) 
+    generic;
+};
+
+struct lang_decl GTY(())
+{
+};
+
+struct lang_type GTY (())
+{
+};
+
+struct language_function GTY (())
+{
+};
+ 
+tree
+c_common_truthvalue_conversion (tree expr)
+{
+  if (TREE_CODE (TREE_TYPE (expr)) == BOOLEAN_TYPE)
+    return expr;
+  if (TREE_CODE (expr) == INTEGER_CST)
+    return integer_zerop (expr) ? integer_zero_node : integer_one_node;
+  
+  abort ();
+}
+
+int
+get_PROMOTE_PROTOTYPES (void)
+{
+  return PROMOTE_PROTOTYPES;
+}
+
+struct binding_level GTY(())
+{
+  tree names;
+  tree blocks;
+  tree block_created_by_back_end;
+  struct binding_level *level_chain;
+};
+
+extern GTY(()) struct binding_level *current_binding_level;
+extern GTY((deletable (""))) struct binding_level *old_binding_level;
+
+struct binding_level *
+alloc_binding_level (void)
+{
+  return (struct binding_level *)ggc_alloc (sizeof (struct binding_level));
+}
+
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD  BITS_PER_WORD
+#endif
+
+extern GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
+
+#include "debug.h"
+#include "gt-vhdl-agcc-bindings.h"
+#include "gtype-vhdl.h"
+
diff --git a/ortho/agcc/agcc-convert.ads b/ortho/agcc/agcc-convert.ads
new file mode 100644
index 000000000..964dd81a6
--- /dev/null
+++ b/ortho/agcc/agcc-convert.ads
@@ -0,0 +1,26 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Trees; use Agcc.Trees;
+
+package Agcc.Convert is
+   function Convert_To_Integer (Atype : Tree; Expr : Tree) return Tree;
+   function Convert_To_Pointer (Atype : Tree; Expr : Tree) return Tree;
+private
+   pragma Import (C, Convert_To_Integer);
+   pragma Import (C, Convert_To_Pointer);
+end Agcc.Convert;
diff --git a/ortho/agcc/agcc-diagnostic.ads b/ortho/agcc/agcc-diagnostic.ads
new file mode 100644
index 000000000..4558896a6
--- /dev/null
+++ b/ortho/agcc/agcc-diagnostic.ads
@@ -0,0 +1,24 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Agcc.Diagnostic is
+   function Get_Errorcount return Integer;
+   procedure Set_Errorcount (Cnt : Integer);
+private
+   pragma Import (C, Get_Errorcount);
+   pragma Import (C, Set_Errorcount);
+end Agcc.Diagnostic;
diff --git a/ortho/agcc/agcc-fe.ads b/ortho/agcc/agcc-fe.ads
new file mode 100644
index 000000000..7c2b11001
--- /dev/null
+++ b/ortho/agcc/agcc-fe.ads
@@ -0,0 +1,238 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Trees; use Agcc.Trees;
+with Agcc.Machmode; use Agcc.Machmode;
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Options; use Agcc.Options;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
+with C; use C;
+
+package Agcc.Fe is
+   --  Subprograms that must be defined by the front-end.
+
+   --  Defined in langhooks.h
+   function Lang_Init_Options (Argc : Integer; Argv : C_String_Array)
+     return Integer;
+
+   --  Front-end function expected by GCC.
+   function Lang_Handle_Option (Code : Opt_Code;
+                                Arg : C_String;
+                                Value : Integer)
+                               return Integer;
+
+   type C_String_Acc is access C_String;
+   pragma Convention (C, C_String_Acc);
+
+   function Lang_Post_Options (Filename : C_String_Acc) return C_Bool;
+
+   function Lang_Init return C_Bool;
+
+   procedure Lang_Finish;
+
+   --procedure Lang_Clear_Binding_Stack;
+
+   --  Return the typed-based alias set for T, which may be an expression
+   --  or a type.  Return -1 if we don't do anything special.
+   --  O means can alias everything.
+   function Lang_Get_Alias_Set (T : Tree) return HOST_WIDE_INT;
+
+   --function Lang_Expand_Constant (N : Tree) return Tree;
+
+   --function Lang_Safe_From_P (Target : Rtx; Exp : Tree) return C_Bool;
+
+   procedure Lang_Parse_File (Debug : C_Bool);
+
+   --  Called by the back-end or by the front-end when the address of EXP
+   --  must be taken.
+   --  This function should found the base object (if any), and mark it as
+   --  addressable (via TREE_ADDRESSABLE).  It may emit a warning if this
+   --  object cannot be addressable (front-end restriction).
+   --  Returns TRUE in case of success, FALSE in case of failure.
+   --  Note that the status is never checked by the back-end.
+   function Mark_Addressable (Exp : Tree) return C_Bool;
+
+   --  Possibly apply default attributes to function FUNC represented by
+   --  a FUNCTION_DECL.
+   procedure Insert_Default_Attributes (Func : Tree);
+
+   --  Lexical scopes.
+   --  Roughly speaking, it is used to mark declarations regions.
+
+   --  Enter in a new lexical scope.  INSIDE should be FALSE (TRUE iff called
+   --  from the inside of the front end, ie from gcc internal code).
+   procedure Pushlevel (Inside : C_Bool);
+
+   --  Add a declaration to the current scope.
+   --  Note: GCC backend expect PUSHDECL to return its argument; however,
+   --  it is only seldom used.  Both forms exist and are aliased with a third
+   --  one which is exported under the C name.
+   --  (Unfortunatly, it is not possible to export the function and to import
+   --   the procedure).
+   procedure Pushdecl (Decl : Tree);
+   function Pushdecl (Decl : Tree) return Tree;
+
+   --  This function has to be defined.
+   function Exported_Pushdecl (Decl : Tree) return Tree;
+
+   --  Get the declarations of the current scope.
+   function Getdecls return Tree;
+
+   procedure Set_Block (Block : Tree);
+
+   -- Return non-zero if we are currently in the global binding level.
+   function Global_Bindings_P return Integer;
+
+   --  Insert BLOCK at the end of the list of subblocks of the
+   --  current binding level.  This is used when a BIND_EXPR is expanded,
+   --  to handle the BLOCK node inside the BIND_EXPR.
+   procedure Insert_Block (Block : Tree);
+
+   --  Exit the current scope.
+   --  FUNCTIONBODY is TRUE iff the scope corresponds to a subprogram scope.
+   --  Used forms (both imported).
+   procedure Poplevel (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool);
+   function Poplevel (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool)
+     return Tree;
+
+   --  Exported form.
+   function Exported_Poplevel
+     (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool)
+     return Tree;
+
+   --  Perform all the initialization steps that are language-specific.
+   --procedure Lang_Init;
+
+   --  Perform all the finalization steps that are language-specific.
+   --procedure Lang_Finish;
+
+   --  Return an integer type with the number of bits of precision given by
+   --  PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
+   --  it is a signed type.
+   function Type_For_Size (Precision : Natural; Unsignedp : C_Bool)
+     return Tree;
+
+   --  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+   --  an unsigned type; otherwise a signed type is returned.
+   function Type_For_Mode (Mode : Machine_Mode; Unsignedp : C_Bool)
+     return Tree;
+
+   --  Return the unsigned version of a TYPE_NODE, a scalar type.
+   function Unsigned_Type (Type_Node : Tree) return Tree;
+
+   --  Return the signed version of a TYPE_NODE, a scalar type.
+   function Signed_Type (Type_Node : Tree) return Tree;
+
+   --  Return a type the same as TYPE except unsigned or signed according to
+   --  UNSIGNEDP.
+   function Signed_Or_Unsigned_Type (Unsignedp : C_Bool; Atype : Tree)
+     return Tree;
+
+   --  Return a definition for a builtin function named NAME and whose data
+   --  type is TYPE.  TYPE should be a function type with argument types.
+   --  FUNCTION_CODE tells later passes how to compile calls to this function.
+   --  See tree.h for its possible values.
+   --
+   --  If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+   --  the name to be called if we can't opencode the function.
+   function Builtin_Function
+     (Name: System.Address;
+      Ftype : Tree;
+      Function_Code : Built_In_Function;
+      Class : Built_In_Class;
+      Library_Name : System.Address)
+     return Tree;
+
+   --  Set debug flag of the parser.
+   procedure Set_Yydebug (Flag : C_Bool);
+
+
+   --  Hooks for print-tree.c:
+   procedure Print_Lang_Decl (File : FILEs; Node : Tree; Indent : natural);
+   procedure Print_Lang_Type (File : FILEs; Node : Tree; Indent : Natural);
+   procedure Print_Lang_Identifier
+     (File : FILEs; Node : Tree; Indent : Natural);
+   procedure Lang_Print_Xnode (File : FILEs; Node : Tree; Indent : Natural);
+
+   --  Print any language-specific compilation statistics.
+   procedure Print_Lang_Statistics;
+
+
+   --  Finish to copy a ..._DECL node (the LANG_DECL_SPECIFIC field).
+   procedure Copy_Lang_Decl (Node : Tree);
+
+   --  Normalize boolean value EXPR.
+   function Truthvalue_Conversion (Expr : Tree) return Tree;
+
+   --  Procedure called in case of sizeof applied to an incomplete type.
+   procedure Incomplete_Type_Error (Value : Tree; Atype : Tree);
+
+   --  This function must be defined in the language-specific files.
+   --  expand_expr calls it to build the cleanup-expression for a TARGET_EXPR.
+   function Maybe_Build_Cleanup (Decl : Tree) return Tree;
+
+   --Language_String : constant Chars;
+   Flag_Traditional : Integer := 0;
+private
+   pragma Export (C, Lang_Init_Options);
+   pragma Export (C, Lang_Handle_Option);
+   pragma Export (C, Lang_Post_Options);
+   pragma Export (C, Lang_Init);
+   pragma Export (C, Lang_Finish);
+   pragma Export (C, Lang_Get_Alias_Set);
+
+   pragma Export (C, Lang_Parse_File);
+
+   pragma Export (C, Mark_Addressable);
+   pragma Export (C, Insert_Default_Attributes);
+
+   pragma Import (C, Pushdecl);
+   pragma Export (C, Exported_Pushdecl, "pushdecl");
+   pragma Export (C, Pushlevel);
+   pragma Export (C, Set_Block);
+   pragma Export (C, Insert_Block);
+   pragma Export (C, Global_Bindings_P);
+   pragma Import (C, Poplevel);
+   pragma Export (C, Exported_Poplevel, "poplevel");
+   pragma Export (C, Getdecls);
+
+   pragma Export (C, Type_For_Size);
+   pragma Export (C, Type_For_Mode);
+   pragma Export (C, Unsigned_Type);
+   pragma Export (C, Signed_Type);
+   pragma Export (C, Signed_Or_Unsigned_Type);
+
+   pragma Export (C, Builtin_Function);
+
+
+   pragma Export (C, Set_Yydebug);
+
+   pragma Export (C, Print_Lang_Decl);
+   pragma Export (C, Print_Lang_Type);
+   pragma Export (C, Print_Lang_Identifier);
+   pragma Export (C, Lang_Print_Xnode);
+
+   pragma Export (C, Print_Lang_Statistics);
+   pragma Export (C, Copy_Lang_Decl);
+
+   pragma Export (C, Truthvalue_Conversion);
+   pragma Export (C, Incomplete_Type_Error);
+   pragma Export (C, Maybe_Build_Cleanup);
+
+   pragma Export (C, Flag_Traditional);
+end Agcc.Fe;
+
diff --git a/ortho/agcc/agcc-ggc.ads b/ortho/agcc/agcc-ggc.ads
new file mode 100644
index 000000000..4892d59b3
--- /dev/null
+++ b/ortho/agcc/agcc-ggc.ads
@@ -0,0 +1,33 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Trees; use Agcc.Trees;
+
+package Agcc.Ggc is
+   procedure Ggc_Add_Root (Base : System.Address;
+                           Nelt : Natural;
+                           Size : Natural;
+                           Func : System.Address);
+
+   procedure Ggc_Add_Tree_Root (Base : System.Address; Nelt : Natural);
+
+   procedure Ggc_Mark_Tree (Expr : Tree);
+private
+   pragma Import (C, Ggc_Add_Root);
+   pragma Import (C, Ggc_Mark_Tree);
+   pragma Import (C, Ggc_Add_Tree_Root);
+end Agcc.Ggc;
diff --git a/ortho/agcc/agcc-ghdl.c b/ortho/agcc/agcc-ghdl.c
new file mode 100644
index 000000000..211d5e093
--- /dev/null
+++ b/ortho/agcc/agcc-ghdl.c
@@ -0,0 +1,658 @@
+/*  Ada bindings for GCC internals.
+    Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+
+    GHDL is free software; you can redistribute it and/or modify it under
+    the terms of the GNU General Public License as published by the Free
+    Software Foundation; either version 2, or (at your option) any later
+    version.
+
+    GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+    WARRANTY; without even the implied warranty of MERCHANTABILITY or
+    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+    for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with GCC; see the file COPYING.  If not, write to the Free
+    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+*/
+#include "config.h"
+#include "system.h"
+#include "tree.h"
+#include "flags.h"
+#include <stdio.h>
+
+#if 0
+const char *const language_string = "ghdl";
+int flag_traditional;
+#endif
+
+/* Convertion from a C string to the corresponding cannonical
+   Ada (GNAT) String.  */
+struct str_template
+{
+  int first;
+  int last;
+};
+
+struct str_fatptr
+{
+  const char *array;
+  struct str_template *tpl;
+};
+
+#if 0
+/* Called by toplev.c, to initialize the parser.  */
+const char *
+init_parse (const char *filename)
+{
+  struct str_template temp1 = {1, strlen (filename)};
+  struct str_fatptr   fp = {filename, &temp1};
+
+  ghdl1__init_parse (fp);
+  return filename;
+}
+#endif
+
+void
+lang_init_options (void)
+{
+  extern int gnat_argc;
+  extern const char **gnat_argv;
+  extern const char *progname;
+
+  /* Initialize ada.command_line.  */
+  gnat_argc = 1;
+  gnat_argv = &progname;
+
+  adainit ();
+}
+
+#if 0
+/* Decode all the language specific options that cannot be decoded by GCC. The
+   option decoding phase of GCC calls this routine on the flags that it cannot
+   decode.  Return 1 if successful, otherwise return 0. */
+
+int
+lang_decode_option (argc, argv)
+     int argc;
+     char **argv;
+{
+  return 0;
+}
+
+void
+lang_print_xnode(file, t, i)
+     FILE *file;
+     tree t;
+     int i;
+{
+     return;
+}
+
+/* Routines Expected by gcc:  */
+
+/* These are used to build types for various sizes.  The code below
+   is a simplified version of that of GNAT.  */
+
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD  BITS_PER_WORD
+#endif
+
+/* This variable keeps a table for types for each precision so that we only
+   allocate each of them once. Signed and unsigned types are kept separate.  */
+static tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
+
+/* Return an integer type with the number of bits of precision given by
+   PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
+   it is a signed type.  */
+
+tree
+type_for_size (precision, unsignedp)
+     unsigned precision;
+     int unsignedp;
+{
+  tree t;
+
+  if (precision <= MAX_BITS_PER_WORD
+      && signed_and_unsigned_types[precision][unsignedp] != 0)
+    return signed_and_unsigned_types[precision][unsignedp];
+
+ if (unsignedp)
+    t = signed_and_unsigned_types[precision][1]
+      = make_unsigned_type (precision);
+  else
+    t = signed_and_unsigned_types[precision][0]
+      = make_signed_type (precision);
+
+  return t;
+}
+
+
+/* Return a data type that has machine mode MODE.  UNSIGNEDP selects
+   an unsigned type; otherwise a signed type is returned.  */
+
+tree
+type_for_mode (mode, unsignedp)
+     enum machine_mode mode;
+     int unsignedp;
+{
+  return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
+}
+
+/* Return the unsigned version of a TYPE_NODE, a scalar type.  */
+
+tree
+unsigned_type (type_node)
+     tree type_node;
+{
+  return type_for_size (TYPE_PRECISION (type_node), 1);
+}
+
+/* Return the signed version of a TYPE_NODE, a scalar type.  */
+
+tree
+signed_type (type_node)
+     tree type_node;
+{
+  return type_for_size (TYPE_PRECISION (type_node), 0);
+}
+
+/* Return a type the same as TYPE except unsigned or signed according to
+   UNSIGNEDP.  */
+
+tree
+signed_or_unsigned_type (unsignedp, type)
+     int unsignedp;
+     tree type;
+{
+  if (! INTEGRAL_TYPE_P (type) || TREE_UNSIGNED (type) == unsignedp)
+    return type;
+  else
+    return type_for_size (TYPE_PRECISION (type), unsignedp);
+}
+
+void
+init_type_for_size (void)
+{
+  ggc_add_tree_root (signed_and_unsigned_types,
+		     sizeof (signed_and_unsigned_types) / sizeof (tree));
+}
+#endif
+
+
+#if 0
+/* These functions and variables deal with binding contours.  We only
+   need these functions for the list of PARM_DECLs, but we leave the
+   functions more general; these are a simplified version of the
+   functions from GNAT.  */
+
+/* For each binding contour we allocate a binding_level structure which records
+   the entities defined or declared in that contour. Contours include:
+
+        the global one
+        one for each subprogram definition
+        one for each compound statement (declare block)
+
+   Binding contours are used to create GCC tree BLOCK nodes.  */
+
+struct binding_level
+{
+  /* A chain of ..._DECL nodes for all variables, constants, functions,
+     parameters and type declarations.  These ..._DECL nodes are chained
+     through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
+     in the reverse of the order supplied to be compatible with the
+     back-end.  */
+  tree names;
+  /* For each level (except the global one), a chain of BLOCK nodes for all
+     the levels that were entered and exited one level down from this one.  */
+  tree blocks;
+  /* The back end may need, for its own internal processing, to create a BLOCK
+     node. This field is set aside for this purpose. If this field is non-null
+     when the level is popped, i.e. when poplevel is invoked, we will use such
+     block instead of creating a new one from the 'names' field, that is the
+     ..._DECL nodes accumulated so far.  Typically the routine 'pushlevel'
+     will be called before setting this field, so that if the front-end had
+     inserted ..._DECL nodes in the current block they will not be lost.   */
+  tree block_created_by_back_end;
+  /* The binding level containing this one (the enclosing binding level). */
+  struct binding_level *level_chain;
+};
+
+/* The binding level currently in effect.  */
+static struct binding_level *current_binding_level = NULL;
+
+/* The outermost binding level. This binding level is created when the
+   compiler is started and it will exist through the entire compilation.  */
+static struct binding_level *global_binding_level;
+
+/* Binding level structures are initialized by copying this one.  */
+static struct binding_level clear_binding_level = {NULL, NULL, NULL, NULL};
+
+/* Return non-zero if we are currently in the global binding level.  */
+
+int
+global_bindings_p ()
+{
+  return current_binding_level == global_binding_level ? -1 : 0;
+}
+
+/* Return the list of declarations in the current level. Note that this list
+   is in reverse order (it has to be so for back-end compatibility).  */
+
+tree
+getdecls ()
+{
+  return current_binding_level->names;
+}
+
+/* Nonzero if the current level needs to have a BLOCK made.  */
+
+int
+kept_level_p ()
+{
+  return (current_binding_level->names != 0);
+}
+
+/* Enter a new binding level. The input parameter is ignored, but has to be
+   specified for back-end compatibility.  */
+
+void
+pushlevel (ignore)
+     int ignore;
+{
+  struct binding_level *newlevel
+    = (struct binding_level *) xmalloc (sizeof (struct binding_level));
+
+  *newlevel = clear_binding_level;
+
+  /* Add this level to the front of the chain (stack) of levels that are
+     active.  */
+  newlevel->level_chain = current_binding_level;
+  current_binding_level = newlevel;
+}
+
+/* Exit a binding level.
+   Pop the level off, and restore the state of the identifier-decl mappings
+   that were in effect when this level was entered.
+
+   If KEEP is nonzero, this level had explicit declarations, so
+   and create a "block" (a BLOCK node) for the level
+   to record its declarations and subblocks for symbol table output.
+
+   If FUNCTIONBODY is nonzero, this level is the body of a function,
+   so create a block as if KEEP were set and also clear out all
+   label names.
+
+   If REVERSE is nonzero, reverse the order of decls before putting
+   them into the BLOCK.  */
+
+tree
+poplevel (keep, reverse, functionbody)
+     int keep;
+     int reverse;
+     int functionbody;
+{
+  /* Points to a BLOCK tree node. This is the BLOCK node construted for the
+     binding level that we are about to exit and which is returned by this
+     routine.  */
+  tree block_node = NULL_TREE;
+  tree decl_chain;
+  tree decl_node;
+  tree subblock_chain = current_binding_level->blocks;
+  tree subblock_node;
+  tree block_created_by_back_end;
+
+  /* Reverse the list of XXXX_DECL nodes if desired.  Note that the ..._DECL
+     nodes chained through the `names' field of current_binding_level are in
+     reverse order except for PARM_DECL node, which are explicitely stored in
+     the right order.  */
+  decl_chain = (reverse) ? nreverse (current_binding_level->names)
+                         : current_binding_level->names;
+
+  block_created_by_back_end = current_binding_level->block_created_by_back_end;
+  if (block_created_by_back_end != 0)
+    {
+      block_node = block_created_by_back_end;
+
+      /* Check if we are about to discard some information that was gathered
+         by the front-end. Nameley check if the back-end created a new block
+         without calling pushlevel first. To understand why things are lost
+         just look at the next case (i.e. no block created by back-end.  */
+      if ((keep || functionbody) && (decl_chain || subblock_chain))
+        abort ();
+    }
+
+  /* If there were any declarations in the current binding level, or if this
+     binding level is a function body, or if there are any nested blocks then
+     create a BLOCK node to record them for the life of this function.  */
+  else if (keep || functionbody)
+    block_node = build_block (keep ? decl_chain : 0, 0, subblock_chain, 0, 0);
+
+  /* Record the BLOCK node just built as the subblock its enclosing scope.  */
+  for (subblock_node = subblock_chain; subblock_node;
+       subblock_node = TREE_CHAIN (subblock_node))
+    BLOCK_SUPERCONTEXT (subblock_node) = block_node;
+
+  /* Clear out the meanings of the local variables of this level.  */
+
+  for (subblock_node = decl_chain; subblock_node;
+       subblock_node = TREE_CHAIN (subblock_node))
+    if (DECL_NAME (subblock_node) != 0)
+      /* If the identifier was used or addressed via a local extern decl,
+         don't forget that fact.   */
+      if (DECL_EXTERNAL (subblock_node))
+        {
+          if (TREE_USED (subblock_node))
+            TREE_USED (DECL_NAME (subblock_node)) = 1;
+          if (TREE_ADDRESSABLE (subblock_node))
+            TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
+        }
+
+  /* Pop the current level.  */
+  current_binding_level = current_binding_level->level_chain;
+
+  if (functionbody)
+    {
+      /* This is the top level block of a function. The ..._DECL chain stored
+         in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
+         leave them in the BLOCK because they are found in the FUNCTION_DECL
+         instead.  */
+      DECL_INITIAL (current_function_decl) = block_node;
+      BLOCK_VARS (block_node) = 0;
+    }
+  else if (block_node)
+    {
+      if (block_created_by_back_end == NULL)
+        current_binding_level->blocks
+          = chainon (current_binding_level->blocks, block_node);
+    }
+
+  /* If we did not make a block for the level just exited, any blocks made for
+     inner levels (since they cannot be recorded as subblocks in that level)
+     must be carried forward so they will later become subblocks of something
+     else.  */
+  else if (subblock_chain)
+    current_binding_level->blocks
+      = chainon (current_binding_level->blocks, subblock_chain);
+  if (block_node)
+    TREE_USED (block_node) = 1;
+
+  return block_node;
+}
+
+/* Insert BLOCK at the end of the list of subblocks of the
+   current binding level.  This is used when a BIND_EXPR is expanded,
+   to handle the BLOCK node inside the BIND_EXPR.  */
+
+void
+insert_block (block)
+     tree block;
+{
+  TREE_USED (block) = 1;
+  current_binding_level->blocks
+    = chainon (current_binding_level->blocks, block);
+}
+
+/* Set the BLOCK node for the innermost scope
+   (the one we are currently in).  */
+
+void
+set_block (block)
+     tree block;
+{
+  current_binding_level->block_created_by_back_end = block;
+}
+
+/* Records a ..._DECL node DECL as belonging to the current lexical scope.
+   Returns the ..._DECL node. */
+
+tree
+pushdecl (decl)
+     tree decl;
+{
+  /* External objects aren't nested, other objects may be.  */
+  if (DECL_EXTERNAL (decl))
+    DECL_CONTEXT (decl) = 0;
+  else
+    DECL_CONTEXT (decl) = current_function_decl;
+
+  /* Put the declaration on the list.  The list of declarations is in reverse
+     order. The list will be reversed later if necessary.  This needs to be
+     this way for compatibility with the back-end.  */
+
+  TREE_CHAIN (decl) = current_binding_level->names;
+  current_binding_level->names = decl;
+
+  /* For the declaration of a type, set its name if it is not already set. */
+
+  if (TREE_CODE (decl) == TYPE_DECL
+      && TYPE_NAME (TREE_TYPE (decl)) == 0)
+    TYPE_NAME (TREE_TYPE (decl)) = decl; /* DECL_NAME (decl); */
+
+  return decl;
+}
+#endif
+
+#ifndef CHAR_TYPE_SIZE
+#define CHAR_TYPE_SIZE BITS_PER_UNIT
+#endif
+
+#ifndef INT_TYPE_SIZE
+#define INT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#undef SIZE_TYPE
+#define SIZE_TYPE "long unsigned int"
+
+#if 0
+/* Create the predefined scalar types such as `integer_type_node' needed
+   in the gcc back-end and initialize the global binding level.  */
+
+void
+init_decl_processing ()
+{
+  tree endlink;
+
+  error_mark_node = make_node (ERROR_MARK);
+  TREE_TYPE (error_mark_node) = error_mark_node;
+
+  initialize_sizetypes ();
+
+  /* The structure `tree_identifier' is the GCC tree data structure that holds
+     IDENTIFIER_NODE nodes. We need to call `set_identifier_size' to tell GCC
+     that we have not added any language specific fields to IDENTIFIER_NODE
+     nodes.  */
+  set_identifier_size (sizeof (struct tree_identifier));
+  lineno = 0;
+
+  /* Make the binding_level structure for global names.  */
+  pushlevel (0);
+  global_binding_level = current_binding_level;
+
+  build_common_tree_nodes (0);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("int"),
+                        integer_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("char"),
+                        char_type_node));
+  set_sizetype (unsigned_type_node);
+  build_common_tree_nodes_2 (0);
+
+}
+#endif
+
+
+#if 0
+/* Perform all the initialization steps that are language-specific.  */
+
+void
+lang_init ()
+{}
+
+/* Perform all the finalization steps that are language-specific.  */
+
+void
+lang_finish ()
+{}
+
+/* Return a short string identifying this language to the debugger.  */
+
+const char *
+lang_identify ()
+{
+  return "vhdl";
+}
+
+/* If DECL has a cleanup, build and return that cleanup here.
+   This is a callback called by expand_expr.  */
+
+tree
+maybe_build_cleanup (decl)
+     tree decl;
+{ return NULL_TREE; }
+
+/* Print an error message for invalid use of an incomplete type.  */
+
+void
+incomplete_type_error (dont_care_1, dont_care_2)
+     tree dont_care_1, dont_care_2;
+{ abort (); }
+
+tree
+truthvalue_conversion (expr)
+     tree expr;
+{ return expr;}
+
+int
+mark_addressable (expr)
+     tree expr;
+{return 0;}
+#endif
+
+#if 0
+/* Print any language-specific compilation statistics.  */
+
+void
+print_lang_statistics ()
+{}
+
+/* Since we don't use the DECL_LANG_SPECIFIC field, this is a no-op.  */
+
+void
+copy_lang_decl (node)
+     tree node;
+{}
+
+/* Hooks for print-tree.c:  */
+
+void
+print_lang_decl (file, node, indent)
+     FILE *file;
+     tree node;
+     int indent;
+{}
+
+void
+print_lang_type (file, node, indent)
+     FILE *file;
+     tree node;
+     int indent;
+{}
+
+void
+print_lang_identifier (file, node, indent)
+     FILE *file;
+     tree node;
+     int indent;
+{}
+#endif
+
+#if 0
+/* Performs whatever initialization steps are needed by the language-dependent
+   lexical analyzer.  */
+
+void
+init_lex ()
+{}
+
+
+/* Sets some debug flags for the parser. It does nothing here.  */
+
+void
+set_yydebug (value)
+     int value;
+{}
+#endif
+
+#if 0
+/* Routine to print parse error message.  */
+void
+yyerror (str)
+     char *str;
+{
+  fprintf (stderr, "%s\n", str);
+}
+#endif
+
+#if 0
+/* Return the typed-based alias set for T, which may be an expression
+   or a type.  Return -1 if we don't do anything special.  */
+
+HOST_WIDE_INT
+lang_get_alias_set (t)
+     tree t ATTRIBUTE_UNUSED;
+{
+  return -1;
+}
+#endif
+
+#if 0
+/* Return a definition for a builtin function named NAME and whose data type
+   is TYPE.  TYPE should be a function type with argument types.
+   FUNCTION_CODE tells later passes how to compile calls to this function.
+   See tree.h for its possible values.
+
+   If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+   the name to be called if we can't opencode the function.  */
+
+tree
+builtin_function (name, type, function_code, class, library_name)
+     const char *name;
+     tree type;
+     int function_code;
+     enum built_in_class class;
+     const char *library_name;
+{
+  tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  if (library_name)
+    DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name);
+  make_decl_rtl (decl, NULL_PTR, 1);
+  pushdecl (decl);
+  DECL_BUILT_IN_CLASS (decl) = class;
+  DECL_FUNCTION_CODE (decl) = function_code;
+  return decl;
+}
+#endif
+
+#if 0
+/* Mark language-specific parts of T for garbage-collection.  */
+
+void
+lang_mark_tree (t)
+     tree t ATTRIBUTE_UNUSED;
+{
+}
+#endif
+
+void
+print_chain (tree t)
+{
+  while (t != NULL)
+    {
+      print_node_brief (stdout, "", t, 0);
+      fprintf (stdout, "\n");
+      t = TREE_CHAIN (t);
+    }
+}
diff --git a/ortho/agcc/agcc-hconfig.ads.in b/ortho/agcc/agcc-hconfig.ads.in
new file mode 100644
index 000000000..3662c953c
--- /dev/null
+++ b/ortho/agcc/agcc-hconfig.ads.in
@@ -0,0 +1,21 @@
+--  Ada bindings for GCC internals. -*- Ada -*-
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Agcc.Hconfig is
+@host_big_endian
+end Agcc.Hconfig;
diff --git a/ortho/agcc/agcc-hwint.ads.in b/ortho/agcc/agcc-hwint.ads.in
new file mode 100644
index 000000000..245f211dc
--- /dev/null
+++ b/ortho/agcc/agcc-hwint.ads.in
@@ -0,0 +1,23 @@
+--  Ada bindings for GCC internals. -*- Ada -*-
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces;
+
+package Agcc.Hwint is
+   pragma Preelaborate (Agcc.Hwint);
+@host_wide_int
+end Agcc.Hwint;
diff --git a/ortho/agcc/agcc-input.ads b/ortho/agcc/agcc-input.ads
new file mode 100644
index 000000000..d7ff5ec5a
--- /dev/null
+++ b/ortho/agcc/agcc-input.ads
@@ -0,0 +1,29 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Agcc.Input is
+   type Location_T is record
+      File : Chars;
+      Line : Integer;
+   end record;
+   pragma Convention (C_Pass_By_Copy, Location_T);
+
+   Input_Location : Location_T;
+   pragma Import (C, Input_Location);
+end Agcc.Input;
+
+
diff --git a/ortho/agcc/agcc-libiberty.ads b/ortho/agcc/agcc-libiberty.ads
new file mode 100644
index 000000000..89784b7e0
--- /dev/null
+++ b/ortho/agcc/agcc-libiberty.ads
@@ -0,0 +1,21 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Agcc.Libiberty is
+   function Xmalloc (Size : Size_T) return Chars;
+   pragma Import (C, Xmalloc);
+end Agcc.Libiberty;
diff --git a/ortho/agcc/agcc-machmode.ads.in b/ortho/agcc/agcc-machmode.ads.in
new file mode 100644
index 000000000..ccc6980ab
--- /dev/null
+++ b/ortho/agcc/agcc-machmode.ads.in
@@ -0,0 +1,35 @@
+--  Ada bindings for GCC internals. -*- Ada -*-
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Agcc.Machmode is
+   pragma Preelaborate (Agcc.Machmode);
+
+   type Machine_Mode is
+     (
+@machmode
+      );
+   pragma Convention (C, Machine_Mode);
+
+   function GET_MODE_BITSIZE (Mode : Machine_Mode) return Natural;
+   Ptr_Mode : Machine_Mode;
+
+private
+   pragma Import (C, GET_MODE_BITSIZE);
+   pragma Import (C, Ptr_Mode);
+end Agcc.Machmode;
+
diff --git a/ortho/agcc/agcc-options.ads.in b/ortho/agcc/agcc-options.ads.in
new file mode 100644
index 000000000..8931edde4
--- /dev/null
+++ b/ortho/agcc/agcc-options.ads.in
@@ -0,0 +1,31 @@
+--  Ada bindings for GCC internals. -*- Ada -*-
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+-- This file is preprocessed by gen_tree to create agcc-options.ads
+
+package Agcc.Options is
+
+@options_CL
+
+   type Opt_Code is
+     (
+@options_OPTs
+     );
+
+   pragma Convention (C, Opt_Code);
+end Agcc.Options;
diff --git a/ortho/agcc/agcc-output.ads b/ortho/agcc/agcc-output.ads
new file mode 100644
index 000000000..6ecab6e33
--- /dev/null
+++ b/ortho/agcc/agcc-output.ads
@@ -0,0 +1,24 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Trees; use Agcc.Trees;
+
+package Agcc.Output is
+   procedure Make_Function_Rtl (Func : Tree);
+private
+   pragma Import (C, Make_Function_Rtl);
+end Agcc.Output;
diff --git a/ortho/agcc/agcc-real.ads.in b/ortho/agcc/agcc-real.ads.in
new file mode 100644
index 000000000..ec6b080bd
--- /dev/null
+++ b/ortho/agcc/agcc-real.ads.in
@@ -0,0 +1,42 @@
+--  Ada bindings for GCC internals. -*- Ada -*-
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Machmode; use Agcc.Machmode;
+
+package Agcc.Real is
+   pragma Preelaborate (Agcc.Real);
+
+   type REAL_VALUE_TYPE is private;
+
+   function REAL_VALUE_ATOF (S : System.Address; M : Machine_Mode)
+     return REAL_VALUE_TYPE;
+
+   function REAL_VALUE_LDEXP (X : REAL_VALUE_TYPE; N : Integer)
+     return REAL_VALUE_TYPE;
+
+   procedure REAL_VALUE_FROM_INT (D : System.Address;
+                                  Lo, Hi : HOST_WIDE_INT;
+                                  Mode : Machine_Mode);
+private
+@real
+   --  FIXME: check about the convention on other machines.
+   pragma Convention (C_Pass_By_Copy, REAL_VALUE_TYPE);
+   pragma Import (C, REAL_VALUE_ATOF, "get_REAL_VALUE_ATOF");
+   pragma Import (C, REAL_VALUE_LDEXP, "get_REAL_VALUE_LDEXP");
+   pragma Import (C, REAL_VALUE_FROM_INT, "get_REAL_VALUE_FROM_INT");
+end Agcc.Real;
diff --git a/ortho/agcc/agcc-rtl.ads b/ortho/agcc/agcc-rtl.ads
new file mode 100644
index 000000000..e45143a8f
--- /dev/null
+++ b/ortho/agcc/agcc-rtl.ads
@@ -0,0 +1,31 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Input; use Agcc.Input;
+with System;
+
+package Agcc.Rtl is
+   --  Defines RTX as an opaque type.
+   type Rtx is new System.Address;
+
+   procedure Emit_Line_Note (Loc : Location_T);
+   function Emit_Line_Note (Loc : Location_T) return Rtx;
+   procedure Emit_Nop;
+private
+   pragma Import (C, Emit_Line_Note);
+   pragma Import (C, Emit_Nop);
+end Agcc.Rtl;
diff --git a/ortho/agcc/agcc-stor_layout.ads b/ortho/agcc/agcc-stor_layout.ads
new file mode 100644
index 000000000..aeaa4d74e
--- /dev/null
+++ b/ortho/agcc/agcc-stor_layout.ads
@@ -0,0 +1,24 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Trees; use Agcc.Trees;
+
+package Agcc.Stor_Layout is
+   procedure Fixup_Unsigned_Type (Atype : Tree);
+private
+   pragma Import (C, Fixup_Unsigned_Type);
+end Agcc.Stor_Layout;
diff --git a/ortho/agcc/agcc-tm.ads.in b/ortho/agcc/agcc-tm.ads.in
new file mode 100644
index 000000000..7fea03cd2
--- /dev/null
+++ b/ortho/agcc/agcc-tm.ads.in
@@ -0,0 +1,37 @@
+--  Ada bindings for GCC internals. -*- Ada -*-
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+--  Definitions about target machine.
+
+package Agcc.Tm is
+   pragma Preelaborate (Agcc.Tm);
+
+   function DOUBLE_TYPE_SIZE return Natural;
+   function LONG_DOUBLE_TYPE_SIZE return Natural;
+   function BITS_PER_UNIT return Natural;
+   function BITS_PER_WORD return Natural;
+   function PROMOTE_PROTOTYPES return C_Bool;
+@tm
+private
+   pragma Import (C, DOUBLE_TYPE_SIZE);
+   pragma Import (C, LONG_DOUBLE_TYPE_SIZE);
+   pragma Import (C, BITS_PER_UNIT);
+   pragma Import (C, BITS_PER_WORD);
+   pragma Import (C, PROMOTE_PROTOTYPES, "get_PROMOTE_PROTOTYPES");
+end Agcc.Tm;
+
diff --git a/ortho/agcc/agcc-toplev.ads b/ortho/agcc/agcc-toplev.ads
new file mode 100644
index 000000000..a816f54f2
--- /dev/null
+++ b/ortho/agcc/agcc-toplev.ads
@@ -0,0 +1,51 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Trees; use Agcc.Trees;
+with System;
+with Agcc.Hwint; use Agcc.Hwint;
+
+package Agcc.Toplev is
+   procedure Rest_Of_Decl_Compilation (Decl : Tree;
+                                       Asmspec : System.Address;
+                                       Top_Level : C_Bool;
+                                       At_End : C_Bool);
+   procedure Rest_Of_Type_Compilation (Decl : Tree; Toplevel : C_Bool);
+   procedure Rest_Of_Compilation (Decl : Tree);
+
+   function Exact_Log2_Wide (X : HOST_WIDE_INT) return Integer;
+   function Floor_Log2_Wide (X : HOST_WIDE_INT) return Integer;
+
+   procedure Error (Msg : System.Address);
+
+   procedure Announce_Function (Func : Tree);
+
+   function Toplev_Main (Argc : Integer; Argv : System.Address)
+     return Integer;
+private
+   pragma Import (C, Rest_Of_Decl_Compilation);
+   pragma Import (C, Rest_Of_Type_Compilation);
+   pragma Import (C, Rest_Of_Compilation);
+
+   pragma Import (C, Exact_Log2_Wide);
+   pragma Import (C, Floor_Log2_Wide);
+
+   pragma Import (C, Error);
+
+   pragma Import (C, Announce_Function);
+   pragma Import (C, Toplev_Main);
+end Agcc.Toplev;
diff --git a/ortho/agcc/agcc-trees.adb b/ortho/agcc/agcc-trees.adb
new file mode 100644
index 000000000..a13aba346
--- /dev/null
+++ b/ortho/agcc/agcc-trees.adb
@@ -0,0 +1,33 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Agcc.Trees is
+   function Build_Int (Low : HOST_WIDE_INT) return Tree is
+   begin
+      if Low < 0 then
+         return Build_Int_2_Wide (Low, -1);
+      else
+         return Build_Int_2_Wide (Low, 0);
+      end if;
+   end Build_Int;
+
+   procedure Expand_Start_Bindings (Flags : Integer) is
+   begin
+      Expand_Start_Bindings_And_Block (Flags, NULL_TREE);
+   end Expand_Start_Bindings;
+
+end Agcc.Trees;
diff --git a/ortho/agcc/agcc-trees.ads.in b/ortho/agcc/agcc-trees.ads.in
new file mode 100644
index 000000000..5eb2d5844
--- /dev/null
+++ b/ortho/agcc/agcc-trees.ads.in
@@ -0,0 +1,514 @@
+--  Ada bindings for GCC internals. -*- Ada -*-
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+-- This file is preprocessed by gen_tree to create agcc-trees.ads
+-- gen_tree adds enumerations from GCC C files.
+
+with System; use System;
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Real; use Agcc.Real;
+with Agcc.Machmode; use Agcc.Machmode;
+
+package Agcc.Trees is
+   --pragma No_Elaboration_Code (Agcc.Trees);
+
+   type Tree is new System.Address;
+
+   NULL_TREE : constant Tree;
+
+   type Tree_Code is
+     (
+@tree_code
+     );
+   pragma Convention (C, Tree_Code);
+
+   type Built_In_Class is
+     (NOT_BUILT_IN, BUILT_IN_FRONTEND, BUILT_IN_MD, BUILT_IN_NORMAL);
+   pragma Convention (C, Built_In_Class);
+
+   type Built_In_Function is
+     (
+@built_in_function
+     );
+   pragma Convention (C, Built_In_Function);
+
+   type Tree_Index is
+     (
+@tree_index
+     );
+
+   type Type_Qual_Type is new Integer;
+@type_qual
+
+   type Global_Trees_Array is array (Tree_Index) of Tree;
+   pragma Convention (C, Global_Trees_Array);
+   Global_Trees : Global_Trees_Array;
+   pragma Import (C, Global_Trees);
+
+   Error_Mark_Node : Tree renames Global_Trees (TI_ERROR_MARK);
+   Void_Type_Node : Tree renames Global_Trees (TI_VOID_TYPE);
+   Ptr_Type_Node : Tree renames Global_Trees (TI_PTR_TYPE);
+   Const_Ptr_Type_Node : Tree renames Global_Trees (TI_CONST_PTR_TYPE);
+   Integer_Zero_Node : Tree renames Global_Trees (TI_INTEGER_ZERO);
+   Integer_One_Node : Tree renames Global_Trees (TI_INTEGER_ONE);
+   Size_Zero_Node : Tree renames Global_Trees (TI_SIZE_ZERO);
+
+   type Size_Type_Kind is
+     (
+@size_type_kind
+      );
+
+   type Sizetype_Tab_Array is array (Size_Type_Kind) of Tree;
+   pragma Convention (C, Sizetype_Tab_Array);
+   Sizetype_Tab : Sizetype_Tab_Array;
+   pragma Import (C, Sizetype_Tab);
+
+   Bitsizetype : Tree renames Sizetype_Tab (TK_BITSIZETYPE);
+   Sizetype : Tree renames Sizetype_Tab (TK_SIZETYPE);
+
+   type Integer_Types_Kind is
+     (
+@integer_types
+      );
+
+   type Integer_Types_Array is array (Integer_Types_Kind) of Tree;
+   pragma Convention (C, Integer_Types_Array);
+   Integer_Types : Integer_Types_Array;
+   pragma Import (C, Integer_Types);
+
+   Integer_Type_Node : Tree renames Integer_Types (itk_int);
+   Unsigned_Type_Node : Tree renames Integer_Types (itk_unsigned_int);
+   Char_Type_Node : Tree renames Integer_Types (itk_char);
+
+   function Build (Code: Tree_Code; T: Tree; O0, O1: Tree) return Tree;
+   function Build (Code: Tree_Code; T: Tree; O0, O1, O2: Tree) return Tree;
+   function Build1 (Code: Tree_Code; T: Tree; O: Tree) return Tree;
+   function Build_Constructor (T : Tree; V : Tree) return Tree;
+   function Build_Block (Vars : Tree;
+                         Tags : Tree;
+                         Subblocks : Tree;
+                         Supercontext : Tree;
+                         Chain : Tree)
+     return Tree;
+   function Build_Decl (Code : Tree_Code; T1 : Tree; T2: Tree) return Tree;
+   function Build_Int_2 (Low, Hi: HOST_WIDE_INT) return Tree;
+   function Build_Int_2_Wide (Low, Hi: HOST_WIDE_INT) return Tree;
+   function Build_Real (Rtype : Tree; D : REAL_VALUE_TYPE) return Tree;
+   function Build_Function_Type (Value_Type : Tree; Arg_Type : Tree)
+     return Tree;
+   function Build_Pointer_Type (Atype : Tree) return Tree;
+   function Get_Identifier (Str : System.Address) return Tree;
+   function Build_String (Len : Integer; Str : System.Address) return Tree;
+   function Build_Index_Type (Max : Tree) return Tree;
+   function Build_Range_Type (Basetype : Tree; Low : Tree; High : Tree)
+     return Tree;
+   function Build_Array_Type (El_Type : Tree; Domain : Tree) return Tree;
+   function Make_Node (Code : Tree_Code) return Tree;
+   function Build_Qualified_Type (Atype : Tree; Qual : Type_Qual_Type)
+     return Tree;
+
+   function Build_Save_Expr (Expr : Tree) return Tree;
+
+   function Make_Signed_Type (Precision : Natural) return Tree;
+   function Make_Unsigned_Type (Precision : Natural) return Tree;
+   procedure Initialize_Sizetypes;
+   procedure Set_Sizetype (Atype : Tree);
+
+   function Host_Integerp (T : Tree; Pos : Integer) return Integer;
+
+   function Chainon (Op1, Op2 : Tree) return Tree;
+   function Listify (Node : Tree) return Tree;
+   function Tree_Cons (Purpose : Tree; Value : Tree; Chain : Tree)
+     return Tree;
+   function Nreverse (Chain : Tree) return Tree;
+   function Build_Tree_List (Purpose : Tree; Value : Tree) return Tree;
+
+   function Size_In_Bytes (Decl : Tree) return Tree;
+   procedure Set_Identifier_Size (Size : Natural);
+
+   function Get_Inner_Reference
+     (Exp : Tree;
+      Pbitsize : Address; --  HOST_WIDE_INT pointer
+      Pbitpos : Address; -- HOST_WIDE_INT pointer
+      Poffset : Address; -- Tree pointer
+      Pmode : Address; -- MACHINE_MODE pointer
+      Punsignedp : Address; -- int pointer
+      Pvolatilep : Address) -- int pointer
+     return Tree;
+
+   Current_Function_Decl : Tree;
+
+   function Integer_Zerop (Expr : Tree) return C_Bool;
+   function Integer_Onep (Expr : Tree) return C_Bool;
+   function Real_Zerop (Expr : Tree) return C_Bool;
+
+   procedure Layout_Type (Atype : Tree);
+   procedure Layout_Decl (Decl : Tree; Align : Natural);
+
+   procedure Expand_Start_Bindings_And_Block (Flags : Integer; Block : Tree);
+   procedure Expand_Start_Bindings (Flags : Integer);
+   procedure Expand_End_Bindings
+     (Vars : Tree; Mark_Ends: C_Bool; Dont_Jump_In : C_Bool);
+
+   procedure Init_Function_Start
+     (Subr : Tree; Filename : Chars; Line : Integer);
+   procedure Expand_Function_Start
+     (Subr : Tree; Parms_Have_Cleanups : C_Bool);
+   procedure Expand_Function_End
+     (Filename : Chars; Line : Integer; End_Bindings : C_Bool);
+   procedure Push_Function_Context;
+   procedure Pop_Function_Context;
+   procedure Put_Var_Into_Stack (Expr : Tree; Rescan : C_Bool);
+   procedure Expand_Null_Return;
+   procedure Expand_Return (Expr : Tree);
+   procedure Expand_Expr_Stmt (Expr : Tree);
+   procedure Expand_Decl (Decl : Tree);
+   procedure Expand_Decl_Init (Decl : Tree);
+
+   function Expand_Exit_Something return Integer;
+
+   --  Conditions (IF).
+   procedure Expand_Start_Cond (Cond : Tree; Has_Exit : C_Bool);
+   procedure Expand_Start_Elseif (Cond : Tree);
+   procedure Expand_Start_Else;
+   procedure Expand_End_Cond;
+
+   --  Loops (FOR, WHILE, DO-WHILE, CONTINUE, EXIT ...)
+   type Nesting is private;
+   Nesting_Null : constant Nesting;
+   function Expand_Start_Loop (Exit_Flag : C_Bool) return Nesting;
+   procedure Expand_Continue_Loop (Which_Loop: Nesting);
+   procedure Expand_End_Loop;
+   function Expand_Start_Loop_Continue_Elsewhere (Exit_Flag : C_Bool)
+     return Nesting;
+   procedure Expand_Loop_Continue_Here;
+   procedure Expand_Exit_Loop (Which_Loop : Nesting);
+   function Expand_Exit_Loop_If_False (Which_Loop : Nesting; Cond : Tree)
+     return Integer;
+
+   --  multibranch (SWITCH).
+   procedure Expand_Start_Case
+     (Exit_Flag : C_Bool; Expr : Tree; Etype : Tree; Printname : Chars);
+   function Pushcase
+     (Value : Tree; Converter : Address; Label : Tree; Duplicate : Address)
+     return Integer;
+   function Pushcase_Range
+     (Low, High : Tree; Converter : Address; Label : Tree; Duplicate : Address)
+     return Integer;
+   function Add_Case_Node (Low, High : Tree; Label : Tree; Duplicate : Address)
+     return Integer;
+   procedure Expand_End_Case_Type (Orig_Index : Tree; Orig_Type : Tree);
+
+   procedure Debug_Tree (T: Tree);
+
+   function Fold (Atree : Tree) return Tree;
+   function Size_Binop (Code : Tree_Code; arg0, Arg1 : Tree) return Tree;
+   function Size_Int (Number : HOST_WIDE_INT) return Tree;
+
+   function Convert (Atype : Tree; Expr : Tree) return Tree;
+
+   --  Create an INTEGER_CST whose value is LOW signed extended to
+   --  2 HOST_WIDE_INT.
+   function Build_Int (Low : HOST_WIDE_INT) return Tree;
+
+   function Get_TREE_CODE (T : Tree) return Tree_Code;
+   procedure Set_TREE_CONSTANT (T : Tree; Val : C_Bool);
+   function Get_TREE_CONSTANT (T : Tree) return C_Bool;
+   procedure Set_TREE_PUBLIC (Decl: Tree; Val : C_Bool);
+   procedure Set_TREE_STATIC (Decl : Tree; Val : C_Bool);
+   procedure Set_TREE_TYPE (Decl : Tree; T : Tree);
+   function Get_TREE_TYPE (Decl : Tree) return Tree;
+   procedure Set_TREE_CHAIN (Decl : Tree; Chain : Tree);
+   function Get_TREE_CHAIN (Decl : Tree) return Tree;
+   procedure Set_TREE_UNSIGNED (Decl : Tree; Val: C_Bool);
+   function Get_TREE_UNSIGNED (Decl : Tree) return C_Bool;
+   procedure Set_TREE_ADDRESSABLE (Decl : Tree; Val: C_Bool);
+   function Get_TREE_ADDRESSABLE (Decl : Tree) return C_Bool;
+   procedure Set_TREE_SIDE_EFFECTS (Decl : Tree; Val: C_Bool);
+   procedure Set_TREE_READONLY (Decl : Tree; Val: C_Bool);
+   procedure Set_TREE_OPERAND (T : Tree; N : Natural; Val : Tree);
+   function Get_TREE_OPERAND (T : Tree; N : Natural) return Tree;
+   procedure Set_TREE_THIS_VOLATILE (T : Tree; Val : C_Bool);
+   function Get_TREE_THIS_VOLATILE (T : Tree) return C_Bool;
+   function Get_TREE_VALUE (Decl : Tree) return Tree;
+   function Get_TREE_PURPOSE (Decl : Tree) return Tree;
+   function Get_TREE_USED (Decl : Tree) return C_Bool;
+   procedure Set_TREE_USED (Decl : Tree; Flag : C_Bool);
+
+   function Get_TREE_INT_CST_LOW (Node : Tree) return HOST_WIDE_INT;
+   function Get_TREE_INT_CST_HIGH (Node : Tree) return HOST_WIDE_INT;
+
+   function Get_CONSTRUCTOR_ELTS (Cons : Tree) return Tree;
+
+   procedure Set_DECL_ARG_TYPE (Decl : Tree; Val : Tree);
+   procedure Set_DECL_EXTERNAL (Decl : Tree; Val : C_Bool);
+   function Get_DECL_EXTERNAL (Decl : Tree) return C_Bool;
+   procedure Set_DECL_ARGUMENTS (Decl : Tree; Args : Tree);
+   function Get_DECL_ARGUMENTS (Decl : Tree) return Tree;
+   procedure Set_DECL_RESULT (Decl : Tree; Res : Tree);
+   function Get_DECL_RESULT (Decl : Tree) return Tree;
+   procedure Set_DECL_CONTEXT (Decl : Tree; Context : Tree);
+   function Get_DECL_CONTEXT (Decl : Tree) return Tree;
+   function Get_DECL_INITIAL (Decl : Tree) return Tree;
+   procedure Set_DECL_INITIAL (Decl : Tree; Init : Tree);
+   function Get_DECL_NAME (Decl : Tree) return Tree;
+   function Get_DECL_ASSEMBLER_NAME (Decl : Tree) return Tree;
+   procedure Set_DECL_ASSEMBLER_NAME (Decl : Tree; Name : Tree);
+   procedure Set_DECL_BUILT_IN_CLASS (Decl : Tree; Class : Built_In_Class);
+   procedure Set_DECL_FUNCTION_CODE (Decl : Tree; Code : Built_In_Function);
+   function Get_DECL_FIELD_OFFSET (Decl : Tree) return Tree;
+   function Get_DECL_FIELD_BIT_OFFSET (Decl : Tree) return Tree;
+
+   procedure Set_TYPE_VALUES (Atype : Tree; Values: Tree);
+   procedure Set_TYPE_NAME (Atype : Tree; Name: Tree);
+   function Get_TYPE_NAME (Atype : Tree) return Tree;
+   procedure Set_TYPE_MIN_VALUE (Atype : Tree; Val: Tree);
+   function Get_TYPE_MIN_VALUE (Atype : Tree) return Tree;
+   procedure Set_TYPE_MAX_VALUE (Atype : Tree; Val: Tree);
+   function Get_TYPE_MAX_VALUE (Atype : Tree) return Tree;
+   procedure Set_TYPE_SIZE (Atype : Tree; Size: Tree);
+   function Get_TYPE_SIZE (Atype : Tree) return Tree;
+   procedure Set_TYPE_PRECISION (Atype : Tree; Precision : Integer);
+   function Get_TYPE_PRECISION (Atype : Tree) return Integer;
+   procedure Set_TYPE_FIELDS (Atype : Tree; Fields : Tree);
+   function Get_TYPE_FIELDS (Atype : Tree) return Tree;
+   procedure Set_TYPE_STUB_DECL (Atype : Tree; Decl : Tree);
+   procedure Set_TYPE_LANG_SPECIFIC (Atype : Tree; Val : System.Address);
+   function Get_TYPE_LANG_SPECIFIC (Atype : Tree) return System.Address;
+   function Get_TYPE_IS_SIZETYPE (Atype : Tree) return C_Bool;
+   function Get_TYPE_DOMAIN (Atype : Tree) return Tree;
+   procedure Set_TYPE_DOMAIN (Atype : Tree; Domain : Tree);
+   function Get_TYPE_SIZE_UNIT (Atype : Tree) return Tree;
+   function Get_TYPE_POINTER_TO (Atype : Tree) return Tree;
+   procedure Set_TYPE_POINTER_TO (Atype : Tree; Dtype : Tree);
+   function INTEGRAL_TYPE_P (Atype : Tree) return C_Bool;
+   procedure Set_TYPE_MODE (Atype : Tree; Mode : Machine_Mode);
+   function Get_TYPE_MODE (Atype : Tree) return Machine_Mode;
+
+   function Get_BLOCK_SUPERCONTEXT (Ablock : Tree) return Tree;
+   procedure Set_BLOCK_SUPERCONTEXT (Ablock : Tree; Sc : Tree);
+   procedure Set_BLOCK_VARS (Ablock : Tree; Vars : Tree);
+
+   function Get_IDENTIFIER_LENGTH (N : Tree) return Integer;
+   function Get_IDENTIFIER_POINTER (N : Tree) return Chars;
+
+   procedure Build_Common_Tree_Nodes (Signed_Char : C_Bool);
+   procedure Build_Common_Tree_Nodes_2 (Short_Double : C_Bool);
+
+   --  Points to the name of the input file from which the current input
+   --  being parsed originally came (before it went into cpp).
+   Input_Filename : Chars;
+
+   Main_Input_Filename : Chars;
+
+   -- Current line number in input file.
+   Lineno : Integer;
+
+   --  sizeof (struct tree_identifier).
+   Tree_Identifier_Size : Natural;
+
+   --  Create DECL_RTL for a declaration for a static or external variable or
+   --  static or external function.
+   procedure Make_Decl_Rtl (Decl : Tree; Asmspec : Chars; Top_Level : C_Bool);
+
+private
+   NULL_TREE : constant Tree := Tree (System.Null_Address);
+
+   type Nesting is new System.Address;
+   Nesting_Null : constant Nesting := Nesting (Null_Address);
+
+   pragma Import (C, Current_Function_Decl);
+   pragma Import (C, Set_Identifier_Size);
+
+   pragma Import (C, Build);
+   pragma Import (C, Build1);
+   pragma Import (C, Build_Constructor);
+   pragma Import (C, Build_Block);
+   pragma Import (C, Build_Decl);
+   pragma Import (C, Build_Int_2);
+   pragma Import (C, Build_Int_2_Wide);
+   pragma Import (C, Build_Real);
+   pragma Import (C, Build_Function_Type);
+   pragma Import (C, Build_Pointer_Type);
+   pragma Import (C, Get_Identifier);
+   pragma Import (C, Build_String);
+   pragma Import (C, Make_Node);
+   pragma Import (C, Build_Index_Type);
+   pragma Import (C, Build_Range_Type);
+   pragma Import (C, Build_Array_Type);
+   pragma Import (C, Build_Qualified_Type);
+   pragma Import (C, Build_Save_Expr, "save_expr");
+
+   pragma Import (C, Make_Signed_Type);
+   pragma Import (C, Make_Unsigned_Type);
+   pragma Import (C, Initialize_Sizetypes);
+   pragma Import (C, Set_Sizetype);
+   pragma Import (C, Host_Integerp);
+
+   pragma Import (C, Chainon);
+   pragma Import (C, Listify);
+   pragma Import (C, Tree_Cons);
+   pragma Import (C, Nreverse);
+   pragma Import (C, Build_Tree_List);
+
+   pragma Import (C, Size_In_Bytes);
+   pragma Import (C, Get_Inner_Reference);
+
+   pragma Import (C, Integer_Zerop);
+   pragma Import (C, Integer_Onep);
+   pragma Import (C, Real_Zerop);
+
+   pragma Import (C, Layout_Type);
+   pragma Import (C, Layout_Decl);
+
+   pragma Import (C, Expand_Start_Bindings_And_Block);
+   pragma Import (C, Expand_End_Bindings);
+
+   pragma Import (C, Init_Function_Start);
+   pragma Import (C, Expand_Function_Start);
+   pragma Import (C, Expand_Function_End);
+   pragma Import (C, Push_Function_Context);
+   pragma Import (C, Pop_Function_Context);
+   pragma Import (C, Put_Var_Into_Stack);
+
+   pragma Import (C, Expand_Null_Return);
+   pragma Import (C, Expand_Return);
+   pragma Import (C, Expand_Expr_Stmt);
+   pragma Import (C, Expand_Decl);
+   pragma Import (C, Expand_Decl_Init);
+
+   pragma Import (C, Expand_Exit_Something);
+
+   pragma Import (C, Expand_Start_Cond);
+   pragma Import (C, Expand_Start_Elseif);
+   pragma Import (C, Expand_Start_Else);
+   pragma Import (C, Expand_End_Cond);
+
+   pragma Import (C, Expand_Start_Loop);
+   pragma Import (C, Expand_Continue_Loop);
+   pragma Import (C, Expand_End_Loop);
+   pragma Import (C, Expand_Start_Loop_Continue_Elsewhere);
+   pragma Import (C, Expand_Loop_Continue_Here);
+   pragma Import (C, Expand_Exit_Loop);
+   pragma Import (C, Expand_Exit_Loop_If_False);
+
+   pragma Import (C, Expand_Start_Case);
+   pragma Import (C, Pushcase);
+   pragma Import (C, Pushcase_Range);
+   pragma Import (C, Add_Case_Node);
+   pragma Import (C, Expand_End_Case_Type);
+
+   pragma Import (C, Debug_Tree);
+
+   pragma Import (C, Fold);
+   pragma Import (C, Size_Binop);
+   pragma Import (C, Size_Int);
+   pragma Import (C, Convert);
+
+   -- Import pragma clauses for C MACROs.
+   pragma Import (C, Get_TREE_CODE);
+   pragma Import (C, Set_TREE_CONSTANT);
+   pragma Import (C, Get_TREE_CONSTANT);
+   pragma Import (C, Set_TREE_PUBLIC);
+   pragma Import (C, Set_TREE_STATIC);
+   pragma Import (C, Set_TREE_TYPE);
+   pragma Import (C, Get_TREE_TYPE);
+   pragma Import (C, Set_TREE_CHAIN);
+   pragma Import (C, Get_TREE_CHAIN);
+   pragma Import (C, Set_TREE_UNSIGNED);
+   pragma Import (C, Get_TREE_UNSIGNED);
+   pragma Import (C, Set_TREE_ADDRESSABLE);
+   pragma Import (C, Get_TREE_ADDRESSABLE);
+   pragma Import (C, Set_TREE_SIDE_EFFECTS);
+   pragma Import (C, Set_TREE_READONLY);
+   pragma Import (C, Get_TREE_OPERAND);
+   pragma Import (C, Set_TREE_OPERAND);
+   pragma Import (C, Get_TREE_THIS_VOLATILE);
+   pragma Import (C, Set_TREE_THIS_VOLATILE);
+   pragma Import (C, Get_TREE_PURPOSE);
+   pragma Import (C, Get_TREE_VALUE);
+   pragma Import (C, Get_TREE_USED);
+   pragma Import (C, Set_TREE_USED);
+
+   pragma Import (C, Get_TREE_INT_CST_LOW);
+   pragma Import (C, Get_TREE_INT_CST_HIGH);
+
+   pragma Import (C, Get_CONSTRUCTOR_ELTS);
+   pragma Import (C, Set_TYPE_VALUES);
+   pragma Import (C, Set_TYPE_NAME);
+   pragma Import (C, Get_TYPE_NAME);
+   pragma Import (C, Set_TYPE_MIN_VALUE);
+   pragma Import (C, Get_TYPE_MIN_VALUE);
+   pragma Import (C, Set_TYPE_MAX_VALUE);
+   pragma Import (C, Get_TYPE_MAX_VALUE);
+   pragma Import (C, Set_TYPE_SIZE);
+   pragma Import (C, Get_TYPE_SIZE);
+   pragma Import (C, Set_TYPE_PRECISION);
+   pragma Import (C, Get_TYPE_PRECISION);
+   pragma Import (C, Set_TYPE_FIELDS);
+   pragma Import (C, Get_TYPE_FIELDS);
+   pragma Import (C, Set_TYPE_STUB_DECL);
+   pragma Import (C, Set_TYPE_LANG_SPECIFIC);
+   pragma Import (C, Get_TYPE_LANG_SPECIFIC);
+   pragma Import (C, Get_TYPE_IS_SIZETYPE);
+   pragma Import (C, Get_TYPE_DOMAIN);
+   pragma Import (C, Set_TYPE_DOMAIN);
+   pragma Import (C, Get_TYPE_POINTER_TO);
+   pragma Import (C, Set_TYPE_POINTER_TO);
+   pragma Import (C, Get_TYPE_SIZE_UNIT);
+   pragma Import (C, INTEGRAL_TYPE_P);
+   pragma Import (C, Set_TYPE_MODE);
+   pragma Import (C, Get_TYPE_MODE);
+
+   pragma Import (C, Set_DECL_ARG_TYPE);
+   pragma Import (C, Set_DECL_EXTERNAL);
+   pragma Import (C, Get_DECL_EXTERNAL);
+   pragma Import (C, Set_DECL_ARGUMENTS);
+   pragma Import (C, Get_DECL_ARGUMENTS);
+   pragma Import (C, Set_DECL_RESULT);
+   pragma Import (C, Get_DECL_RESULT);
+   pragma Import (C, Set_DECL_CONTEXT);
+   pragma Import (C, Get_DECL_CONTEXT);
+   pragma Import (C, Get_DECL_INITIAL);
+   pragma Import (C, Set_DECL_INITIAL);
+   pragma Import (C, Get_DECL_NAME);
+   pragma Import (C, Set_DECL_ASSEMBLER_NAME, "set_DECL_ASSEMBLER_NAME");
+   pragma Import (C, Get_DECL_ASSEMBLER_NAME);
+   pragma Import (C, Set_DECL_BUILT_IN_CLASS);
+   pragma Import (C, Set_DECL_FUNCTION_CODE);
+   pragma Import (C, Get_DECL_FIELD_OFFSET);
+   pragma Import (C, Get_DECL_FIELD_BIT_OFFSET);
+
+   pragma Import (C, Get_BLOCK_SUPERCONTEXT);
+   pragma Import (C, Set_BLOCK_SUPERCONTEXT);
+   pragma Import (C, Set_BLOCK_VARS);
+
+   pragma Import (C, Get_IDENTIFIER_LENGTH);
+   pragma Import (C, Get_IDENTIFIER_POINTER);
+
+   pragma Import (C, Build_Common_Tree_Nodes);
+   pragma Import (C, Build_Common_Tree_Nodes_2);
+
+   pragma Import (C, Input_Filename);
+   pragma Import (C, Main_Input_Filename);
+   pragma Import (C, Lineno);
+
+   pragma Import (C, Tree_Identifier_Size);
+
+   pragma Import (C, Make_Decl_Rtl);
+end Agcc.Trees;
diff --git a/ortho/agcc/agcc.adb b/ortho/agcc/agcc.adb
new file mode 100644
index 000000000..da2fe437e
--- /dev/null
+++ b/ortho/agcc/agcc.adb
@@ -0,0 +1,23 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Agcc is
+   function "+" (B : C_Bool) return Boolean is
+   begin
+      return B /= C_False;
+   end "+";
+end Agcc;
diff --git a/ortho/agcc/agcc.ads b/ortho/agcc/agcc.ads
new file mode 100644
index 000000000..c21745c03
--- /dev/null
+++ b/ortho/agcc/agcc.ads
@@ -0,0 +1,45 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Interfaces.C;
+
+package Agcc is
+   pragma Pure (Agcc);
+
+   subtype Chars is System.Address;
+   NULL_Chars : Chars renames System.Null_Address;
+
+   Nul : constant Character := Character'Val (0);
+
+   --  Names size_t.
+   type Size_T is new Interfaces.C.size_t;
+
+   --  Ada representation of boolean type in C.
+   --  Never compare with C_TRUE, since in C any value different from 0 is
+   --  considered as true.
+   type C_Bool is new Integer;
+   pragma Convention (C, C_Bool);
+
+   subtype C_Boolean is C_Bool range 0 .. 1;
+
+   C_False : constant C_Bool := 0;
+   C_True : constant C_Bool := 1;
+
+   function "+" (B : C_Bool) return Boolean;
+   pragma Inline ("+");
+end Agcc;
diff --git a/ortho/agcc/agcc.sed b/ortho/agcc/agcc.sed
new file mode 100644
index 000000000..9252e4a45
--- /dev/null
+++ b/ortho/agcc/agcc.sed
@@ -0,0 +1,23 @@
+# SED script used to extract lines enclosed in /* BEGIN ... END  */ of a
+# gnatbind C generated files.
+# Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+
+# If the current line starts with /* BEGIN, read next line and go to keep.
+\@/* BEGIN@ {
+ n
+ b keep
+}
+# The current line is discarded, and a the cycle is restarted.
+d
+
+# keep the lines.
+: keep
+# If the current line starts with END, then it is removed and a new cycle is
+# started.
+\@  END@ d
+# Print the current line
+p
+# Read the next line
+n
+# Go to keep.
+b keep
diff --git a/ortho/agcc/c.adb b/ortho/agcc/c.adb
new file mode 100644
index 000000000..1b8863600
--- /dev/null
+++ b/ortho/agcc/c.adb
@@ -0,0 +1,55 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+with System;
+
+package body C is
+   function C_String_Len (Str : C_String) return Natural is
+   begin
+      if Str = null then
+         return 0;
+      end if;
+      for I in Str'Range loop
+         if Str (I) = Character'Val (0) then
+            return I - 1;
+         end if;
+      end loop;
+      raise Program_Error;
+   end C_String_Len;
+
+   function Image (Str : C_Str_Len) return String is
+   begin
+      if Str.Str = null then
+         return ''' & Character'Val (Str.Len) & ''';
+      else
+         return Str.Str (1 .. Str.Len);
+      end if;
+   end Image;
+
+   function To_C_String (Acc : access String) return C_String
+   is
+      function Unchecked_Conversion is new Ada.Unchecked_Conversion
+        (Source => System.Address, Target => C_String);
+   begin
+      --  Check ACC is nul-terminated.
+      if Acc (Acc.all'Last) /= Character'Val (0) then
+         raise Program_Error;
+      end if;
+      return Unchecked_Conversion (Acc (Acc.all'First)'Address);
+   end To_C_String;
+end C;
diff --git a/ortho/agcc/c.ads b/ortho/agcc/c.ads
new file mode 100644
index 000000000..01ff03078
--- /dev/null
+++ b/ortho/agcc/c.ads
@@ -0,0 +1,64 @@
+--  Ada bindings for GCC internals.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+with System;
+
+package C is
+   pragma Preelaborate (C);
+
+   --  Representation of a C String: this is an access to a bounded string.
+   --  Therefore, with GNAT, such an access is a thin pointer.
+   subtype Fat_C_String is String (Positive);
+   type C_String is access all Fat_C_String;
+   pragma Convention (C, C_String);
+
+   --  Convert an address to a C_STRING.
+   function To_C_String is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => C_String);
+
+   --  NULL for a string.
+   C_String_Null : constant C_String;
+
+   --  Convert an Ada access string to a C_String.
+   --  This simply takes the address of the first character of ACC.  This
+   --  is unchecked, so be careful with the life of ACC.
+   --  The last element of the string designated by ACC must be the NUL-char.
+   --  This is a little bit more restrictive than being only NUL-terminated.
+   function To_C_String (Acc : access String) return C_String;
+
+   --  Return the length of a C String (ie, the number of characters before
+   --  the Nul).
+   function C_String_Len (Str : C_String) return Natural;
+
+   --  An (very large) array of C String.  This is the type of ARGV.
+   type C_String_Array is array (Natural) of C_String;
+   pragma Convention (C, C_String_Array);
+
+   --  A structure for a string (len and address).
+   type C_Str_Len is record
+      Len : Natural;
+      Str : C_String;
+   end record;
+   pragma Convention (C_Pass_By_Copy, C_Str_Len);
+
+   type C_Str_Len_Acc is access C_Str_Len;
+
+   function Image (Str : C_Str_Len) return String;
+private
+   C_String_Null : constant C_String := null;
+end C;
diff --git a/ortho/agcc/gen_tree.c b/ortho/agcc/gen_tree.c
new file mode 100644
index 000000000..ff826b408
--- /dev/null
+++ b/ortho/agcc/gen_tree.c
@@ -0,0 +1,575 @@
+/*  Ada bindings for GCC internals - generate Ada files.
+    Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+
+    GHDL is free software; you can redistribute it and/or modify it under
+    the terms of the GNU General Public License as published by the Free
+    Software Foundation; either version 2, or (at your option) any later
+    version.
+
+    GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+    WARRANTY; without even the implied warranty of MERCHANTABILITY or
+    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+    for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with GCC; see the file COPYING.  If not, write to the Free
+    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+*/
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "flags.h"
+#include "tree.h"
+#include "real.h"
+#include "options.h"
+#undef abort
+
+static const char *progname;
+
+/* Taken from tree.h.  */
+
+
+#define XSTR(X) #X
+#define STR(X) XSTR(X)
+static const char *treecode_sym[] =
+{
+#define DEFTREECODE(SYM, STRING, TYPE, NARGS)   #SYM,
+#include "tree.def"
+#undef DEFTREECODE
+  NULL
+};
+
+static const char *treecode_string[] =
+{
+#define DEFTREECODE(SYM, STRING, TYPE, NARGS)   STRING,
+#include "tree.def"
+#undef DEFTREECODE
+  NULL
+};
+
+void
+gen_tree_code (void)
+{
+  int i, j;
+  size_t len;
+  const size_t indent = 24;
+
+  for (i = 0; treecode_sym[i] != NULL; i++)
+    {
+      len = strlen (treecode_sym[i]);
+      printf ("      %s, ", treecode_sym[i]);
+      for (j = len; j < indent; j++)
+        putchar (' ');
+      printf ("-- %s\n", treecode_string[i]);
+    }
+  printf ("      LAST_AND_UNUSED_TREE_CODE\n");
+}
+
+static const char *built_in_function_sym[] =
+{
+#if 0
+#define DEF_BUILTIN(x) #x,
+#else
+#define DEF_BUILTIN(ENUM, N, C, T, LT, B, F, NA, ATTR, IMP) #ENUM,
+#endif
+#include "builtins.def"
+#undef DEF_BUILTIN
+  NULL
+};
+
+static void
+print_underscore (const char *sym)
+{
+  for (; *sym != 0; sym++)
+    {
+      if (sym[0] == '_' && (sym[1] == '_' || sym[1] == 0))
+	fputs ("_u", stdout);
+      else
+	fputc (sym[0], stdout);
+    }
+}
+
+void
+gen_built_in_function (void)
+{
+  int i;
+  
+  for (i = 0; built_in_function_sym[i] != NULL; i++)
+    {
+      fputs ("      ", stdout);
+      print_underscore (built_in_function_sym[i]);
+      fputs (",\n", stdout);
+    }
+
+  printf ("      END_BUILTINS\n");
+}
+
+#if 0
+static const char *machmode_sym[] =
+{
+#if 0
+#define DEF_MACHMODE(SYM, NAME, TYPE, BITSIZE, SIZE, UNIT, WIDER)  #SYM,
+#else
+#define DEF_MACHMODE(SYM, NAME, TYPE, BITSIZE, SIZE, UNIT, WIDER, INNER) \
+  #SYM,
+#endif
+#include "machmode.def"
+#undef DEF_MACHMODE
+  NULL
+};
+#endif
+
+static void
+gen_machmode (void)
+{
+  int i;
+  char line[128];
+  FILE *f;
+  int do_emit;
+  char *p;
+
+  f = fopen ("insn-modes.h", "r");
+  if (f == NULL)
+    {
+      fprintf (stderr, "cannot open insn-modes\n");
+      exit (1);
+    }
+
+  do_emit = 0;
+  while (1)
+    {
+      if (fgets (line, sizeof (line), f) == NULL)
+	break;
+      if (!do_emit)
+	{
+	  if (strncmp (line, "enum machine_mode", 17) == 0)
+	    do_emit = 1;
+	}
+      else if (memcmp (line, "  MAX_MACHINE_MODE,", 19) == 0)
+	{
+	  fclose (f);
+	  break;
+	}
+      else	  
+	{
+	  /* Search for "  [A-Z0-9_]*mode,".  */
+	  p = line;
+	  if (p[0] != ' ' || p[1] != ' ')
+	    continue;
+	  p += 2;
+	  while ((*p >= 'A' && *p <= 'Z')
+		 || (*p >= '0' && *p <= '9')
+		 || (*p == '_'))
+	    p++;
+	  if (memcmp (p, "mode,", 5) == 0)
+	    {
+	      p[4] = 0;
+	      printf ("      %s,\n", line + 2);
+	    }
+	}
+
+    }
+  printf ("      MAX_MACHINE_MODE\n");
+}
+
+static void
+gen_options_CL (void)
+{
+  printf ("   CL_C : constant Integer := %d;\n", CL_C);
+  printf ("   CL_vhdl : constant Integer := %d;\n", CL_vhdl);
+}
+
+static void
+gen_options_OPTs (void)
+{
+  char line[128];
+  FILE *f;
+  int do_emit;
+  char *p;
+
+  f = fopen ("options.h", "r");
+  if (f == NULL)
+    {
+      fprintf (stderr, "cannot open options.h\n");
+      exit (1);
+    }
+
+  do_emit = 0;
+  while (1)
+    {
+      if (fgets (line, sizeof (line), f) == NULL)
+	break;
+      if (!do_emit)
+	{
+	  if (strncmp (line, "enum opt_code", 13) == 0)
+	    do_emit = 1;
+	}
+      else if (memcmp (line, "  N_OPTS", 9) == 0)
+	{
+	  fclose (f);
+	  break;
+	}
+      else	  
+	{
+	  /* Search for "  [A-Z0-9]*mode,".  */
+	  p = line;
+	  if (memcmp (p, "  OPT_", 6) != 0)
+	    continue;
+	  printf ("      OPT");
+	  for (p = line + 5; *p != ','; p++)
+	    {
+	      if (p[0] == '_' && (p[1] == ',' || p[1] == '_'))
+		fputs ("_U", stdout);
+	      else
+		{
+		  if (p[0] >= 'A' && p[0] <= 'Z')
+		    putchar ('U');
+		  putchar (p[0]);
+		}
+	    }
+	  printf (",\n");
+	}
+
+    }
+  printf ("       N_OPTS\n");
+}
+
+struct xtab_t
+{
+  int val;
+  const char *name;
+};
+
+void
+gen_enumeration (const struct xtab_t *xtab, int max, const char *max_name)
+{
+  int i;
+
+  for (i = 0; i < max; i++)
+    {
+      const struct xtab_t *t;
+
+      for (t = xtab; t->name; t++)
+        if (t->val == i)
+          break;
+
+      if (t->name == NULL)
+        {
+          fprintf (stderr, "gen_enumeration: kind %d unknown (max is %s)\n",
+		   i, max_name);
+          exit (1);
+        }
+
+      printf ("       %s,\n", t->name);
+    }
+  printf ("      %s\n", max_name);
+}
+
+const struct xtab_t size_type_names[] =
+{
+  { SIZETYPE, "TK_SIZETYPE" },
+  { SSIZETYPE, "TK_SSIZETYPE" },
+  { USIZETYPE, "TK_USIZETYPE" },
+  { BITSIZETYPE, "TK_BITSIZETYPE" },
+  { SBITSIZETYPE, "TK_SBITSIZETYPE" },
+  { UBITSIZETYPE, "TK_UBITSIZETYPE" },
+  { 0, NULL}
+};
+
+static void
+gen_size_type (void)
+{
+  gen_enumeration (size_type_names, TYPE_KIND_LAST, "TYPE_KIND_LAST");
+}
+
+
+const struct xtab_t type_qual_tab[] =
+{
+  { TYPE_UNQUALIFIED, "TYPE_UNQUALIFIED" },
+  { TYPE_QUAL_CONST, "TYPE_QUAL_CONST" },
+  { TYPE_QUAL_VOLATILE, "TYPE_QUAL_VOLATILE" },
+  { TYPE_QUAL_RESTRICT, "TYPE_QUAL_RESTRICT" },
+  { 0, NULL}
+};
+
+void
+gen_type_qual (void)
+{
+  const struct xtab_t *t;
+  for (t = type_qual_tab; t->name; t++)
+    printf ("   %s : constant Type_Qual_Type := %d;\n", t->name, t->val);
+}
+
+const struct xtab_t tree_index_tab[] =
+{
+  /* Defined in tree.h  */
+  { TI_ERROR_MARK, "TI_ERROR_MARK" },
+  { TI_INTQI_TYPE, "TI_INTQI_TYPE" },
+  { TI_INTHI_TYPE, "TI_INTHI_TYPE" },
+  { TI_INTSI_TYPE, "TI_INTSI_TYPE" },
+  { TI_INTDI_TYPE, "TI_INTDI_TYPE" },
+  { TI_INTTI_TYPE, "TI_INTTI_TYPE" },
+
+  { TI_UINTQI_TYPE, "TI_UINTQI_TYPE" },
+  { TI_UINTHI_TYPE, "TI_UINTHI_TYPE" },
+  { TI_UINTSI_TYPE, "TI_UINTSI_TYPE" },
+  { TI_UINTDI_TYPE, "TI_UINTDI_TYPE" },
+  { TI_UINTTI_TYPE, "TI_UINTTI_TYPE" },
+
+  { TI_INTEGER_ZERO, "TI_INTEGER_ZERO" },
+  { TI_INTEGER_ONE, "TI_INTEGER_ONE" },
+  { TI_INTEGER_MINUS_ONE, "TI_INTEGER_MINUS_ONE" },
+  { TI_NULL_POINTER, "TI_NULL_POINTER" },
+
+  { TI_SIZE_ZERO, "TI_SIZE_ZERO" },
+  { TI_SIZE_ONE, "TI_SIZE_ONE" },
+
+  { TI_BITSIZE_ZERO, "TI_BITSIZE_ZERO" },
+  { TI_BITSIZE_ONE, "TI_BITSIZE_ONE" },
+  { TI_BITSIZE_UNIT, "TI_BITSIZE_UNIT" },
+
+  { TI_PUBLIC, "TI_PUBLIC" },
+  { TI_PROTECTED, "TI_PROTECTED" },
+  { TI_PRIVATE, "TI_PRIVATE" },
+
+  { TI_BOOLEAN_FALSE, "TI_BOOLEAN_FALSE" },
+  { TI_BOOLEAN_TRUE, "TI_BOOLEAN_TRUE" },
+
+  { TI_COMPLEX_INTEGER_TYPE, "TI_COMPLEX_INTEGER_TYPE" },
+  { TI_COMPLEX_FLOAT_TYPE, "TI_COMPLEX_FLOAT_TYPE" },
+  { TI_COMPLEX_DOUBLE_TYPE, "TI_COMPLEX_DOUBLE_TYPE" },
+  { TI_COMPLEX_LONG_DOUBLE_TYPE, "TI_COMPLEX_LONG_DOUBLE_TYPE" },
+
+  { TI_FLOAT_TYPE, "TI_FLOAT_TYPE" },
+  { TI_DOUBLE_TYPE, "TI_DOUBLE_TYPE" },
+  { TI_LONG_DOUBLE_TYPE, "TI_LONG_DOUBLE_TYPE" },
+
+  { TI_FLOAT_PTR_TYPE, "TI_FLOAT_PTR_TYPE" },
+  { TI_DOUBLE_PTR_TYPE, "TI_DOUBLE_PTR_TYPE" },
+  { TI_LONG_DOUBLE_PTR_TYPE, "TI_LONG_DOUBLE_PTR_TYPE" },
+  { TI_INTEGER_PTR_TYPE, "TI_INTEGER_PTR_TYPE" },
+
+  { TI_VOID_TYPE, "TI_VOID_TYPE" },
+  { TI_PTR_TYPE, "TI_PTR_TYPE" },
+  { TI_CONST_PTR_TYPE, "TI_CONST_PTR_TYPE" },
+  { TI_SIZE_TYPE, "TI_SIZE_TYPE" },
+  { TI_PTRDIFF_TYPE, "TI_PTRDIFF_TYPE" },
+  { TI_VA_LIST_TYPE, "TI_VA_LIST_TYPE" },
+  { TI_BOOLEAN_TYPE, "TI_BOOLEAN_TYPE" },
+
+  { TI_VOID_LIST_NODE, "TI_VOID_LIST_NODE" },
+
+  { TI_UV4SF_TYPE, "TI_UV4SF_TYPE" },
+  { TI_UV4SI_TYPE, "TI_UV4SI_TYPE" },
+  { TI_UV8HI_TYPE, "TI_UV8HI_TYPE" },
+  { TI_UV8QI_TYPE, "TI_UV8QI_TYPE" },
+  { TI_UV4HI_TYPE, "TI_UV4HI_TYPE" },
+  { TI_UV2HI_TYPE, "TI_UV2HI_TYPE" },
+  { TI_UV2SI_TYPE, "TI_UV2SI_TYPE" },
+  { TI_UV2SF_TYPE, "TI_UV2SF_TYPE" },
+  { TI_UV2DI_TYPE, "TI_UV2DI_TYPE" },
+  { TI_UV1DI_TYPE, "TI_UV1DI_TYPE" },
+  { TI_UV16QI_TYPE, "TI_UV16QI_TYPE" },
+
+  { TI_V4SF_TYPE, "TI_V4SF_TYPE" },
+  { TI_V16SF_TYPE, "TI_V16SF_TYPE" },
+  { TI_V4SI_TYPE, "TI_V4SI_TYPE" },
+  { TI_V8HI_TYPE, "TI_V8HI_TYPE" },
+  { TI_V8QI_TYPE, "TI_V8QI_TYPE" },
+  { TI_V4HI_TYPE, "TI_V4HI_TYPE" },
+  { TI_V2HI_TYPE, "TI_V2HI_TYPE" },
+  { TI_V2SI_TYPE, "TI_V2SI_TYPE" },
+  { TI_V2SF_TYPE, "TI_V2SF_TYPE" },
+  { TI_V2DF_TYPE, "TI_V2DF_TYPE" },
+  { TI_V2DI_TYPE, "TI_V2DI_TYPE" },
+  { TI_V1DI_TYPE, "TI_V1DI_TYPE" },
+  { TI_V16QI_TYPE, "TI_V16QI_TYPE" },
+  { TI_V4DF_TYPE, "TI_V4DF_TYPE" },
+
+  { TI_MAIN_IDENTIFIER, "TI_MAIN_IDENTIFIER" },
+
+  { 0, NULL }
+};
+
+const struct xtab_t integer_types_tab[] =
+{
+  { itk_char, "itk_char" },
+  { itk_signed_char, "itk_signed_char" },
+  { itk_unsigned_char, "itk_unsigned_char" },
+  { itk_short, "itk_short" },
+  { itk_unsigned_short, "itk_unsigned_short" },
+  { itk_int, "itk_int" },
+  { itk_unsigned_int, "itk_unsigned_int" },
+  { itk_long, "itk_long" },
+  { itk_unsigned_long, "itk_unsigned_long" },
+  { itk_long_long, "itk_long_long" },
+  { itk_unsigned_long_long, "itk_unsigned_long_long" },
+  { 0, NULL }
+};
+
+
+void
+gen_tree_index (void)
+{
+  gen_enumeration (tree_index_tab, TI_MAX, "TI_MAX");
+}
+
+void
+gen_integer_types (void)
+{
+  gen_enumeration (integer_types_tab, itk_none, "itk_none");
+}
+
+static void
+gen_host_wide_int_decl (void)
+{
+  int l;
+  switch (sizeof (HOST_WIDE_INT))
+    {
+    case 4:
+      l = 32;
+      break;
+    case 8:
+      l = 64;
+      break;
+    default:
+      fprintf (stderr, "%s: cannot handle sizeof (HOST_WIDE_INT) %d\n",
+	       progname, sizeof (HOST_WIDE_INT));
+      exit (1);
+    }
+  printf ("   type HOST_WIDE_INT is new Interfaces.Integer_%d;\n", l);
+  printf ("   type UNSIGNED_HOST_WIDE_INT is new Interfaces.Unsigned_%d;\n",
+	  l);
+}
+
+static void
+gen_host_big_endian (void)
+{
+#ifdef HOST_WORDS_BIG_ENDIAN
+  printf ("   HOST_WORDS_BIG_ENDIAN : constant Boolean := True;\n");
+#else
+  printf ("   HOST_WORDS_BIG_ENDIAN : constant Boolean := False;\n");
+#endif
+}
+
+static void
+gen_real (void)
+{
+  printf ("   type Real_Value_Type_Arr is array (0 .. %d) of HOST_WIDE_INT;\n",
+	  (sizeof (REAL_VALUE_TYPE) / sizeof (HOST_WIDE_INT)) - 1);
+  printf ("   type REAL_VALUE_TYPE is record\n"
+	  "      r : Real_Value_Type_Arr;\n"
+	  "   end record;\n");
+}
+
+static void
+gen_tm (void)
+{
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD  BITS_PER_WORD
+#endif
+  /* This is a constant.  */
+  printf ("   MAX_BITS_PER_WORD : constant Natural := %d;\n",
+	  MAX_BITS_PER_WORD);
+}
+
+int
+main (int argc, char *argv[])
+{
+  FILE *infile;
+  char line[2048];
+  const char *filename;
+  int c;
+
+  progname = argv[0];
+
+  while ((c = getopt (argc, argv, "C:")) != -1)
+    switch (c)
+      {
+      case 'C':
+	chdir (optarg);
+	break;
+      case '?':
+	fprintf (stderr, "%s: unknown option '%s'\n", progname, optopt);
+	exit (1);
+      default:
+	abort ();
+      }
+
+  if (argc - optind != 1)
+    {
+      fprintf (stderr, "usage: %s FILENAME\n", progname);
+      exit (1);
+    }
+  filename = argv[optind];
+  if (strcmp (filename, "-") == 0)
+    infile = stdin;
+  else
+    infile = fopen (filename, "r");
+  if (infile == NULL)
+    {
+      fprintf (stderr, "%s: cannot open %s (%s)\n", progname, filename,
+               strerror (errno));
+      exit (1);
+    }
+#if 0
+#ifdef REAL_IS_NOT_DOUBLE
+  printf ("-- REAL_IS_NOT_DOUBLE is not yet implemented\n");
+  printf ("You loose\n");
+  return 1;
+#endif
+#endif
+  printf ("--  Automatically generated by %s\n", progname);
+  printf ("--    from %s\n", filename);
+  printf ("--  DO NOT EDIT THIS FILE\n");
+
+  while (fgets (line, sizeof (line), infile) != NULL)
+    {
+      if (line[0] != '@')
+        fputs (line, stdout);
+      else
+        {
+          char *p;
+
+          for (p = line + 1; isalpha (*p) || *p == '_'; p++)
+            ;
+          *p = 0;
+
+          if (!strcmp (line, "@tree_code"))
+            gen_tree_code ();
+	  else if (!strcmp (line, "@built_in_function"))
+	    gen_built_in_function ();
+          else if (!strcmp (line, "@size_type_kind"))
+            gen_size_type ();
+          else if (!strcmp (line, "@type_qual"))
+            gen_type_qual ();
+          else if (!strcmp (line, "@host_wide_int"))
+            gen_host_wide_int_decl ();
+          else if (!strcmp (line, "@tree_index"))
+            gen_tree_index ();
+          else if (!strcmp (line, "@integer_types"))
+            gen_integer_types ();
+          else if (!strcmp (line, "@host_big_endian"))
+	    gen_host_big_endian ();
+          else if (!strcmp (line, "@real"))
+	    gen_real ();
+          else if (!strcmp (line, "@machmode"))
+	    gen_machmode ();
+          else if (!strcmp (line, "@tm"))
+	    gen_tm ();
+	  else if (!strcmp (line, "@options_CL"))
+	    gen_options_CL ();
+	  else if (!strcmp (line, "@options_OPTs"))
+	    gen_options_OPTs ();
+          else
+            {
+              fprintf (stderr, "unknown code `%s'\n", line);
+              exit (1);
+            }
+        }
+    }
+  return 0;
+}
diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile
new file mode 100644
index 000000000..9f8b327a8
--- /dev/null
+++ b/ortho/gcc/Makefile
@@ -0,0 +1,50 @@
+#  Makefile of ortho implementation for GCC.
+#  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+#
+#  GHDL is free software; you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free
+#  Software Foundation; either version 2, or (at your option) any later
+#  version.
+#
+#  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#  for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with GCC; see the file COPYING.  If not, write to the Free
+#  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+#  02111-1307, USA.
+ortho_srcdir=..
+orthobe_srcdir=$(ortho_srcdir)/gcc
+agcc_srcdir=$(ortho_srcdir)/agcc
+agcc_objdir=.
+AGCC_GCCSRC_DIR:=$(HOME)/dist/gcc-3.4.3
+AGCC_GCCOBJ_DIR:=$(AGCC_GCCSRC_DIR)-objs
+SED=sed
+
+all: $(ortho_exec)
+
+include $(agcc_srcdir)/Makefile.inc
+
+ORTHO_BASENAME=$(orthobe_srcdir)/ortho_gcc
+ORTHO_PACKAGE=Ortho_Gcc
+
+include $(ortho_srcdir)/Makefile.inc
+
+$(ortho_exec): $(AGCC_DEPS) $(ORTHO_BASENAME).ads force
+	gnatmake -m -o $@ -g -aI$(agcc_srcdir) -aI$(ortho_srcdir) \
+	 -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \
+	 -bargs -E -largs $(AGCC_OBJS) #-static
+
+clean: agcc-clean
+	$(RM) -f *.o *.ali ortho_nodes-main
+	$(RM) b~*.ad? *~
+
+distclean: clean agcc-clean
+
+
+force:
+
+.PHONY: force all clean
+
diff --git a/ortho/gcc/agcc-fe.adb b/ortho/gcc/agcc-fe.adb
new file mode 100644
index 000000000..75ba79549
--- /dev/null
+++ b/ortho/gcc/agcc-fe.adb
@@ -0,0 +1,776 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Deallocation;
+--with Agcc.Ggc; use Agcc.Ggc;
+with Agcc.Tm; use Agcc.Tm;
+with Agcc.Machmode; use Agcc.Machmode;
+with Agcc.Diagnostic;
+with Agcc.Input; use Agcc.Input;
+with Agcc.Options; use Agcc.Options;
+with Ortho_Gcc;
+with Ortho_Gcc_Front; use Ortho_Gcc_Front;
+
+package body Agcc.Fe is
+   File_Name : String_Acc;
+
+   Stdin_Filename : String_Acc := new String'("*stdin*" & Nul);
+
+   function Lang_Init_Options (Argc : Integer; Argv : C_String_Array)
+                              return Integer
+   is
+      pragma Unreferenced (Argc);
+      pragma Unreferenced (Argv);
+   begin
+      return CL_vhdl;
+   end Lang_Init_Options;
+
+   function Lang_Handle_Option (Code : Opt_Code;
+                                Arg : C_String;
+                                Value : Integer)
+     return Integer
+   is
+      pragma Unreferenced (Value);
+      --type String_Acc_Array_Acc is access String_Acc_Array;
+
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Name => String_Acc, Object => String);
+      --procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+      --  (Name => String_Acc_Array_Acc, Object => String_Acc_Array);
+
+      --C_Opt : C_String := Argv (0);
+      --C_Arg : C_String;
+      --Opt : String := C_Opt (1 .. C_String_Len (C_Opt));
+      Res : Natural;
+      Opt : String_Acc;
+      Opt_Arg : String_Acc;
+      Len : Natural;
+   begin
+      if Arg /= C_String_Null then
+         Len := C_String_Len (Arg);
+      else
+         Len := 0;
+      end if;
+      Opt_Arg := null;
+      case Code is
+         when OPT_U_std_U =>
+            Opt := new String'("--std=" & Arg (1 .. Len));
+         when OPT_U_compile_standard =>
+            Opt := new String'("--compile-standard");
+         when OPT_U_bootstrap =>
+            Opt := new String'("--bootstrap");
+         when OPT_U_work_U =>
+            Opt := new String'("--work=" & Arg (1 .. Len));
+         when OPT_U_workdir_U =>
+            Opt := new String'("--workdir=" & Arg (1 .. Len));
+         when OPT_UP =>
+            Opt := new String'("-P" & Arg (1 .. Len));
+         when OPT_U_elab =>
+            Opt := new String'("--elab");
+            Opt_Arg := new String'(Arg (1 .. Len));
+         when OPT_U_anaelab =>
+            Opt := new String'("--anaelab");
+            Opt_Arg := new String'(Arg (1 .. Len));
+         when OPT_l =>
+            Opt := new String'("-l");
+            Opt_Arg := new String'(Arg (1 .. Len));
+         when OPT_c =>
+            Opt := new String'("-c");
+            Opt_Arg := new String'(Arg (1 .. Len));
+         when OPT_U_ghdl  =>
+            Opt := new String'(Arg (1 .. Len));
+         when OPT_U_warn_U  =>
+            Opt := new String'("--warn-" & Arg (1 .. Len));
+         when OPT_U_expect_failure =>
+            Opt := new String'("--expect-failure");
+         when OPT_U_no_vital_checks =>
+            Opt := new String'("--no-vital-checks");
+         when OPT_U_vital_checks =>
+            Opt := new String'("--vital-checks");
+         when OPT_fexplicit =>
+            Opt := new String'("-fexplicit");
+         when OPT_v =>
+            Opt := new String'("-v");
+         when others =>
+            return 0;
+      end case;
+      Res := Ortho_Gcc_Front.Decode_Option (Opt, Opt_Arg);
+      Unchecked_Deallocation (Opt);
+      Unchecked_Deallocation (Opt_Arg);
+      return Res;
+   end Lang_Handle_Option;
+
+   function Lang_Post_Options (Filename : C_String_Acc) return C_Bool
+   is
+      Filename_Len : Natural;
+   begin
+      if Filename.all = C_String_Null then
+         File_Name := null;
+         Filename.all := To_C_String (Stdin_Filename);
+      else
+         Filename_Len := C_String_Len (Filename.all);
+         File_Name := new String'(Filename.all (1 .. Filename_Len));
+      end if;
+
+      --  Run the back-end.
+      return C_False;
+   end Lang_Post_Options;
+
+
+   procedure Lang_Parse_File (Debug : C_Bool)
+   is
+      pragma Unreferenced (Debug);
+   begin
+      if not Ortho_Gcc_Front.Parse (File_Name) then
+         Agcc.Diagnostic.Set_Errorcount (1);
+      end if;
+   end Lang_Parse_File;
+
+   function Lang_Get_Alias_Set (T : Tree) return HOST_WIDE_INT
+   is
+      pragma Unreferenced (T);
+   begin
+      return -1;
+   end Lang_Get_Alias_Set;
+
+   --function Lang_Safe_From_P (Target : Rtx; Exp : Tree) return Boolean;
+
+   function Mark_Addressable (Exp : Tree) return C_Bool
+   is
+      N : Tree;
+      Code : Tree_Code;
+   begin
+      N := Exp;
+      loop
+         Code := Get_TREE_CODE (N);
+         case Code is
+            when VAR_DECL
+              | CONST_DECL
+              | PARM_DECL
+              | RESULT_DECL =>
+               Put_Var_Into_Stack (N, C_True);
+               Set_TREE_ADDRESSABLE (N, C_True);
+               return C_True;
+
+            when COMPONENT_REF
+              | ARRAY_REF =>
+               N := Get_TREE_OPERAND (N, 0);
+
+            when FUNCTION_DECL
+              | CONSTRUCTOR =>
+               Set_TREE_ADDRESSABLE (N, C_True);
+               return C_True;
+
+            when INDIRECT_REF =>
+               return C_True;
+
+            when others =>
+               raise Program_Error;
+         end case;
+      end loop;
+   end Mark_Addressable;
+
+   procedure Insert_Default_Attributes (Func : Tree)
+   is
+      pragma Unreferenced (Func);
+   begin
+      null;
+   end Insert_Default_Attributes;
+
+   --  These functions and variables deal with binding contours.
+
+   --  For each binding contour we allocate a binding_level structure which
+   --  records the entities defined or declared in that contour.
+   --  Contours include:
+   --
+   --     the global one
+   --     one for each subprogram definition
+   --     one for each compound statement (declare block)
+   --
+   --  Binding contours are used to create GCC tree BLOCK nodes.
+
+   --  BE CAREFUL: this structure is also declared in agcc-bindings.c
+   type Binding_Level;
+   type Binding_Level_Acc is access Binding_Level;
+   type Binding_Level is record
+      --  A chain of ..._DECL nodes for all variables, constants, functions,
+      --  parameters and type declarations.  These ..._DECL nodes are chained
+      --  through the TREE_CHAIN field. Note that these ..._DECL nodes are
+      --  stored in the reverse of the order supplied to be compatible with
+      --  the back-end.
+      Names : Tree;
+
+      --  For each level (except the global one), a chain of BLOCK nodes for
+      --  all the levels that were entered and exited one level down from this
+      --  one.
+      Blocks : Tree;
+
+      --  The back end may need, for its own internal processing, to create a
+      --  BLOCK node. This field is set aside for this purpose. If this field
+      --  is non-null when the level is popped, i.e. when poplevel is invoked,
+      --  we will use such block instead of creating a new one from the
+      --  'names' field, that is the ..._DECL nodes accumulated so far.
+      --  Typically the routine 'pushlevel' will be called before setting this
+      --  field, so that if the front-end had inserted ..._DECL nodes in the
+      --  current block they will not be lost.
+      Block_Created_By_Back_End : Tree;
+
+      --  The binding level containing this one (the enclosing binding level).
+      Level_Chain : Binding_Level_Acc;
+   end record;
+   pragma Convention (C, Binding_Level_Acc);
+   pragma Convention (C, Binding_Level);
+
+   --  The binding level currently in effect.
+   Current_Binding_Level : Binding_Level_Acc := null;
+   pragma Export (C, Current_Binding_Level);
+
+   --  The outermost binding level. This binding level is created when the
+   --  compiler is started and it will exist through the entire compilation.
+   Global_Binding_Level : Binding_Level_Acc;
+
+   --  Chain of unused binding levels, since they are never deallocated.
+   Old_Binding_Level : Binding_Level_Acc := null;
+   pragma Export (C, Old_Binding_Level);
+
+   function Alloc_Binding_Level return Binding_Level_Acc;
+   pragma Import (C, Alloc_Binding_Level);
+
+   -- Binding level structures are initialized by copying this one.
+   Clear_Binding_Level : constant Binding_Level :=
+     (Names => NULL_TREE,
+      Blocks => NULL_TREE,
+      Block_Created_By_Back_End => NULL_TREE,
+      Level_Chain => null);
+
+   -- Return non-zero if we are currently in the global binding level.
+   function Global_Bindings_P return Integer is
+   begin
+      if Current_Binding_Level = Global_Binding_Level then
+         return 1;
+      else
+         return 0;
+      end if;
+   end Global_Bindings_P;
+
+   --  Return the list of declarations in the current level. Note that this
+   --  list is in reverse order (it has to be so for back-end compatibility).
+   function Getdecls return Tree is
+   begin
+      return Current_Binding_Level.Names;
+   end Getdecls;
+
+   --  Nonzero if the current level needs to have a BLOCK made.
+--    function Kept_Level_P return Boolean is
+--    begin
+--       return Current_Binding_Level.Names /= NULL_TREE;
+--    end Kept_Level_P;
+
+   --  Enter a new binding level. The input parameter is ignored, but has to
+   --  be specified for back-end compatibility.
+   procedure Pushlevel (Inside : C_Bool)
+   is
+      pragma Unreferenced (Inside);
+      Newlevel : Binding_Level_Acc;
+
+   begin
+      if Old_Binding_Level /= null then
+         Newlevel := Old_Binding_Level;
+         Old_Binding_Level := Old_Binding_Level.Level_Chain;
+      else
+         Newlevel := Alloc_Binding_Level;
+      end if;
+      Newlevel.all := Clear_Binding_Level;
+
+      --  Add this level to the front of the chain (stack) of levels that are
+      --  active.
+      Newlevel.Level_Chain := Current_Binding_Level;
+      Current_Binding_Level := Newlevel;
+   end Pushlevel;
+
+   --  Exit a binding level.
+   --  Pop the level off, and restore the state of the identifier-decl mappings
+   --  that were in effect when this level was entered.
+   --
+   --  If KEEP is nonzero, this level had explicit declarations, so
+   --  and create a "block" (a BLOCK node) for the level
+   --  to record its declarations and subblocks for symbol table output.
+   --
+   --  If FUNCTIONBODY is nonzero, this level is the body of a function,
+   --  so create a block as if KEEP were set and also clear out all
+   --  label names.
+   --
+   --  If REVERSE is nonzero, reverse the order of decls before putting
+   --  them into the BLOCK.
+   function Exported_Poplevel
+     (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool)
+     return Tree
+   is
+      --  Points to a BLOCK tree node. This is the BLOCK node construted for
+      --  the binding level that we are about to exit and which is returned
+      --  by this routine.
+      Block_Node : Tree := NULL_TREE;
+
+      Decl_Chain : Tree;
+      Subblock_Chain : Tree;
+      Subblock_Node : Tree;
+      Block_Created_By_Back_End : Tree;
+
+      N : Tree;
+      Tmp : Binding_Level_Acc;
+   begin
+      Decl_Chain := Current_Binding_Level.Names;
+      Block_Created_By_Back_End :=
+        Current_Binding_Level.Block_Created_By_Back_End;
+      Subblock_Chain := Current_Binding_Level.Blocks;
+
+      --  Pop the current level, and save it on the chain of old binding
+      --  levels.
+      Tmp := Current_Binding_Level;
+      Current_Binding_Level := Tmp.Level_Chain;
+      Tmp.Level_Chain := Old_Binding_Level;
+      Old_Binding_Level := Tmp;
+
+      --  Reverse the list of XXXX_DECL nodes if desired.  Note that
+      --  the ..._DECL nodes chained through the `names' field of
+      --  current_binding_level are in reverse order except for PARM_DECL node,
+      --  which are explicitely stored in the right order.
+      if Revers /= C_False then
+         Decl_Chain := Nreverse (Decl_Chain);
+      end if;
+
+      if Block_Created_By_Back_End /= NULL_TREE then
+         Block_Node := Block_Created_By_Back_End;
+
+         --  Check if we are about to discard some information that was
+         --  gathered by the front-end. Nameley check if the back-end created
+         --  a new block without calling pushlevel first. To understand why
+         --  things are lost just look at the next case (i.e. no block
+         --  created by back-end.  */
+         if (Keep /= C_False or Functionbody /= C_False)
+           and then (Decl_Chain /= NULL_TREE or Subblock_Chain /= NULL_TREE)
+         then
+            raise Program_Error;
+         end if;
+      elsif Keep /= C_False or Functionbody /= C_False then
+         --  If there were any declarations in the current binding level, or if
+         --  this binding level is a function body, or if there are any nested
+         --  blocks then create a BLOCK node to record them for the life of
+         --  this function.
+         if Keep /= C_False then
+            N := Decl_Chain;
+         else
+            N := NULL_TREE;
+         end if;
+         Block_Node := Build_Block
+           (N, NULL_TREE, Subblock_Chain, NULL_TREE, NULL_TREE);
+      end if;
+
+      --  Record the BLOCK node just built as the subblock its enclosing scope.
+      Subblock_Node := Subblock_Chain;
+      while Subblock_Node /= NULL_TREE loop
+         Set_BLOCK_SUPERCONTEXT (Subblock_Node, Block_Node);
+         Subblock_Node := Get_TREE_CHAIN (Subblock_Node);
+      end loop;
+
+      --  Clear out the meanings of the local variables of this level.
+      Subblock_Node := Decl_Chain;
+      while Subblock_Node /= NULL_TREE loop
+
+         if Get_DECL_NAME (Subblock_Node) /= NULL_TREE then
+            --  If the identifier was used or addressed via a local
+            --  extern decl, don't forget that fact.
+            if Get_DECL_EXTERNAL (Subblock_Node) /= C_False then
+               if Get_TREE_USED (Subblock_Node) /= C_False then
+                  Set_TREE_USED (Get_DECL_NAME (Subblock_Node), C_True);
+               end if;
+               if Get_TREE_ADDRESSABLE (Subblock_Node) /= C_False then
+                  Set_TREE_ADDRESSABLE
+                    (Get_DECL_ASSEMBLER_NAME (Subblock_Node), C_True);
+               end if;
+            end if;
+         end if;
+         Subblock_Node := Get_TREE_CHAIN (Subblock_Node);
+      end loop;
+
+      if Functionbody /= C_False then
+         --  This is the top level block of a function. The ..._DECL chain
+         --  stored in BLOCK_VARS are the function's parameters (PARM_DECL
+         --  nodes). Don't leave them in the BLOCK because they are found
+         --  in the FUNCTION_DECL instead.
+         Set_DECL_INITIAL (Current_Function_Decl, Block_Node);
+         Set_BLOCK_VARS (Block_Node, NULL_TREE);
+      elsif Block_Node /= NULL_TREE then
+         if Block_Created_By_Back_End = NULL_TREE then
+            Current_Binding_Level.Blocks
+              := Chainon (Current_Binding_Level.Blocks, Block_Node);
+         end if;
+      elsif Subblock_Chain /= NULL_TREE then
+         --  If we did not make a block for the level just exited, any blocks
+         --  made for inner levels (since they cannot be recorded as subblocks
+         --  in that level) must be carried forward so they will later become
+         --  subblocks of something else.
+         Current_Binding_Level.Blocks
+           := Chainon (Current_Binding_Level.Blocks, Subblock_Chain);
+      end if;
+
+      if Block_Node /= NULL_TREE then
+         Set_TREE_USED (Block_Node, C_True);
+      end if;
+
+      return Block_Node;
+   end Exported_Poplevel;
+
+   --  Insert BLOCK at the end of the list of subblocks of the
+   --  current binding level.  This is used when a BIND_EXPR is expanded,
+   --  to handle the BLOCK node inside the BIND_EXPR.
+   procedure Insert_Block (Block : Tree) is
+   begin
+      Set_TREE_USED (Block, C_True);
+      Current_Binding_Level.Blocks
+        := Chainon (Current_Binding_Level.Blocks, Block);
+   end Insert_Block;
+
+   --  Set the BLOCK node for the innermost scope (the one we are
+   --  currently in).
+   procedure Set_Block (Block : Tree) is
+   begin
+      Current_Binding_Level.Block_Created_By_Back_End := Block;
+   end Set_Block;
+
+   --  Records a ..._DECL node DECL as belonging to the current lexical scope.
+   --  Returns the ..._DECL node.
+   function Exported_Pushdecl (Decl : Tree) return Tree
+   is
+   begin
+      --  External objects aren't nested, other objects may be.
+      if Get_DECL_EXTERNAL (Decl) /= C_False then
+         Set_DECL_CONTEXT (Decl, NULL_TREE);
+      else
+         Set_DECL_CONTEXT (Decl, Current_Function_Decl);
+      end if;
+
+      --  Put the declaration on the list.  The list of declarations is in
+      --  reverse order. The list will be reversed later if necessary.  This
+      --  needs to be this way for compatibility with the back-end.
+      Set_TREE_CHAIN (Decl, Current_Binding_Level.Names);
+      Current_Binding_Level.Names := Decl;
+
+      -- For the declaration of a type, set its name if it is not already set.
+      if Get_TREE_CODE (Decl) = TYPE_DECL
+        and then Get_TYPE_NAME (Get_TREE_TYPE (Decl)) = NULL_TREE
+      then
+         Set_TYPE_NAME (Get_TREE_TYPE (Decl), Decl); -- DECL_NAME (decl);
+      end if;
+
+      return Decl;
+   end Exported_Pushdecl;
+
+   --  This variable keeps a table for types for each precision so that we only
+   --  allocate each of them once. Signed and unsigned types are kept separate.
+   type Signed_And_Unsigned_Types_Array_Type is
+     array (Natural range 0 .. MAX_BITS_PER_WORD, C_Boolean) of Tree;
+   Signed_And_Unsigned_Types : Signed_And_Unsigned_Types_Array_Type :=
+     (others => (others => NULL_TREE));
+   pragma Export (C, Signed_And_Unsigned_Types);
+
+   --  Return an integer type with the number of bits of precision given by
+   --  PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
+   --  it is a signed type.
+   function Type_For_Size (Precision : Natural; Unsignedp : C_Bool)
+     return Tree
+   is
+      T : Tree;
+   begin
+      if Precision <= MAX_BITS_PER_WORD
+        and then Signed_And_Unsigned_Types (Precision, Unsignedp) /= NULL_TREE
+      then
+         return Signed_And_Unsigned_Types (Precision, Unsignedp);
+      end if;
+
+      if Unsignedp /= C_False then
+         T := Make_Unsigned_Type (Precision);
+      else
+         T := Make_Signed_Type (Precision);
+      end if;
+      if Precision <= MAX_BITS_PER_WORD then
+         Signed_And_Unsigned_Types (Precision, Unsignedp) := T;
+      end if;
+      return T;
+   end Type_For_Size;
+
+   --  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+   --  an unsigned type; otherwise a signed type is returned.
+   function Type_For_Mode (Mode : Machine_Mode; Unsignedp : C_Bool)
+     return Tree
+   is
+   begin
+      return Type_For_Size (GET_MODE_BITSIZE (Mode), Unsignedp);
+   end Type_For_Mode;
+
+   --  Return the unsigned version of a TYPE_NODE, a scalar type.
+   function Unsigned_Type (Type_Node : Tree) return Tree
+   is
+   begin
+      return Type_For_Size (Get_TYPE_PRECISION (Type_Node), C_True);
+   end Unsigned_Type;
+
+   --  Return the signed version of a TYPE_NODE, a scalar type.
+   function Signed_Type (Type_Node : Tree) return Tree
+   is
+   begin
+      return Type_For_Size (Get_TYPE_PRECISION (Type_Node), C_False);
+   end Signed_Type;
+
+   --  Return a type the same as TYPE except unsigned or signed according to
+   --  UNSIGNEDP.
+   function Signed_Or_Unsigned_Type (Unsignedp : C_Bool; Atype : Tree)
+     return Tree
+   is
+   begin
+      if INTEGRAL_TYPE_P (Atype) = C_False
+        or else Get_TREE_UNSIGNED (Atype) = Unsignedp
+      then
+         return Atype;
+      else
+         return Type_For_Size (Get_TYPE_PRECISION (Atype), Unsignedp);
+      end if;
+   end Signed_Or_Unsigned_Type;
+
+
+   --procedure Init_Type_For_Size;
+   --pragma Import (C, Init_Type_For_Size);
+
+   Int_Str : constant String := "int" & Nul;
+   Char_Str : constant String := "char" & Nul;
+
+   Builtin_Alloca_Str : constant String := "__builtin_alloca" & Nul;
+
+   function Lang_Init return C_Bool
+   is
+      --File : String renames Filename (1 .. Filename_Len);
+      Ptr_Ftype_Sizetype : Tree;
+      Alloca_Function : Tree;
+   begin
+      --Error_Mark_Node := Make_Node (ERROR_MARK);
+      --Set_TREE_TYPE (Error_Mark_Node, Error_Mark_Node);
+
+      --Initialize_Sizetypes;
+
+      --  The structure `tree_identifier' is the GCC tree data structure that
+      --  holds IDENTIFIER_NODE nodes. We need to call `set_identifier_size'
+      --  to tell GCC that we have not added any language specific fields to
+      --  IDENTIFIER_NODE nodes.
+      --Set_Identifier_Size (Tree_Identifier_Size);
+      Input_Location.Line := 0;
+
+      -- Make the binding_level structure for global names.
+      Pushlevel (C_False);
+      Global_Binding_Level := Current_Binding_Level;
+
+      Build_Common_Tree_Nodes (C_False);
+      Pushdecl (Build_Decl (TYPE_DECL, Get_Identifier (Int_Str'Address),
+                            Integer_Type_Node));
+      Pushdecl (Build_Decl (TYPE_DECL, Get_Identifier (Char_Str'Address),
+                            Char_Type_Node));
+      Set_Sizetype (Unsigned_Type_Node);
+      Build_Common_Tree_Nodes_2 (C_False);
+
+      --Init_Type_For_Size;
+
+      --  Create alloc builtin.
+      Ptr_Ftype_Sizetype := Build_Function_Type
+        (Ptr_Type_Node,
+         Tree_Cons (NULL_TREE, Get_TYPE_DOMAIN (Sizetype), NULL_TREE));
+      Alloca_Function := Builtin_Function
+        (Builtin_Alloca_Str'Address, Ptr_Ftype_Sizetype,
+         BUILT_IN_ALLOCA, BUILT_IN_NORMAL, System.Null_Address);
+      Ortho_Gcc.Alloca_Function_Ptr := Build1
+        (ADDR_EXPR, Build_Pointer_Type (Ptr_Ftype_Sizetype), Alloca_Function);
+--        Ggc_Add_Tree_Root (Ortho_Gcc.Alloca_Function_Ptr'Address, 1);
+
+      Ortho_Gcc.Init;
+
+      --  Continue.
+      return C_True;
+   end Lang_Init;
+
+   procedure Lang_Finish is
+   begin
+      null;
+   end Lang_Finish;
+
+   --  Return a definition for a builtin function named NAME and whose data
+   --  type is TYPE.  TYPE should be a function type with argument types.
+   --  FUNCTION_CODE tells later passes how to compile calls to this function.
+   --  See tree.h for its possible values.
+   --
+   --  If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+   --  the name to be called if we can't opencode the function.
+   function Builtin_Function
+     (Name: System.Address;
+      Ftype : Tree;
+      Function_Code : Built_In_Function;
+      Class : Built_In_Class;
+      Library_Name : System.Address)
+     return Tree
+   is
+      use System;
+      Decl : Tree;
+   begin
+      Decl := Build_Decl (FUNCTION_DECL, Get_Identifier (Name), Ftype);
+      Set_DECL_EXTERNAL (Decl, C_True);
+      Set_TREE_PUBLIC (Decl, C_True);
+      if Library_Name /= Null_Address then
+         Set_DECL_ASSEMBLER_NAME (Decl, Get_Identifier (Library_Name));
+      end if;
+      Make_Decl_Rtl (Decl, NULL_Chars, C_True);
+      Pushdecl (Decl);
+      Set_DECL_BUILT_IN_CLASS (Decl, Class);
+      Set_DECL_FUNCTION_CODE (Decl, Function_Code);
+      return Decl;
+   end Builtin_Function;
+
+   procedure Set_Yydebug (Flag : C_Bool)
+   is
+      pragma Unreferenced (Flag);
+   begin
+      null;
+   end Set_Yydebug;
+
+   procedure Print_Lang_Decl (File : FILEs; Node : Tree; Indent : natural)
+   is
+      pragma Unreferenced (File);
+      pragma Unreferenced (Node);
+      pragma Unreferenced (Indent);
+   begin
+      null;
+   end Print_Lang_Decl;
+
+   procedure Print_Lang_Type (File : FILEs; Node : Tree; Indent : Natural)
+   is
+      pragma Unreferenced (File);
+      pragma Unreferenced (Node);
+      pragma Unreferenced (Indent);
+   begin
+      null;
+   end Print_Lang_Type;
+
+   procedure Print_Lang_Identifier
+     (File : FILEs; Node : Tree; Indent : Natural)
+   is
+      pragma Unreferenced (File);
+      pragma Unreferenced (Node);
+      pragma Unreferenced (Indent);
+   begin
+      null;
+   end Print_Lang_Identifier;
+
+   procedure Lang_Print_Xnode (File : FILEs; Node : Tree; Indent : Natural)
+   is
+      pragma Unreferenced (File);
+      pragma Unreferenced (Node);
+      pragma Unreferenced (Indent);
+   begin
+      --  There is no X nodes.
+      raise Program_Error;
+   end Lang_Print_Xnode;
+
+   procedure Print_Lang_Statistics is
+   begin
+      null;
+   end Print_Lang_Statistics;
+
+   procedure Copy_Lang_Decl (Node : Tree)
+   is
+      pragma Unreferenced (Node);
+   begin
+      null;
+   end Copy_Lang_Decl;
+
+   function Truthvalue_Conversion (Expr : Tree) return Tree
+   is
+      Expr_Type : Tree;
+      type Conv_Array is array (Boolean) of Tree;
+      Conv : Conv_Array;
+   begin
+      Expr_Type := Get_TREE_TYPE (Expr);
+      if Get_TREE_CODE (Expr_Type) /= BOOLEAN_TYPE then
+         Conv := (True => Integer_One_Node,
+                  False => Integer_Zero_Node);
+      else
+         Conv := (False => Get_TYPE_MIN_VALUE (Expr_Type),
+                  True => Get_TYPE_MAX_VALUE (Expr_Type));
+      end if;
+
+      --  From java/decl.c
+      --  It is simpler and generates better code to have only TRUTH_*_EXPR
+      --  or comparison expressions as truth values at this level.
+
+      case Get_TREE_CODE (Expr) is
+         when EQ_EXPR
+           | NE_EXPR
+           | LE_EXPR
+           | GE_EXPR
+           | LT_EXPR
+           | GT_EXPR
+           | TRUTH_ANDIF_EXPR
+           | TRUTH_ORIF_EXPR
+           | TRUTH_AND_EXPR
+           | TRUTH_OR_EXPR
+           | ERROR_MARK =>
+            return Expr;
+
+         when INTEGER_CST =>
+            if Integer_Zerop (Expr) = C_False then
+               --  EXPR is not 0, so EXPR is interpreted as TRUE.
+               return Conv (True);
+            else
+               return Conv (False);
+            end if;
+
+         when REAL_CST =>
+            if Real_Zerop (Expr) = C_False then
+               return Conv (True);
+            else
+               return Conv (False);
+            end if;
+
+         when others =>
+            raise Program_Error;
+      end case;
+   end Truthvalue_Conversion;
+
+   procedure Incomplete_Type_Error (Value : Tree; Atype : Tree)
+   is
+      pragma Unreferenced (Value);
+      pragma Unreferenced (Atype);
+   begin
+      --  Can never happen.
+      raise Program_Error;
+   end Incomplete_Type_Error;
+
+   function Maybe_Build_Cleanup (Decl : Tree) return Tree
+   is
+      pragma Unreferenced (Decl);
+   begin
+      return NULL_TREE;
+   end Maybe_Build_Cleanup;
+
+   Language_Name : constant String := "GNU vhdl" & Nul;
+   pragma Export (C, Language_Name);
+end Agcc.Fe;
diff --git a/ortho/gcc/lang.opt b/ortho/gcc/lang.opt
new file mode 100644
index 000000000..b2f650aa0
--- /dev/null
+++ b/ortho/gcc/lang.opt
@@ -0,0 +1,88 @@
+;  Options for the VHDL front-end.
+;  Copyright (C) 2003, 2004, 2005 Tristan Gingold
+;
+;  GHDL is free software; you can redistribute it and/or modify it under
+;  the terms of the GNU General Public License as published by the Free
+;  Software Foundation; either version 2, or (at your option) any later
+;  version.
+;
+;  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+;  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;  for more details.
+;
+;  You should have received a copy of the GNU General Public License
+;  along with GCC; see the file COPYING.  If not, write to the Free
+;  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+;  02111-1307, USA.
+
+Language
+vhdl
+
+-std=
+vhdl Joined
+Select the vhdl standard
+
+-compile-standard
+vhdl
+Used during compiler build to compile the std.standard package
+
+-bootstrap
+vhdl
+Used during compiler build to compile std packages
+
+-work=
+vhdl Joined
+Set the name of the work library
+
+-workdir=
+vhdl Joined
+Set the directory of the work library
+
+P
+vhdl Joined
+-P<dir>	Add <dir> to the end of the vhdl library path
+
+-elab
+vhdl Separate
+--elab <name>	Used internally during elaboration of <name>
+
+-anaelab
+vhdl Separate
+--anaelab <name>	Used internally during elaboration of <name>
+
+c
+vhdl Separate
+-c <filename>	Analyze <filename> for --anaelab
+
+v
+vhdl
+Verbose
+
+-warn-
+vhdl Joined
+--warn-<name>	Warn about <name>
+
+-ghdl
+vhdl Joined
+--ghdl-<option>	Pass <option> to vhdl front-end
+
+-expect-failure
+vhdl
+Expect a compiler error (used for testsuite)
+
+-no-vital-checks
+vhdl
+Disable VITAL checks
+
+-vital-checks
+vhdl
+Enable VITAL checks
+
+fexplicit
+vhdl
+Explicit functions override implicit functions
+
+l
+vhdl Joined Separate
+-l<filename>	Put list of files for link in <filename>
diff --git a/ortho/gcc/ortho_gcc-main.adb b/ortho/gcc/ortho_gcc-main.adb
new file mode 100644
index 000000000..5ee7a76fc
--- /dev/null
+++ b/ortho/gcc/ortho_gcc-main.adb
@@ -0,0 +1,44 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Ortho_Gcc_Front;
+with Agcc.Toplev;
+with Ada.Command_Line; use Ada.Command_Line;
+
+procedure Ortho_Gcc.Main
+is
+   gnat_argc : Integer;
+   gnat_argv : System.Address;
+   gnat_envp : System.Address;
+
+   pragma Import (C, gnat_argc);
+   pragma Import (C, gnat_argv);
+   pragma Import (C, gnat_envp);
+
+   Status : Exit_Status;
+begin
+   Ortho_Gcc_Front.Init;
+
+   --  Note: GCC set signal handlers...
+   Status := Exit_Status (Agcc.Toplev.Toplev_Main (gnat_argc, gnat_argv));
+   Set_Exit_Status (Status);
+exception
+   when others =>
+      Set_Exit_Status (2);
+      return;
+end Ortho_Gcc.Main;
diff --git a/ortho/gcc/ortho_gcc-main.ads b/ortho/gcc/ortho_gcc-main.ads
new file mode 100644
index 000000000..fd79cf42c
--- /dev/null
+++ b/ortho/gcc/ortho_gcc-main.ads
@@ -0,0 +1,18 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+procedure Ortho_Gcc.Main;
diff --git a/ortho/gcc/ortho_gcc.adb b/ortho/gcc/ortho_gcc.adb
new file mode 100644
index 000000000..66a3f1af0
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.adb
@@ -0,0 +1,1362 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+--with Ada.Unchecked_Conversion;
+with Agcc; use Agcc;
+with Agcc.Hwint; use Agcc.Hwint;
+with Agcc.Toplev; use Agcc.Toplev;
+with Agcc.Tm; use Agcc.Tm;
+with Agcc.Stor_Layout; use Agcc.Stor_Layout;
+with Agcc.Machmode;
+with System;
+with Agcc.Autils; use Agcc.Autils;
+with Agcc.Real; use Agcc.Real;
+with Agcc.Fe; use Agcc.Fe;
+with Agcc.Rtl; use Agcc.Rtl;
+with Agcc.Input; use Agcc.Input;
+with Agcc.Machmode;
+
+package body Ortho_Gcc is
+   type ON_Op_To_Tree_Code_Type is array (ON_Op_Kind) of Tree_Code;
+   ON_Op_To_Tree_Code : constant ON_Op_To_Tree_Code_Type :=
+     (
+      --  Dyadic operations.
+      ON_Add_Ov => PLUS_EXPR,
+      ON_Sub_Ov => MINUS_EXPR,
+      ON_Mul_Ov => MULT_EXPR,
+      ON_Div_Ov => ERROR_MARK,
+      ON_Rem_Ov => TRUNC_MOD_EXPR,
+      ON_Mod_Ov => FLOOR_MOD_EXPR,
+
+      --  Binary operations.
+      ON_And => TRUTH_AND_EXPR,
+      ON_Or => TRUTH_OR_EXPR,
+      ON_Xor => TRUTH_XOR_EXPR,
+      ON_And_Then => TRUTH_ANDIF_EXPR,
+      ON_Or_Else => TRUTH_ORIF_EXPR,
+
+      --  Monadic operations.
+      ON_Not => TRUTH_NOT_EXPR,
+      ON_Neg_Ov => NEGATE_EXPR,
+      ON_Abs_Ov => ABS_EXPR,
+
+      --  Comparaisons
+      ON_Eq => EQ_EXPR,
+      ON_Neq => NE_EXPR,
+      ON_Le => LE_EXPR,
+      ON_Lt => LT_EXPR,
+      ON_Ge => GE_EXPR,
+      ON_Gt => GT_EXPR,
+
+      ON_Nil => ERROR_MARK
+      );
+
+   --  Constants used for FP rounding.
+   Fp_Const_P5 : REAL_VALUE_TYPE;   -- 0.5
+   Fp_Const_M_P5 : REAL_VALUE_TYPE; -- -0.5
+   Fp_Const_Zero : REAL_VALUE_TYPE; -- 0.0
+
+   procedure Init
+   is
+      use Agcc.Machmode;
+
+      L, H : HOST_WIDE_INT;
+      V : REAL_VALUE_TYPE;
+   begin
+      To_Host_Wide_Int (Integer_64'(1), L, H);
+      REAL_VALUE_FROM_INT (V'Address, L, H, DFmode);
+      Fp_Const_P5 := REAL_VALUE_LDEXP (V, -1);
+
+      To_Host_Wide_Int (Integer_64'(-1), L, H);
+      REAL_VALUE_FROM_INT (V'Address, L, H, DFmode);
+      Fp_Const_M_P5 := REAL_VALUE_LDEXP (V, -1);
+
+      To_Host_Wide_Int (Integer_64'(0), L, H);
+      REAL_VALUE_FROM_INT (Fp_Const_Zero'Address, L, H, DFmode);
+   end Init;
+
+   procedure Chain_Init (Constr : out Chain_Constr_Type) is
+   begin
+      Constr.First := NULL_TREE;
+      Constr.Last := NULL_TREE;
+   end Chain_Init;
+
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree)
+   is
+   begin
+      if Constr.First = NULL_TREE then
+         if Constr.Last /= NULL_TREE then
+            raise Program_Error;
+         end if;
+         Constr.First := El;
+      else
+         Set_TREE_CHAIN (Constr.Last, El);
+      end if;
+      Constr.Last := El;
+   end Chain_Append;
+
+
+   procedure List_Init (Constr : out List_Constr_Type) is
+   begin
+      Constr := (First => NULL_TREE, Last => NULL_TREE);
+   end List_Init;
+
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree)
+   is
+      Res : Tree;
+   begin
+      Res := Tree_Cons (NULL_TREE, El, NULL_TREE);
+      if Constr.First = NULL_TREE then
+         Constr.First := Res;
+      else
+         Set_TREE_CHAIN (Constr.Last, Res);
+      end if;
+      Constr.Last := Res;
+   end List_Append;
+
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode
+   is
+      Left_Type : Tree;
+      Code : Tree_Code;
+   begin
+      Left_Type := Get_TREE_TYPE (Tree (Left));
+      if Left_Type /= Get_TREE_TYPE (Tree (Right)) then
+         raise Type_Error;
+      end if;
+      case Kind is
+         when ON_Div_Ov =>
+            if Get_TREE_CODE (Left_Type) = REAL_TYPE then
+               Code := RDIV_EXPR;
+            else
+               Code := TRUNC_DIV_EXPR;
+            end if;
+         when others =>
+            Code := ON_Op_To_Tree_Code (Kind);
+      end case;
+      return O_Enode (Build (Code, Left_Type, Tree (Left), Tree (Right)));
+   end New_Dyadic_Op;
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode
+   is
+   begin
+      return Build1 (ON_Op_To_Tree_Code (Kind),
+                     Get_TREE_TYPE (Operand), Operand);
+   end New_Monadic_Op;
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode
+   is
+   begin
+      if Get_TREE_CODE (Ntype) /= BOOLEAN_TYPE then
+         raise Type_Error;
+      end if;
+      if Get_TREE_TYPE (Left) /= Get_TREE_TYPE (Right) then
+         raise Type_Error;
+      end if;
+      return O_Enode (Build (ON_Op_To_Tree_Code (Kind),
+                             Tree (Ntype), Tree (Left), Tree (Right)));
+   end New_Compare_Op;
+
+--   function Unchecked_Conversion is new
+--   Ada.Unchecked_Conversion (Source => Unsigned_32, Target => HOST_WIDE_INT);
+
+--    function High_Part (V : Unsigned_64) return HOST_WIDE_INT
+--    is
+--    begin
+--       return Unchecked_Conversion (Unsigned_32 (Shift_Left (V, 32)));
+--    end High_Part;
+
+--    function Low_Part (V : Unsigned_64) return HOST_WIDE_INT
+--    is
+--    begin
+--       return Unchecked_Conversion
+--         (Unsigned_32 (V and (Unsigned_32'Modulus - 1)));
+--    end Low_Part;
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode
+   is
+      L, H : HOST_WIDE_INT;
+      Res : Tree;
+   begin
+      To_Host_Wide_Int (Value, L, H);
+      Res := Build_Int_2 (L, H);
+      Set_TREE_TYPE (Res, Tree (Ltype));
+      return O_Cnode (Res);
+   end New_Signed_Literal;
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode
+   is
+      Res : Tree;
+      L, H : HOST_WIDE_INT;
+   begin
+      To_Host_Wide_Int (Value, L, H);
+      Res := Build_Int_2 (L, H);
+      Set_TREE_TYPE (Res, Tree (Ltype));
+      return O_Cnode (Res);
+   end New_Unsigned_Literal;
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode
+   is
+      Res : Tree;
+   begin
+      Res := Build_Int_2 (0, 0);
+      Set_TREE_TYPE (Res, Tree (Ltype));
+      return O_Cnode (Res);
+   end New_Null_Access;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode
+   is
+      Res : REAL_VALUE_TYPE;
+   begin
+      Res := To_Real_Value_Type (Value);
+      return O_Cnode (Build_Real (Tree (Ltype), Res));
+   end New_Float_Literal;
+
+   procedure Check_Constrained_Type (Atype : O_Tnode)
+   is
+      pragma Unreferenced (Atype);
+   begin
+      null;
+   end Check_Constrained_Type;
+
+   procedure Finish_Type_Def (Atype : O_Tnode) is
+   begin
+      Layout_Type (Atype);
+      --Rest_Of_Type_Compilation (Tree (Atype), True);
+   end Finish_Type_Def;
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      Res := Make_Node (RECORD_TYPE);
+   end New_Uncomplete_Record_Type;
+
+   procedure Start_Record_Type (Elements : out O_Element_List) is
+   begin
+      Elements.Res := Make_Node (RECORD_TYPE);
+      Chain_Init (Elements.Chain);
+   end Start_Record_Type;
+
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List) is
+   begin
+      Elements.Res := Tree (Res);
+      Chain_Init (Elements.Chain);
+   end Start_Uncomplete_Record_Type;
+
+   procedure New_Record_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+   is
+      Res : Tree;
+   begin
+      Check_Constrained_Type (Etype);
+      Res := Build_Decl (FIELD_DECL, Ident, Tree (Etype));
+      Set_DECL_CONTEXT (Res, Elements.Res);
+      Chain_Append (Elements.Chain, Res);
+      El := O_Fnode (Res);
+   end New_Record_Union_Field;
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+     renames New_Record_Union_Field;
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Set_TYPE_FIELDS (Elements.Res, Elements.Chain.First);
+      Finish_Type_Def (O_Tnode (Elements.Res));
+      Res := O_Tnode (Elements.Res);
+      if Get_TYPE_NAME (Elements.Res) /= NULL_TREE then
+         --  The type was completed.
+         Rest_Of_Type_Compilation (Elements.Res, C_True);
+      end if;
+   end Finish_Record_Type;
+
+   procedure Start_Union_Type (Elements : out O_Element_List) is
+   begin
+      Elements.Res := Make_Node (UNION_TYPE);
+      Chain_Init (Elements.Chain);
+   end Start_Union_Type;
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+     renames New_Record_Union_Field;
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Set_TYPE_FIELDS (Elements.Res, Elements.Chain.First);
+      Finish_Type_Def (O_Tnode (Elements.Res));
+      Res := O_Tnode (Elements.Res);
+   end Finish_Union_Type;
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode
+   is
+      Res : Tree;
+   begin
+      if Dtype = O_Tnode_Null then
+         Res := Make_Node (POINTER_TYPE);
+         Set_TREE_TYPE (Res, NULL_TREE);
+         Set_TYPE_MODE (Res, Machmode.Ptr_Mode);
+         Layout_Type (Res);
+         return O_Tnode (Res);
+      else
+         return Build_Pointer_Type (Dtype);
+      end if;
+   end New_Access_Type;
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) is
+   begin
+      if Get_TREE_CODE (Atype) /= POINTER_TYPE
+        or else Get_TREE_TYPE (Atype) /= O_Tnode_Null
+      then
+         raise Syntax_Error;
+      end if;
+      Set_TREE_TYPE (Atype, Dtype);
+   end Finish_Access_Type;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode
+   is
+   begin
+      Check_Constrained_Type (El_Type);
+      return Build_Array_Type (El_Type, Index_Type);
+   end New_Array_Type;
+
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode
+   is
+      Range_Type : Tree;
+      Index_Type : Tree;
+      Len : Tree;
+      One : Tree;
+   begin
+      --if Atype.Kind /= ON_Array_Type then
+      --   raise Type_Error;
+      --end if;
+      Index_Type := Get_TYPE_DOMAIN (Tree (Atype));
+      if +Integer_Zerop (Tree (Length)) then
+         --  Handle null array, by creating a one-length array...
+         Len := Size_Zero_Node;
+      else
+         One := Build_Int_2 (1, 0);
+         Set_TREE_TYPE (One, Index_Type);
+         Len := Build (MINUS_EXPR, Index_Type, Tree (Length), One);
+         Len := Fold (Len);
+      end if;
+      Range_Type := Build_Range_Type (Index_Type, Size_Zero_Node, Len);
+      return O_Tnode (Build_Array_Type (Get_TREE_TYPE (Tree (Atype)),
+                                        Range_Type));
+   end New_Constrained_Array_Type;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode
+   is
+   begin
+      return Make_Unsigned_Type (Size);
+   end New_Unsigned_Type;
+
+   function New_Signed_Type (Size : Natural) return O_Tnode
+   is
+   begin
+      return Make_Signed_Type (Size);
+   end New_Signed_Type;
+
+   function New_Float_Type return O_Tnode is
+      Res : O_Tnode;
+   begin
+      Res := Make_Node (REAL_TYPE);
+      Set_TYPE_PRECISION (Res, DOUBLE_TYPE_SIZE);
+      Layout_Type (Res);
+      return Res;
+   end New_Float_Type;
+
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode)
+   is
+      pragma Unreferenced (False_Id);
+      pragma Unreferenced (True_Id);
+   begin
+      --  see java/decl.c
+      Res := O_Tnode'(Make_Node (BOOLEAN_TYPE));
+      Set_TYPE_PRECISION (Tree (Res), 1);
+      Fixup_Unsigned_Type (Tree (Res));
+      False_E := O_Cnode (Get_TYPE_MIN_VALUE (Tree (Res)));
+      True_E := O_Cnode (Get_TYPE_MAX_VALUE (Tree (Res)));
+   end New_Boolean_Type;
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+   begin
+      List.Res := Make_Node (ENUMERAL_TYPE);
+      Chain_Init (List.Chain);
+      List.Num := 0;
+      List.Size := Size;
+   end Start_Enum_Type;
+
+   procedure New_Enum_Literal
+     (List : in out O_Enum_List; Ident : O_Ident; Res : out O_Cnode)
+   is
+   begin
+      Res := Build_Int_2 (HOST_WIDE_INT (List.Num), 0);
+      Set_TREE_TYPE (Tree (Res), List.Res);
+      Chain_Append (List.Chain, Tree_Cons (Ident, Tree (Res), NULL_TREE));
+      List.Num := List.Num + 1;
+   end New_Enum_Literal;
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := O_Tnode (List.Res);
+      Set_TYPE_VALUES (List.Res, List.Chain.First);
+      Set_TYPE_MIN_VALUE (List.Res, Get_TREE_VALUE (List.Chain.First));
+      Set_TYPE_MAX_VALUE (List.Res, Get_TREE_VALUE (List.Chain.Last));
+      Set_TREE_UNSIGNED (List.Res, C_True);
+      Set_TYPE_PRECISION (List.Res, Integer (List.Size));
+      Finish_Type_Def (Res);
+   end Finish_Enum_Type;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List; Atype : O_Tnode)
+   is
+   begin
+      List.Atype := Tree (Atype);
+      Chain_Init (List.Chain);
+   end Start_Record_Aggr;
+
+   procedure New_Record_Aggr_El
+     (List : in out O_Record_Aggr_List; Value : O_Cnode)
+   is
+   begin
+      --  FIXME: should check type of value.
+      Chain_Append (List.Chain,
+                    Build_Tree_List (NULL_TREE, Tree (Value)));
+   end New_Record_Aggr_El;
+
+   procedure Finish_Record_Aggr
+     (List : in out O_Record_Aggr_List; Res : out O_Cnode)
+   is
+   begin
+      Res := O_Cnode (Build_Constructor (List.Atype, List.Chain.First));
+   end Finish_Record_Aggr;
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode)
+   is
+   begin
+      List.Atype := Tree (Atype);
+      Chain_Init (List.Chain);
+   end Start_Array_Aggr;
+
+   procedure New_Array_Aggr_El
+     (List : in out O_Array_Aggr_List; Value : O_Cnode)
+   is
+   begin
+      --  FIXME: should check type of value.
+      Chain_Append (List.Chain,
+                    Build_Tree_List (NULL_TREE, Tree (Value)));
+   end New_Array_Aggr_El;
+
+   procedure Finish_Array_Aggr
+     (List : in out O_Array_Aggr_List; Res : out O_Cnode)
+   is
+   begin
+      Res := O_Cnode (Build_Constructor (List.Atype, List.Chain.First));
+   end Finish_Array_Aggr;
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      El : Tree;
+      Res : Tree;
+   begin
+      El := Build_Tree_List (Tree (Field), Tree (Value));
+      Res := Build_Constructor (Tree (Atype), El);
+      Set_TREE_CONSTANT (Res, C_True);
+      return O_Cnode (Res);
+   end New_Union_Aggr;
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode
+   is
+      Res : Tree;
+      V : C_Bool;
+   begin
+      V := Mark_Addressable (Tree (Arr));
+      Res := Build (ARRAY_REF, Get_TREE_TYPE (Get_TREE_TYPE (Tree (Arr))),
+                    Tree (Arr), Tree (Index));
+      return O_Lnode (Res);
+   end New_Indexed_Element;
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode
+   is
+      Res : Tree;
+      Ptr_Type : Tree;
+      V : C_Bool;
+   begin
+      --  *((RES_TYPE *)(&ARR[INDEX]))
+      --  convert ARR to a pointer, add index, and reconvert to array ?
+      if Get_TREE_CODE (Res_Type) /= ARRAY_TYPE then
+         raise Type_Error;
+      end if;
+      V := Mark_Addressable (Tree (Arr));
+      Ptr_Type := Build_Pointer_Type (Tree (Res_Type));
+      Res := Build (ARRAY_REF, Get_TREE_TYPE (Get_TREE_TYPE (Tree (Arr))),
+                    Tree (Arr), Tree (Index));
+      Res := Build1 (ADDR_EXPR, Ptr_Type, Res);
+      Res := Build1 (INDIRECT_REF, Tree (Res_Type), Res);
+      return O_Lnode (Res);
+   end New_Slice;
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode
+   is
+   begin
+      if Get_TREE_CODE (Get_TREE_TYPE (Rec)) /= RECORD_TYPE then
+         raise Type_Error;
+      end if;
+      return O_Lnode (Build (COMPONENT_REF, Get_TREE_TYPE (Tree (El)),
+                             Tree (Rec), Tree (El)));
+   end New_Selected_Element;
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      Acc_Type : Tree;
+   begin
+      Acc_Type := Get_TREE_TYPE (Tree (Acc));
+      if Get_TREE_CODE (Acc_Type) /= POINTER_TYPE then
+         raise Type_Error;
+      end if;
+      return O_Lnode (Build1 (INDIRECT_REF, Get_TREE_TYPE (Acc_Type),
+                              Tree (Acc)));
+   end New_Access_Element;
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode
+   is
+      Val_Type : Tree;
+      Val_Code : Tree_Code;
+      Rtype_Code : Tree_Code;
+      Code : Tree_Code;
+   begin
+      Val_Type := Get_TREE_TYPE (Tree (Val));
+      if Val_Type = Tree (Rtype) then
+         return Val;
+      end if;
+      --  FIXME: check conversions.
+      Val_Code := Get_TREE_CODE (Val_Type);
+      Rtype_Code := Get_TREE_CODE (Rtype);
+      if Val_Code = POINTER_TYPE and then Rtype_Code = POINTER_TYPE then
+         Code := NOP_EXPR;
+      elsif Val_Code = INTEGER_TYPE and then Rtype_Code = INTEGER_TYPE then
+         Code := CONVERT_EXPR;
+      elsif Val_Code = REAL_TYPE and then Rtype_Code = INTEGER_TYPE then
+         --  REAL to INTEGER
+         --  Gcc only handles FIX_TRUNC_EXPR, but we need rounding.
+         declare
+            M_P5 : Tree;
+            P5 : Tree;
+            Zero : Tree;
+            Saved : Tree;
+            Comp : Tree;
+            Adj : Tree;
+            Res : Tree;
+         begin
+            M_P5 := Build_Real (Val_Type, Fp_Const_M_P5);
+            P5 := Build_Real (Val_Type, Fp_Const_P5);
+            Zero := Build_Real (Val_Type, Fp_Const_Zero);
+            Saved := Build_Save_Expr (Tree (Val));
+            Comp := Build (GE_EXPR, Integer_Type_Node, Saved, Zero);
+            --  FIXME: instead of res = res + (comp ? .5 : -.5)
+            --                 do: res = res (comp ? + : -) .5
+            Adj := Build (COND_EXPR, Val_Type, Comp, P5, M_P5);
+            Res := Build (PLUS_EXPR, Val_Type, Saved, Adj);
+            Res := Build1 (FIX_TRUNC_EXPR, Tree (Rtype), Res);
+            return O_Enode (Res);
+         end;
+      elsif Val_Code = INTEGER_TYPE and then Rtype_Code = ENUMERAL_TYPE then
+         Code := CONVERT_EXPR;
+      elsif Val_Code = ENUMERAL_TYPE and then Rtype_Code = INTEGER_TYPE then
+         Code := CONVERT_EXPR;
+      elsif Val_Code = INTEGER_TYPE and then Rtype_Code = REAL_TYPE then
+         Code := FLOAT_EXPR;
+      elsif Val_Code = BOOLEAN_TYPE and then Rtype_Code = BOOLEAN_TYPE then
+         Code := NOP_EXPR;
+      elsif Val_Code = BOOLEAN_TYPE and then Rtype_Code = INTEGER_TYPE then
+         Code := CONVERT_EXPR;
+      elsif Val_Code = INTEGER_TYPE and then Rtype_Code = BOOLEAN_TYPE then
+         --  From integer to boolean.
+         Code := NOP_EXPR;
+      elsif Val_Code = REAL_TYPE and then Rtype_Code = REAL_TYPE then
+         Code := CONVERT_EXPR;
+      else
+         raise Program_Error;
+      end if;
+      return O_Enode (Build1 (Code, Tree (Rtype), Tree (Val)));
+   end New_Convert_Ov;
+
+   function Build_Addr (Operand : Tree; Atype : Tree) return Tree
+   is
+      use Agcc.Machmode;
+      Result : Tree;
+   begin
+      case Get_TREE_CODE (Operand) is
+         when INDIRECT_REF =>
+            --  This may be an unchecked conversion.
+            Result := Get_TREE_OPERAND (Operand, 0);
+            if Get_TREE_CODE (Get_TREE_TYPE (Result)) /= POINTER_TYPE then
+               raise Program_Error;
+            end if;
+            return Result;
+
+         when ARRAY_REF
+           | COMPONENT_REF =>
+            --  Find the address of the prefix and add the offset.
+            declare
+               Op_Type : Tree;
+               Bitsize, Bitpos : HOST_WIDE_INT;
+               Inner, Offset : Tree;
+               Mode : Machine_Mode;
+               Unsignedp, Volatilep : Integer;
+            begin
+               Op_Type := Get_TREE_TYPE (Get_TREE_OPERAND (Operand, 0));
+               Inner := Get_Inner_Reference
+                 (Operand, Bitsize'Address, Bitpos'Address, Offset'Address,
+                  Mode'Address, Unsignedp'Address, Volatilep'Address);
+
+               -- Compute the offset as a byte offset from INNER.  */
+               if Offset = NULL_TREE then
+                  Offset := Size_Zero_Node;
+               end if;
+
+               Offset := Size_Binop
+                 (PLUS_EXPR, Offset,
+                  Size_Int (Bitpos / HOST_WIDE_INT (BITS_PER_UNIT)));
+
+               -- Take the address of INNER, convert the offset to void *, and
+               -- add then.  It will later be converted to the desired result
+               -- type, if any.
+               Inner := Build_Addr (Inner, Ptr_Type_Node);
+               Inner := Convert (Ptr_Type_Node, Inner);
+               Offset := Convert (Ptr_Type_Node, Offset);
+               Result := Fold
+                 (Build (PLUS_EXPR, Ptr_Type_Node, Inner, Offset));
+               return Result;
+            end;
+
+         when VAR_DECL =>
+            --  This is like Mark_Addressable.
+            Put_Var_Into_Stack (Operand, C_True);
+            Set_TREE_ADDRESSABLE (Operand, C_True);
+            return Build1 (ADDR_EXPR, Atype, Operand);
+
+         when others =>
+            raise Program_Error;
+      end case;
+   end Build_Addr;
+
+   function New_Addr (Lvalue : Tree; Atype : O_Tnode)
+                     return Tree
+   is
+      Result : Tree;
+   begin
+      Result := Build_Addr (Lvalue, Tree (Atype));
+      if Get_TREE_TYPE (Result) /= Tree (Atype) then
+         if Get_TREE_CODE (Get_TREE_TYPE (Result)) /= POINTER_TYPE then
+            raise Program_Error;
+         end if;
+         Result := Build1 (NOP_EXPR, Tree (Atype), Result);
+      end if;
+      return Result;
+      --return O_Enode (Build1 (ADDR_EXPR, Tree (Atype), Tree (Lvalue)));
+   end New_Addr;
+
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+                                  return O_Enode
+   is
+   begin
+      return O_Enode (New_Addr (Tree (Lvalue), Atype));
+   end New_Unchecked_Address;
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode
+   is
+   begin
+      --if Get_TREE_TYPE (Lvalue) /= Get_TREE_TYPE (Atype) then
+      --   raise Type_Error;
+      --end if;
+      return O_Enode (New_Addr (Tree (Lvalue), Atype));
+   end New_Address;
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode
+   is
+   begin
+      return O_Cnode (New_Addr (Tree (Decl), Atype));
+   end New_Global_Unchecked_Address;
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) return O_Cnode
+   is
+   begin
+      --if Get_TREE_TYPE (Lvalue) /= Get_TREE_TYPE (Atype) then
+      --   raise Type_Error;
+      --end if;
+      return O_Cnode (New_Addr (Tree (Decl), Atype));
+   end New_Global_Address;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode
+   is
+   begin
+      return O_Cnode (Build1 (ADDR_EXPR, Tree (Atype), Tree (Subprg)));
+   end New_Subprogram_Address;
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode is
+   begin
+      return O_Enode (Lvalue);
+   end New_Value;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return O_Enode (Obj);
+   end New_Obj_Value;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      return O_Lnode (Obj);
+   end New_Obj;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode (Lit);
+   end New_Lit;
+
+   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode
+   is
+      Off : Tree;
+      Bit_Off : Tree;
+      Pos : HOST_WIDE_INT;
+      Res : Tree;
+   begin
+      Off := Get_DECL_FIELD_OFFSET (Tree (Field));
+      if Host_Integerp (Off, 1) = 0 then
+         --  The offset must be a constant.
+         raise Program_Error;
+      end if;
+      Bit_Off := Get_DECL_FIELD_BIT_OFFSET (Tree (Field));
+      if Host_Integerp (Bit_Off, 1) = 0 then
+         --  The offset must be a constant.
+         raise Program_Error;
+      end if;
+      Pos := Get_TREE_INT_CST_LOW (Off)
+        + (Get_TREE_INT_CST_LOW (Bit_Off) / HOST_WIDE_INT (BITS_PER_UNIT));
+      Res := Build_Int_2 (Pos, 0);
+      Set_TREE_TYPE (Res, Tree (Rtype));
+      return O_Cnode (Res);
+   end New_Offsetof;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      Size : Tree;
+   begin
+      Size := Get_TYPE_SIZE_UNIT (Tree (Atype));
+      --Size := Size_Binop (CEIL_DIV_EXPR, Size,
+      --                    Size_Int (HOST_WIDE_INT (BITS_PER_UNIT)));
+
+      return O_Cnode (Fold (Build1 (NOP_EXPR, Tree (Rtype), Size)));
+   end New_Sizeof;
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      Var : Tree;
+      Var_Type : Tree;
+      Res : Tree;
+   begin
+      --  Create a dummy variable of the correct size.
+      --  This way, the storage will be deallocated at the end of the scope.
+      Var_Type := Build_Array_Type (Char_Type_Node,
+                                    Build_Index_Type (Tree (Size)));
+      Var := Build_Decl (VAR_DECL, NULL_TREE, Var_Type);
+      Set_TREE_STATIC (Var, C_False);
+      Set_DECL_EXTERNAL (Var, C_False);
+      Set_TREE_PUBLIC (Var, C_False);
+      Pushdecl (Var);
+      Expand_Decl (Var);
+      Res := Build1 (ADDR_EXPR, Tree (Rtype), Var);
+      return O_Enode (Res);
+
+      -- Old code that use alloca.  This is not space efficient, since the
+      -- storage will be freed only at the exit of the function.
+      --Arg := Build1 (CONVERT_EXPR, Sizetype, Tree (Size));
+      --Res := Build (CALL_EXPR, Ptr_Type_Node, Alloca_Function_Ptr,
+      --              Tree_Cons (NULL_TREE, Arg, NULL_TREE));
+      --return O_Enode (Build1 (NOP_EXPR, Tree (Rtype), Res));
+   end New_Alloca;
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   type String_Acc is access String;
+   Current_Filename : String_Acc := null;
+
+   procedure New_Debug_Filename_Decl (Filename : String)
+   is
+      Len : Natural;
+   begin
+      Len := Filename'Length;
+      if Current_Filename = null
+        or else Current_Filename.all'Length /= Len + 1
+        or else Current_Filename (1 .. Len) /= Filename
+      then
+         Current_Filename := new String (1 .. Len + 1);
+         Current_Filename (1 .. Len) := Filename;
+         Current_Filename (Len + 1) := Nul;
+         Input_Location.File := Current_Filename (1)'Address;
+      end if;
+   end New_Debug_Filename_Decl;
+
+   procedure New_Debug_Line_Decl (Line : Natural)
+   is
+   begin
+      Input_Location.Line := Line;
+   end New_Debug_Line_Decl;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode)
+   is
+      Decl : Tree;
+      Ttype : Tree := Tree (Atype);
+   begin
+--       if Atype.Decl /= null then
+--          raise Type_Error;
+--       end if;
+      Set_TYPE_NAME (Ttype, Ident);
+      Decl := Build_Decl (TYPE_DECL, Ident, Ttype);
+      Set_TYPE_STUB_DECL (Ttype, Decl);
+      Pushdecl (Decl);
+      if Get_TYPE_SIZE (Ttype) /= NULL_TREE then
+         --  Do not generate debug info for uncompleted types.
+         Rest_Of_Type_Compilation (Ttype, C_True);
+      end if;
+   end New_Type_Decl;
+
+   procedure Set_Storage (Node : Tree; Storage : O_Storage)
+   is
+   begin
+      case Storage is
+         when O_Storage_External =>
+            Set_DECL_EXTERNAL (Node, C_True);
+            Set_TREE_PUBLIC (Node, C_True);
+            Set_TREE_STATIC (Node, C_False);
+         when O_Storage_Public =>
+            Set_DECL_EXTERNAL (Node, C_False);
+            Set_TREE_PUBLIC (Node, C_True);
+            Set_TREE_STATIC (Node, C_True);
+         when O_Storage_Private =>
+            Set_DECL_EXTERNAL (Node, C_False);
+            Set_TREE_PUBLIC (Node, C_False);
+            Set_TREE_STATIC (Node, C_True);
+         when O_Storage_Local =>
+            Set_DECL_EXTERNAL (Node, C_False);
+            Set_TREE_PUBLIC (Node, C_False);
+            Set_TREE_STATIC (Node, C_False);
+      end case;
+   end Set_Storage;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+      Cst : Tree;
+   begin
+      Cst := Build_Decl (VAR_DECL, Ident, Tree (Atype));
+      Set_Storage (Cst, Storage);
+      Set_TREE_READONLY (Cst, C_True);
+      Pushdecl (Cst);
+      case Storage is
+         when O_Storage_Local =>
+            raise Syntax_Error;
+         when O_Storage_External =>
+            --  We are at top level if Current_Function_Decl is null.
+            Rest_Of_Decl_Compilation
+              (Cst, NULL_Chars,
+               Boolean'Pos (Current_Function_Decl = NULL_TREE), C_False);
+         when O_Storage_Public
+           | O_Storage_Private =>
+            null;
+      end case;
+      Res := O_Dnode (Cst);
+   end New_Const_Decl;
+
+   procedure Start_Const_Value (Const : in out O_Dnode)
+   is
+      pragma Unreferenced (Const);
+   begin
+      null;
+   end Start_Const_Value;
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
+   is
+   begin
+      Set_DECL_INITIAL (Tree (Const), Tree (Val));
+      Set_TREE_CONSTANT (Val, C_True);
+      Rest_Of_Decl_Compilation
+        (Tree (Const), NULL_Chars,
+         Boolean'Pos (Current_Function_Decl = NULL_TREE), C_False);
+   end Finish_Const_Value;
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+      Var : Tree;
+   begin
+      Var := Build_Decl (VAR_DECL, Ident, Tree (Atype));
+      if Current_Function_Decl /= NULL_TREE  then
+         --  Local variable.
+         Set_TREE_STATIC (Var, C_False);
+         Set_DECL_EXTERNAL (Var, C_False);
+         Set_TREE_PUBLIC (Var, C_False);
+      else
+         Set_Storage (Var, Storage);
+      end if;
+      Pushdecl (Var);
+      if Current_Function_Decl /= NULL_TREE  then
+         Expand_Decl (Var);
+      else
+         Rest_Of_Decl_Compilation (Var, NULL_Chars, C_True, C_False);
+      end if;
+      Res := O_Dnode (Var);
+   end New_Var_Decl;
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Interfaces.Ident := Ident;
+      Interfaces.Storage := Storage;
+      Interfaces.Rtype := Rtype;
+      Chain_Init (Interfaces.Param_Chain);
+      List_Init (Interfaces.Param_List);
+   end Start_Function_Decl;
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List; Ident : O_Ident; Storage : O_Storage) is
+   begin
+      Start_Function_Decl (Interfaces, Ident, Storage,
+                           O_Tnode (Void_Type_Node));
+   end Start_Procedure_Decl;
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode)
+   is
+      R : Tree;
+   begin
+      R := Build_Decl (PARM_DECL, Ident, Tree (Atype));
+      --Set_DECL_CONTEXT (Res, Xxx);
+
+      --  Do type conversion: convert boolean and enums to int
+      if +PROMOTE_PROTOTYPES then
+         case Get_TREE_CODE (Tree (Atype)) is
+            when ENUMERAL_TYPE
+              | BOOLEAN_TYPE =>
+               Set_DECL_ARG_TYPE (R, Integer_Type_Node);
+            when others =>
+               Set_DECL_ARG_TYPE (R, Tree (Atype));
+         end case;
+      else
+         Set_DECL_ARG_TYPE (R, Tree (Atype));
+      end if;
+
+      Chain_Append (Interfaces.Param_Chain, R);
+      List_Append (Interfaces.Param_List, Tree (Atype));
+      Res := O_Dnode (R);
+   end New_Interface_Decl;
+
+   --  Current function nest level, or the number of parents.
+   Function_Nest_Level : Natural := 0;
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode)
+   is
+      Decl : Tree;
+      Result : Tree;
+      Parm : Tree;
+      Is_Global : Boolean;
+   begin
+      Decl := Build_Decl (FUNCTION_DECL, Interfaces.Ident,
+                          Build_Function_Type (Tree (Interfaces.Rtype),
+                                               Interfaces.Param_List.First));
+      Is_Global := Function_Nest_Level = 0
+        or Interfaces.Storage = O_Storage_External;
+      if Is_Global then
+         Set_Storage (Decl, Interfaces.Storage);
+      else
+         --  A nested subprogram.
+         Set_DECL_EXTERNAL (Decl, C_False);
+         Set_TREE_PUBLIC (Decl, C_False);
+      end if;
+      --  The function exist in static storage.
+      Set_TREE_STATIC (Decl, C_True);
+      Set_DECL_INITIAL (Decl, Error_Mark_Node);
+      Set_TREE_ADDRESSABLE (Decl, C_True);
+
+      --  Declare the result.
+      --  FIXME: should be moved in start_function_body.
+      Result := Build_Decl (RESULT_DECL, NULL_TREE, Tree (Interfaces.Rtype));
+      Set_DECL_RESULT (Decl, Result);
+      Set_DECL_CONTEXT (Result, Decl);
+
+      Set_DECL_ARGUMENTS (Decl, Interfaces.Param_Chain.First);
+      --  Set DECL_CONTEXT of parameters.
+      Parm := Interfaces.Param_Chain.First;
+      while Parm /= NULL_TREE loop
+         Set_DECL_CONTEXT (Parm, Decl);
+         Parm := Get_TREE_CHAIN (Parm);
+      end loop;
+
+      Pushdecl (Decl);
+
+      if Is_Global then
+         Rest_Of_Decl_Compilation (Decl, NULL_Chars, C_True, C_False);
+      else
+         Expand_Decl (Decl);
+      end if;
+
+      --Make_Function_Rtl (Decl);
+
+      Res := O_Dnode (Decl);
+   end Finish_Subprogram_Decl;
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+   begin
+      if Function_Nest_Level /= 0 then
+         --  For a nested subprogram:
+         Push_Function_Context;
+         --start_function (c-decl.c)
+         --  announce_function
+         --  current_function_decl = pushdecl (x)
+         --  ??
+         --XXX
+         --finish_function(1) (c-decl.c)
+         --  poplevel
+         --pop_function_context
+         --add_decl_stmt
+      end if;
+      Function_Nest_Level := Function_Nest_Level + 1;
+
+      Current_Function_Decl := Tree (Func);
+      Announce_Function (Tree (Func));
+
+      --  Create a binding for the parameters.
+      Pushlevel (C_False);
+      --  FIXME: should push parameters.
+      --Make_Function_Rtl (Current_Function_Decl);
+      Init_Function_Start (Func, NULL_Chars, 0);
+      Expand_Function_Start (Func, C_False);
+      --  Create a binding for the function.
+      --  This is necessary for compatibility.
+      Pushlevel (C_False);
+      Expand_Start_Bindings (0);
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body
+   is
+   begin
+      Expand_End_Bindings (Getdecls, C_True, C_False);
+      Poplevel (C_True, C_False, C_False);
+      Expand_Function_End (NULL_Chars, 0, C_False);
+      Poplevel (C_True, C_False, C_True);
+      --  The subprogram is not external anymore (extern inline is not
+      --  supported).  As a result, code will be generated.
+      Set_DECL_EXTERNAL (Current_Function_Decl, C_False);
+
+      --  FIXME: protect against ggc.  See c-decl.c:c_expand_body
+      Rest_Of_Compilation (Current_Function_Decl);
+      Function_Nest_Level := Function_Nest_Level - 1;
+      if Function_Nest_Level > 0 then
+         Pop_Function_Context;
+      else
+         Current_Function_Decl := NULL_TREE;
+      end if;
+   end Finish_Subprogram_Body;
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural) is
+   begin
+      Input_Location.Line := Line;
+      Emit_Line_Note (Input_Location);
+   end New_Debug_Line_Stmt;
+
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   procedure Start_Declare_Stmt
+   is
+   begin
+      Pushlevel (C_False);
+      Expand_Start_Bindings (0);
+   end Start_Declare_Stmt;
+
+   procedure Finish_Declare_Stmt
+   is
+   begin
+      Expand_End_Bindings (Getdecls, C_True, C_True);
+      Poplevel (C_True, C_False, C_False);
+   end Finish_Declare_Stmt;
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+   begin
+      Assocs.Subprg := Tree (Subprg);
+      List_Init (Assocs.List);
+   end Start_Association;
+
+--    function Get_Base_Type (Atype : O_Tnode) return O_Tnode
+--    is
+--    begin
+--       case Atype.Kind is
+--          when ON_Array_Sub_Type =>
+--             return Atype.Base_Type;
+--          when others =>
+--             return Atype;
+--       end case;
+--    end Get_Base_Type;
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode)
+   is
+   begin
+      List_Append (Assocs.List, Tree (Val));
+   end New_Association;
+
+   --  Return a pointer to function FUNC.
+   function Build_Function_Ptr (Func : Tree) return Tree is
+   begin
+      return Build1 (ADDR_EXPR,
+                     Build_Pointer_Type (Get_TREE_TYPE (Func)), Func);
+   end Build_Function_Ptr;
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+   begin
+      return O_Enode (Build (CALL_EXPR,
+                             Get_TREE_TYPE (Get_TREE_TYPE (Assocs.Subprg)),
+                             Build_Function_Ptr (Assocs.Subprg),
+                             Assocs.List.First, NULL_TREE));
+   end New_Function_Call;
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List)
+   is
+      Res : Tree;
+   begin
+      Res := Build (CALL_EXPR,
+                    Get_TREE_TYPE (Get_TREE_TYPE (Assocs.Subprg)),
+                    Build_Function_Ptr (Assocs.Subprg),
+                    Assocs.List.First, NULL_TREE);
+      Set_TREE_SIDE_EFFECTS (Res, C_True);
+      Expand_Expr_Stmt (Res);
+   end New_Procedure_Call;
+
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      N : Tree;
+   begin
+      N := Build (MODIFY_EXPR, Get_TREE_TYPE (Tree (Target)),
+                  Tree (Target), Tree (Value));
+      Set_TREE_SIDE_EFFECTS (N, C_True);
+      Expand_Expr_Stmt (N);
+   end New_Assign_Stmt;
+
+   procedure New_Return_Stmt (Value : O_Enode)
+   is
+      Assign : Tree;
+   begin
+      Assign := Build (MODIFY_EXPR, Get_TREE_TYPE (Tree (Value)),
+                       Get_DECL_RESULT (Current_Function_Decl),
+                       Tree (Value));
+      Set_TREE_SIDE_EFFECTS (Assign, C_True);
+      --Set_TREE_USED (Assign, True);
+      Expand_Expr_Stmt (Assign);
+      Expand_Return (Value);
+   end New_Return_Stmt;
+
+   procedure New_Return_Stmt
+   is
+   begin
+      Expand_Null_Return;
+   end New_Return_Stmt;
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode)
+   is
+      pragma Unreferenced (Block);
+   begin
+      Expand_Start_Cond (Cond, C_False);
+   end Start_If_Stmt;
+
+   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode)
+   is
+      pragma Unreferenced (Block);
+   begin
+      Expand_Start_Elseif (Cond);
+   end New_Elsif_Stmt;
+
+   procedure New_Else_Stmt (Block : in out O_If_Block)
+   is
+      pragma Unreferenced (Block);
+   begin
+      Expand_Start_Else;
+   end New_Else_Stmt;
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block)
+   is
+      pragma Unreferenced (Block);
+   begin
+      Expand_End_Cond;
+   end Finish_If_Stmt;
+
+   procedure Start_Loop_Stmt (Label : out O_Snode)
+   is
+   begin
+      Label := Expand_Start_Loop (C_True);
+      --  This is required to avoid crash with goto fixup.
+      Expand_Start_Bindings (0);
+   end Start_Loop_Stmt;
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode)
+   is
+      pragma Unreferenced (Label);
+   begin
+      Expand_End_Bindings (NULL_TREE, C_False, C_False);
+      Expand_End_Loop;
+   end Finish_Loop_Stmt;
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+   begin
+      Expand_Exit_Loop (L);
+   end New_Exit_Stmt;
+
+   procedure New_Next_Stmt (L : O_Snode) is
+   begin
+      Expand_Continue_Loop (L);
+   end New_Next_Stmt;
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode)
+   is
+   begin
+      Expand_Start_Case (C_True, Value, Get_TREE_TYPE (Value), NULL_Chars);
+      Block := O_Case_Block'(Expr => Tree (Value),
+                           First => True, Label => NULL_TREE);
+   end Start_Case_Stmt;
+
+   procedure Start_Choice (Block : in out O_Case_Block)
+   is
+   begin
+      if Block.First then
+         Block.First := False;
+      else
+         --  Add a "break" statement.
+         if Expand_Exit_Something = 0 then
+            raise Type_Error;
+         end if;
+      end if;
+      if Block.Label /= NULL_TREE then
+         raise Syntax_Error;
+      end if;
+      Block.Label := Build_Decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+      --Pushdecl (Choices.Label);
+   end Start_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode)
+   is
+      Duplicate : Tree;
+   begin
+      if Pushcase (Tree (Expr), Agcc.Trees.Convert'Address,
+                   Block.Label, Duplicate'Address) /= 0 then
+         raise Syntax_Error;
+      end if;
+   end New_Expr_Choice;
+
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode)
+   is
+      Duplicate : Tree;
+   begin
+      if Pushcase_Range (Tree (Low), Tree (High), Agcc.Trees.Convert'Address,
+                         Tree (Block.Label), Duplicate'Address) /= 0
+      then
+         raise Syntax_Error;
+      end if;
+   end New_Range_Choice;
+
+   procedure New_Default_Choice (Block : in out O_Case_Block)
+   is
+      Duplicate : Tree;
+   begin
+      if Pushcase (NULL_TREE, System.Null_Address,
+                   Block.Label, Duplicate'Address) /= 0
+      then
+         raise Syntax_Error;
+      end if;
+   end New_Default_Choice;
+
+   procedure Finish_Choice (Block : in out O_Case_Block)
+   is
+   begin
+      Block.Label := NULL_TREE;
+   end Finish_Choice;
+
+   procedure Finish_Case_Stmt (Block: in out O_Case_Block) is
+   begin
+      Expand_End_Case_Type (Block.Expr, NULL_TREE);
+   end Finish_Case_Stmt;
+end Ortho_Gcc;
diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads
new file mode 100644
index 000000000..e7c3679e1
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.ads
@@ -0,0 +1,557 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+with Agcc.Trees; use Agcc.Trees;
+
+
+--  Interface to create nodes.
+package Ortho_Gcc is
+   --- PUBLIC DECLARATIONS
+   --  PUBLIC PART is defined in ortho_nodes.common.ads
+   type O_Cnode is private;
+   type O_Dnode is private;
+   type O_Enode is private;
+   type O_Fnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+
+   --  Alloca builtin, to be set during initialization.
+   Alloca_Function_Ptr : Tree;
+
+   --  Must be called during initialization, before use of any subprograms.
+   procedure Init;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type Bitsize_Type is range 0 .. 1024;
+
+   --  Standard types metrics.  0 means unknown.
+   Metric_Char        : Bitsize_Type := 0;
+   Metric_Short       : Bitsize_Type := 0;
+   Metric_Int         : Bitsize_Type := 0;
+   Metric_Long        : Bitsize_Type := 0;
+   Metric_Long_Long   : Bitsize_Type := 0;
+   Metric_Enum        : Bitsize_Type := 0;
+   Metric_Float       : Bitsize_Type := 0;
+   Metric_Double      : Bitsize_Type := 0;
+   Metric_Long_Double : Bitsize_Type := 0;
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record.  The result is a literal
+   --  of unsigned type RTYPE.
+   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+      ON_And_Then,              --  ON_Dyadic_Op_Kind
+      ON_Or_Else,               --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Or_Else;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   --  COND is NULL for the final else statement.
+   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+private
+   type O_Cnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Snode is new Nesting;
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := O_Snode (Nesting_Null);
+
+
+   --  Efficiently append element EL to a chain.
+   --  FIRST is the first element of the chain (must NULL_TREE if the chain
+   --   is empty),
+   --  LAST is the last element of the chain (idem).
+   type Chain_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   procedure List_Init (Constr : out List_Constr_Type);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      --  Return type.
+      Rtype : O_Tnode;
+      --  List of parameter types.
+      Param_List : List_Constr_Type;
+      --  Chain of parameters declarations.
+      Param_Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Case_Block is record
+      Expr : Tree;
+      First : Boolean;
+      Label : Tree;
+   end record;
+
+   type O_If_Block is record
+      null;
+   end record;
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is new O_Aggr_List;
+   type O_Array_Aggr_List is new O_Aggr_List;
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+
+   type O_Enum_List is record
+      --  The enumeral_type node.
+      Res : Tree;
+      --  Chain of literals.
+      Chain : Chain_Constr_Type;
+      --  Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+      Num : Natural;
+      --  Size of the enumeration type.
+      Size : Natural;
+   end record;
+
+end Ortho_Gcc;
diff --git a/ortho/gcc/ortho_gcc.private.ads b/ortho/gcc/ortho_gcc.private.ads
new file mode 100644
index 000000000..c4a0135e1
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.private.ads
@@ -0,0 +1,122 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Trees; use Agcc.Trees;
+
+package Ortho_Nodes is
+   --  PUBLIC PART is defined in ortho_nodes.common.ads
+   type O_Cnode is private;
+   type O_Dnode is private;
+   type O_Enode is private;
+   type O_Fnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+
+   --  Alloca builtin, to be set during initialization.
+   Alloca_Function_Ptr : Tree;
+
+   --  Must be called during initialization, before use of any subprograms.
+   procedure Init;
+private
+   type O_Cnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Snode is new Nesting;
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := O_Snode (Nesting_Null);
+
+
+   --  Efficiently append element EL to a chain.
+   --  FIRST is the first element of the chain (must NULL_TREE if the chain
+   --   is empty),
+   --  LAST is the last element of the chain (idem).
+   type Chain_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   procedure List_Init (Constr : out List_Constr_Type);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      --  Return type.
+      Rtype : O_Tnode;
+      --  List of parameter types.
+      Param_List : List_Constr_Type;
+      --  Chain of parameters declarations.
+      Param_Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Case_Block is record
+      Expr : Tree;
+      First : Boolean;
+      Label : Tree;
+   end record;
+
+   type O_If_Block is record
+      null;
+   end record;
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is new O_Aggr_List;
+   type O_Array_Aggr_List is new O_Aggr_List;
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+
+   type O_Enum_List is record
+      --  The enumeral_type node.
+      Res : Tree;
+      --  Chain of literals.
+      Chain : Chain_Constr_Type;
+      --  Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+      Num : Natural;
+      --  Size of the enumeration type.
+      Size : Natural;
+   end record;
+
+end Ortho_Nodes;
diff --git a/ortho/gcc/ortho_gcc_front.ads b/ortho/gcc/ortho_gcc_front.ads
new file mode 100644
index 000000000..0b98f4568
--- /dev/null
+++ b/ortho/gcc/ortho_gcc_front.ads
@@ -0,0 +1,19 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Front;
+package Ortho_Gcc_Front renames Ortho_Front;
diff --git a/ortho/gcc/ortho_ident.adb b/ortho/gcc/ortho_ident.adb
new file mode 100644
index 000000000..a3779f38c
--- /dev/null
+++ b/ortho/gcc/ortho_ident.adb
@@ -0,0 +1,52 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc; use Agcc;
+with Agcc.Trees;
+with C; use C;
+
+package body Ortho_Ident is
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Str_Nul : String := Str & Nul;
+   begin
+      return Get_Identifier (Str_Nul'Address);
+   end Get_Identifier;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      use Agcc.Trees;
+      Str : C_Str_Len;
+   begin
+      Str.Len := Get_IDENTIFIER_LENGTH (Id);
+      Str.Str := To_C_String (Get_IDENTIFIER_POINTER (Id));
+      return Image (Str);
+   end Get_String;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean
+   is
+      S : C_String;
+   begin
+      if Get_IDENTIFIER_LENGTH (Id) /= Str'Length then
+         return False;
+      end if;
+      S := To_C_String (Get_IDENTIFIER_POINTER (Id));
+      return S.all (1 .. Str'Length) = Str;
+   end Is_Equal;
+
+end Ortho_Ident;
+
diff --git a/ortho/gcc/ortho_ident.ads b/ortho/gcc/ortho_ident.ads
new file mode 100644
index 000000000..84a330e9c
--- /dev/null
+++ b/ortho/gcc/ortho_ident.ads
@@ -0,0 +1,30 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Agcc.Trees; use Agcc.Trees;
+
+package Ortho_Ident is
+   subtype O_Ident is Tree;
+   function Get_Identifier (Str : String) return O_Ident;
+   function Get_String (Id : O_Ident) return String;
+   function Is_Equal (L, R : O_Ident) return Boolean renames
+     Agcc.Trees."=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   O_Ident_Nul : constant O_Ident;
+private
+   O_Ident_Nul : constant O_Ident := NULL_TREE;
+end Ortho_Ident;
diff --git a/ortho/gcc/ortho_nodes.ads b/ortho/gcc/ortho_nodes.ads
new file mode 100644
index 000000000..04d9018e1
--- /dev/null
+++ b/ortho/gcc/ortho_nodes.ads
@@ -0,0 +1,20 @@
+--  Ortho implementation for GCC.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Gcc;
+
+package Ortho_Nodes renames Ortho_Gcc;
diff --git a/ortho/ortho_front.ads b/ortho/ortho_front.ads
new file mode 100644
index 000000000..1d20e15d7
--- /dev/null
+++ b/ortho/ortho_front.ads
@@ -0,0 +1,41 @@
+--  Ortho front-end specifications.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Ortho_Front is
+   type String_Acc is access String;
+
+   --  Called before decode_option.
+   --  This procedure can only do internal initializations.  It cannot call
+   --  ortho subprograms.
+   procedure Init;
+
+   --  An ortho back-end decodes the command line.  Unknown options may
+   --  be decoded by the user, with this function.
+   --  When an ortho back-end encounter an unknown option, it sets OPT with
+   --  this option and ARG with the next one, if any.
+   --
+   --  DECODE_OPTION must return the number of argument used, ie:
+   --   0 if OPT is unknown.
+   --   1 if OPT is known but ARG is unused.
+   --   2 if OPT is known and ARG used.
+   function Decode_Option (Opt : String_Acc; Arg : String_Acc) return Natural;
+
+   --  Start to parse file FILENAME.
+   --  Return False in case of error.
+   function Parse (Filename : String_Acc) return Boolean;
+end Ortho_Front;
diff --git a/ortho/ortho_nodes.common.ads b/ortho/ortho_nodes.common.ads
new file mode 100644
index 000000000..1d245db1e
--- /dev/null
+++ b/ortho/ortho_nodes.common.ads
@@ -0,0 +1,457 @@
+--  Ortho specifications.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+--- PRIVATE CONTEXT CLAUSES
+
+--  Interface to create nodes.
+package ORTHO_NODES is
+   --- PUBLIC DECLARATIONS
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type Bitsize_Type is range 0 .. 1024;
+
+   --  Standard types metrics.  0 means unknown.
+   Metric_Char        : Bitsize_Type := 0;
+   Metric_Short       : Bitsize_Type := 0;
+   Metric_Int         : Bitsize_Type := 0;
+   Metric_Long        : Bitsize_Type := 0;
+   Metric_Long_Long   : Bitsize_Type := 0;
+   Metric_Enum        : Bitsize_Type := 0;
+   Metric_Float       : Bitsize_Type := 0;
+   Metric_Double      : Bitsize_Type := 0;
+   Metric_Long_Double : Bitsize_Type := 0;
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record.  The result is a literal
+   --  of unsigned type RTYPE.
+   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+      ON_And_Then,              --  ON_Dyadic_Op_Kind
+      ON_Or_Else,               --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Or_Else;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   --  COND is NULL for the final else statement.
+   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+private
+   --- PRIVATE PART is defined by ortho_nodes.ads in one of the subdirectory.
+end ORTHO_NODES;