Move sources to src/ subdirectory.

129 files changed, 42281 insertions, 0 deletions

diff --git a/src/ortho/Makefile.inc b/src/ortho/Makefile.inc
new file mode 100644
index 000000000..597aaeff1
--- /dev/null
+++ b/src/ortho/Makefile.inc
@@ -0,0 +1,38 @@
+#  Common -*- Makefile -*- for ortho implementations.
+#  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+#
+#  GHDL is free software; you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free
+#  Software Foundation; either version 2, or (at your option) any later
+#  version.
+#
+#  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#  for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with GCC; see the file COPYING.  If not, write to the Free
+#  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+#  02111-1307, USA.
+
+# Variable to be defined:
+#   SED: sed the stream editor
+#   ORTHO_BASENAME
+
+$(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).ads: \
+  $(ortho_srcdir)/ortho_nodes.common.ads \
+  $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads
+	$(RM) -f $@
+	echo "--  DO NOT MODIFY - this file was generated from:" > $@
+	echo "--  ortho_nodes.common.ads and $(ORTHO_BASENAME).private.ads" \
+	  >> $@
+	echo "--" >> $@
+	$(SED) -e '/^private/,$$d' \
+	  < $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads >> $@
+	echo "--  Start of common part" >> $@
+	$(SED) -e '1,/^package/d' -e '/^private/,$$d' < $< >> $@
+	echo "--  End of common part" >> $@
+	$(SED) -n -e '/^private/,$$p' \
+	  < $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads >> $@
+	chmod a-w $@
diff --git a/src/ortho/debug/Makefile b/src/ortho/debug/Makefile
new file mode 100644
index 000000000..0c15111ef
--- /dev/null
+++ b/src/ortho/debug/Makefile
@@ -0,0 +1,47 @@
+#  -*- Makefile -*- for the ortho-code back-end
+#  Copyright (C) 2005 Tristan Gingold
+#
+#  GHDL is free software; you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free
+#  Software Foundation; either version 2, or (at your option) any later
+#  version.
+#
+#  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#  for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with GCC; see the file COPYING.  If not, write to the Free
+#  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+#  02111-1307, USA.
+BE=debug
+ortho_srcdir=..
+
+orthobe_srcdir=$(ortho_srcdir)/$(BE)
+
+GNATMAKE=gnatmake
+CC=gcc
+CFLAGS=-g
+ALL_GNAT_FLAGS=-pipe -g -gnato -gnatwl -gnatf -gnaty3befhkmr -gnatwu
+GNATMAKE_FLAGS=-m $(ALL_GNAT_FLAGS) $(GNAT_FLAGS) -aI$(ortho_srcdir) -aI$(orthobe_srcdir) -aI.
+#LARGS=-largs -static
+SED=sed
+
+all: $(ortho_exec)
+
+
+$(ortho_exec): force $(ortho_srcdir)/$(BE)/ortho_debug.ads
+	gnatmake -o $@ $(GNATMAKE_FLAGS) ortho_debug-main -bargs -E $(LARGS)
+
+clean:
+	$(RM) -f *.o *.ali *~ b~*.ad? ortho_nodes-main
+	$(RM) ortho_debug.ads
+
+force:
+
+ORTHO_BASENAME=ortho_debug
+
+# Automatically build ortho_debug.ads from ortho_node.common.ads and
+# ortho_debug.private.ads
+include $(ortho_srcdir)/Makefile.inc
diff --git a/src/ortho/debug/ortho_debug-disp.adb b/src/ortho/debug/ortho_debug-disp.adb
new file mode 100644
index 000000000..2725668bb
--- /dev/null
+++ b/src/ortho/debug/ortho_debug-disp.adb
@@ -0,0 +1,1064 @@
+--  Display the code from the ortho debug tree.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Ortho_Debug.Disp is
+   Disp_All_Types : constant Boolean := False;
+
+   package Formated_Output is
+      use Interfaces.C_Streams;
+
+      type Disp_Context is limited private;
+
+      procedure Init_Context (File : FILEs);
+
+      --  Save the current context, and create a new one.
+      procedure Push_Context (File : FILEs; Prev_Ctx : out Disp_Context);
+
+      --  Restore a previous context, saved by Push_Context.
+      procedure Pop_Context (Prev_Ctx : Disp_Context);
+
+      procedure Put (Str : String);
+
+      procedure Put_Line (Str : String);
+
+      --  Add a tabulation.
+      --  Every new line will start at this tabulation.
+      procedure Add_Tab;
+
+      --  Removed a tabulation.
+      --  The next new line will start at the previous tabulation.
+      procedure Rem_Tab;
+
+      --  Flush the current output.
+      procedure Flush;
+
+      --  Return TRUE if the ident level is nul.
+      function Is_Top return Boolean;
+
+      procedure Put_Tab;
+
+      procedure New_Line;
+
+      procedure Put (C : Character);
+
+      procedure Put_Trim (Str : String);
+
+      procedure Set_Mark;
+
+      --  Flush to disk.  Only for debugging in case of crash.
+      procedure Flush_File;
+      pragma Unreferenced (Flush_File);
+   private
+      type Disp_Context is record
+         --  File where the info are written to.
+         File : FILEs;
+         --  Line number of the line to be written.
+         Lineno : Natural;
+         --  Buffer for the current line.
+         Line : String (1 .. 256);
+         --  Number of characters currently in the line.
+         Line_Len : Natural;
+
+         --  Current tabulation.
+         Tab : Natural;
+         --  Tabulation to be used for the next line.
+         Next_Tab : Natural;
+
+         Mark : Natural;
+      end record;
+   end Formated_Output;
+
+   package body Formated_Output is
+      --  The current context.
+      Ctx : Disp_Context;
+
+      procedure Init_Context (File : FILEs) is
+      begin
+         Ctx.File := File;
+         Ctx.Lineno := 1;
+         Ctx.Line_Len := 0;
+         Ctx.Tab := 0;
+         Ctx.Next_Tab := 0;
+         Ctx.Mark := 0;
+      end Init_Context;
+
+      procedure Push_Context (File : FILEs; Prev_Ctx : out Disp_Context)
+      is
+      begin
+         Prev_Ctx := Ctx;
+         Init_Context (File);
+      end Push_Context;
+
+      --  Restore a previous context, saved by Push_Context.
+      procedure Pop_Context (Prev_Ctx : Disp_Context) is
+      begin
+         Flush;
+         Ctx := Prev_Ctx;
+      end Pop_Context;
+
+      procedure Flush
+      is
+         Status : size_t;
+         Res : int;
+         pragma Unreferenced (Status, Res);
+      begin
+         if Ctx.Line_Len > 0 then
+            Status := fwrite (Ctx.Line'Address, size_t (Ctx.Line_Len), 1,
+                              Ctx.File);
+            Res := fputc (Character'Pos (ASCII.Lf), Ctx.File);
+            Ctx.Line_Len := 0;
+         end if;
+         Ctx.Mark := 0;
+      end Flush;
+
+      function Is_Top return Boolean is
+      begin
+         return Ctx.Tab = 0;
+      end Is_Top;
+
+      procedure Put_Tab
+      is
+         Tab : Natural := Ctx.Next_Tab;
+         Max_Tab : constant Natural := 40;
+      begin
+         if Tab > Max_Tab then
+            --  Limit indentation length, to limit line length.
+            Tab := Max_Tab;
+         end if;
+
+         Ctx.Line (1 .. Tab) := (others => ' ');
+         Ctx.Line_Len := Tab;
+         Ctx.Next_Tab := Ctx.Tab + 2;
+      end Put_Tab;
+
+      procedure Put (Str : String) is
+         Saved : String (1 .. 80);
+         Len : Natural;
+      begin
+         if Ctx.Line_Len + Str'Length >= 80 then
+            if Ctx.Mark > 0 then
+               Len := Ctx.Line_Len - Ctx.Mark + 1;
+               Saved (1 .. Len) := Ctx.Line (Ctx.Mark .. Ctx.Line_Len);
+               Ctx.Line_Len := Ctx.Mark - 1;
+               Flush;
+               Put_Tab;
+               Ctx.Line (Ctx.Line_Len + 1 .. Ctx.Line_Len + Len) :=
+                 Saved (1 .. Len);
+               Ctx.Line_Len := Ctx.Line_Len + Len;
+            else
+               Flush;
+            end if;
+         end if;
+         if Ctx.Line_Len = 0 then
+            Put_Tab;
+         end if;
+         Ctx.Line (Ctx.Line_Len + 1 .. Ctx.Line_Len + Str'Length) := Str;
+         Ctx.Line_Len := Ctx.Line_Len + Str'Length;
+      end Put;
+
+      procedure Put_Trim (Str : String) is
+      begin
+         for I in Str'Range loop
+            if Str (I) /= ' ' then
+               Put (Str (I .. Str'Last));
+               return;
+            end if;
+         end loop;
+      end Put_Trim;
+
+      procedure Put_Line (Str : String) is
+      begin
+         Put (Str);
+         Flush;
+         Ctx.Next_Tab := Ctx.Tab;
+      end Put_Line;
+
+      procedure New_Line
+      is
+         Status : int;
+         pragma Unreferenced (Status);
+      begin
+         if Ctx.Line_Len > 0 then
+            Flush;
+         else
+            Status := fputc (Character'Pos (ASCII.LF), Ctx.File);
+         end if;
+         Ctx.Next_Tab := Ctx.Tab;
+      end New_Line;
+
+      procedure Put (C : Character)
+      is
+         S : constant String (1 .. 1) := (1 => C);
+      begin
+         Put (S);
+      end Put;
+
+      --  Add a tabulation.
+      --  Every new line will start at this tabulation.
+      procedure Add_Tab is
+      begin
+         Ctx.Tab := Ctx.Tab + 2;
+         Ctx.Next_Tab := Ctx.Tab;
+      end Add_Tab;
+
+      --  Removed a tabulation.
+      --  The next new line will start at the previous tabulation.
+      procedure Rem_Tab is
+      begin
+         Ctx.Tab := Ctx.Tab - 2;
+         Ctx.Next_Tab := Ctx.Tab;
+      end Rem_Tab;
+
+      procedure Set_Mark is
+      begin
+         Ctx.Mark := Ctx.Line_Len;
+      end Set_Mark;
+
+      procedure Flush_File is
+         Status : int;
+         pragma Unreferenced (Status);
+      begin
+         Flush;
+         Status := fflush (Ctx.File);
+      end Flush_File;
+   end Formated_Output;
+
+   use Formated_Output;
+
+   procedure Init_Context (File : Interfaces.C_Streams.FILEs) is
+   begin
+      Formated_Output.Init_Context (File);
+   end Init_Context;
+
+   procedure Disp_Enode (E : O_Enode; Etype : O_Tnode);
+   procedure Disp_Lnode (Node : O_Lnode);
+   procedure Disp_Snode (First, Last : O_Snode);
+   procedure Disp_Dnode (Decl : O_Dnode);
+   procedure Disp_Tnode (Atype : O_Tnode; Full : Boolean);
+
+   procedure Disp_Ident (Id : O_Ident) is
+   begin
+      Put (Get_String (Id));
+   end Disp_Ident;
+
+   procedure Disp_Tnode_Name (Atype : O_Tnode) is
+   begin
+      Disp_Tnode (Atype, False);
+   end Disp_Tnode_Name;
+
+   procedure Disp_Dnode_Name (Decl : O_Dnode) is
+   begin
+      Disp_Ident (Decl.Name);
+   end Disp_Dnode_Name;
+
+   procedure Disp_Loop_Name (Stmt : O_Snode) is
+   begin
+      Put ("loop" & Natural'Image (Stmt.Loop_Level));
+   end Disp_Loop_Name;
+
+   function Get_Enode_Name (Kind : OE_Kind) return String
+   is
+   begin
+      case Kind is
+--          when OE_Boolean_Lit =>
+--             return "boolean_lit";
+--          when OE_Unsigned_Lit =>
+--             return "unsigned_lit";
+--          when OE_Signed_Lit =>
+--             return "signed lit";
+--          when OE_Float_Lit =>
+--             return "float lit";
+--          when OE_Null_Lit =>
+--             return "null lit";
+--          when OE_Enum_Lit =>
+--             return "enum lit";
+
+--          when OE_Sizeof_Lit =>
+--             return "sizeof lit";
+--          when OE_Offsetof_Lit =>
+--             return "offsetof lit";
+--          when OE_Aggregate =>
+--             return "aggregate";
+--          when OE_Aggr_Element =>
+--             return "aggr_element";
+--          when OE_Union_Aggr =>
+--             return "union aggr";
+
+         when OE_Lit =>
+            return "lit";
+         when OE_Add_Ov =>
+            return "+#";
+         when OE_Sub_Ov =>
+            return "-#";
+         when OE_Mul_Ov =>
+            return "*#";
+         when OE_Div_Ov =>
+            return "/#";
+         when OE_Rem_Ov =>
+            return "rem#";
+         when OE_Mod_Ov =>
+            return "mod#";
+         when OE_Exp_Ov =>
+            return "**#";
+
+         when OE_And =>
+            return "and";
+         when OE_Or =>
+            return "or";
+         when OE_Xor =>
+            return "xor";
+         when OE_And_Then =>
+            return "and_then";
+         when OE_Or_Else =>
+            return "or_else";
+
+         when OE_Not =>
+            return "not";
+         when OE_Neg_Ov =>
+            return "-";
+         when OE_Abs_Ov =>
+            return "abs";
+
+         when OE_Eq =>
+            return "=";
+         when OE_Neq =>
+            return "/=";
+         when OE_Le =>
+            return "<=";
+         when OE_Lt =>
+            return "<";
+         when OE_Ge =>
+            return ">=";
+         when OE_Gt =>
+            return ">";
+
+         when OE_Function_Call =>
+            return "function call";
+         when OE_Convert_Ov =>
+            return "convert_ov";
+         when OE_Address =>
+            return "address";
+         when OE_Unchecked_Address =>
+            return "unchecked_address";
+--          when OE_Subprogram_Address =>
+--             return "subprg_address";
+         when OE_Alloca =>
+            return "alloca";
+         when OE_Value =>
+            return "value";
+         when OE_Nil =>
+            return "??";
+      end case;
+   end Get_Enode_Name;
+
+   function Get_Lnode_Name (Kind : OL_Kind) return String
+   is
+   begin
+      case Kind is
+         when OL_Obj =>
+            return "obj";
+         when OL_Indexed_Element =>
+            return "indexed_element";
+         when OL_Slice =>
+            return "slice";
+         when OL_Selected_Element =>
+            return "selected_element";
+         when OL_Access_Element =>
+            return "access_element";
+--          when OL_Param_Ref =>
+--             return "param_ref";
+--          when OL_Var_Ref =>
+--             return "var_ref";
+--          when OL_Const_Ref =>
+--             return "const_ref";
+      end case;
+   end Get_Lnode_Name;
+
+   pragma Unreferenced (Get_Lnode_Name);
+
+   procedure Disp_Enode_Name (Kind : OE_Kind) is
+   begin
+      Put (Get_Enode_Name (Kind));
+   end Disp_Enode_Name;
+
+   procedure Disp_Assoc_List (Head : O_Anode)
+   is
+      El : O_Anode;
+   begin
+      El := Head;
+      Put ("(");
+      if El /= null then
+         loop
+            Disp_Enode (El.Actual, El.Formal.Dtype);
+            El := El.Next;
+            exit when El = null;
+            Put (", ");
+         end loop;
+      end if;
+      Put (")");
+   end Disp_Assoc_List;
+
+   function Image (Lit : Integer) return String
+   is
+      S : constant String := Integer'Image (Lit);
+   begin
+      if S (1) = ' ' then
+         return S (2 .. S'Length);
+      else
+         return S;
+      end if;
+   end Image;
+
+   --  Disp STR as a literal for scalar type LIT_TYPE.
+   procedure Disp_Lit (Lit_Type : O_Tnode; Known : Boolean; Str : String) is
+   begin
+      if Known and not Disp_All_Types then
+         Put_Trim (Str);
+      else
+         Disp_Tnode_Name (Lit_Type);
+         Put ("'[");
+         Put_Trim (Str);
+         Put (']');
+      end if;
+   end Disp_Lit;
+
+   --  Display C. If CTYPE is set, this is the known type of C.
+   procedure Disp_Cnode (C : O_Cnode; Ctype : O_Tnode)
+   is
+      Known : constant Boolean := Ctype /= O_Tnode_Null;
+   begin
+      --  Sanity check.
+      if Known then
+         if Ctype /= C.Ctype then
+            raise Program_Error;
+         end if;
+      end if;
+
+      case C.Kind is
+         when OC_Unsigned_Lit =>
+            if False and then (C.U_Val >= Character'Pos(' ')
+                               and C.U_Val <= Character'Pos ('~'))
+            then
+               Put (''');
+               Put (Character'Val (C.U_Val));
+               Put (''');
+            else
+               Disp_Lit (C.Ctype, Known, Unsigned_64'Image (C.U_Val));
+            end if;
+         when OC_Signed_Lit =>
+            Disp_Lit (C.Ctype, Known, Integer_64'Image (C.S_Val));
+         when OC_Float_Lit =>
+            Disp_Lit (C.Ctype, Known, IEEE_Float_64'Image (C.F_Val));
+         when OC_Boolean_Lit =>
+            --  Always disp the type of boolean literals.
+            Disp_Lit (C.Ctype, False, Get_String (C.B_Id));
+         when OC_Null_Lit =>
+            --  Always disp the type of null literals.
+            Disp_Lit (C.Ctype, False, "null");
+         when OC_Enum_Lit =>
+            --  Always disp the type of enum literals.
+            Disp_Lit (C.Ctype, False, Get_String (C.E_Name));
+         when OC_Sizeof_Lit =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'sizeof (");
+            Disp_Tnode_Name (C.S_Type);
+            Put (")");
+         when OC_Alignof_Lit =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'alignof (");
+            Disp_Tnode_Name (C.S_Type);
+            Put (")");
+         when OC_Offsetof_Lit =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'offsetof (");
+            Disp_Tnode_Name (C.Off_Field.Parent);
+            Put (".");
+            Disp_Ident (C.Off_Field.Ident);
+            Put (")");
+         when OC_Aggregate =>
+            declare
+               El : O_Cnode;
+               El_Type : O_Tnode;
+               Field : O_Fnode;
+            begin
+               Put ('{');
+               El := C.Aggr_Els;
+               case C.Ctype.Kind is
+                  when ON_Record_Type =>
+                     Field := C.Ctype.Elements;
+                     El_Type := Field.Ftype;
+                  when ON_Array_Sub_Type =>
+                     Field := null;
+                     El_Type := C.Ctype.Base_Type.El_Type;
+                  when others =>
+                     raise Program_Error;
+               end case;
+               if El /= null then
+                  loop
+                     Set_Mark;
+                     if Field /= null then
+                        if Disp_All_Types then
+                           Put ('.');
+                           Disp_Ident (Field.Ident);
+                           Put (" = ");
+                        end if;
+                        El_Type := Field.Ftype;
+                        Field := Field.Next;
+                     end if;
+                     Disp_Cnode (El.Aggr_Value, El_Type);
+                     El := El.Aggr_Next;
+                     exit when El = null;
+                     Put (", ");
+                  end loop;
+               end if;
+               Put ('}');
+            end;
+         when OC_Aggr_Element =>
+            Disp_Cnode (C.Aggr_Value, Ctype);
+         when OC_Union_Aggr =>
+            Put ('{');
+            Put ('.');
+            Disp_Ident (C.Uaggr_Field.Ident);
+            Put (" = ");
+            Disp_Cnode (C.Uaggr_Value, C.Uaggr_Field.Ftype);
+            Put ('}');
+         when OC_Address =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'address (");
+            Disp_Dnode_Name (C.Decl);
+            Put (")");
+         when OC_Unchecked_Address =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'unchecked_address (");
+            Disp_Dnode_Name (C.Decl);
+            Put (")");
+         when OC_Subprogram_Address =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'subprg_addr (");
+            Disp_Dnode_Name (C.Decl);
+            Put (")");
+      end case;
+   end Disp_Cnode;
+
+   --  Disp E whose expected type is ETYPE (may not be set).
+   procedure Disp_Enode (E : O_Enode; Etype : O_Tnode)
+   is
+   begin
+      case E.Kind is
+         when OE_Lit =>
+            Disp_Cnode (E.Lit, Etype);
+         when OE_Dyadic_Expr_Kind =>
+            Put ("(");
+            Disp_Enode (E.Left, O_Tnode_Null);
+            Put (' ');
+            Disp_Enode_Name (E.Kind);
+            Put (' ');
+            Disp_Enode (E.Right, E.Left.Rtype);
+            Put (')');
+         when OE_Compare_Expr_Kind =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'(");
+            Disp_Enode (E.Left, O_Tnode_Null);
+            Put (' ');
+            Disp_Enode_Name (E.Kind);
+            Put (' ');
+            Disp_Enode (E.Right, E.Left.Rtype);
+            Put (')');
+         when OE_Monadic_Expr_Kind =>
+            Disp_Enode_Name (E.Kind);
+            if E.Kind /= OE_Neg_Ov then
+               Put (' ');
+            end if;
+            Disp_Enode (E.Operand, Etype);
+         when OE_Address =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'address (");
+            Disp_Lnode (E.Lvalue);
+            Put (")");
+         when OE_Unchecked_Address =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'unchecked_address (");
+            Disp_Lnode (E.Lvalue);
+            Put (")");
+         when OE_Convert_Ov =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'conv (");
+            Disp_Enode (E.Conv, O_Tnode_Null);
+            Put (')');
+         when OE_Function_Call =>
+            Disp_Dnode_Name (E.Func);
+            Put (' ');
+            Disp_Assoc_List (E.Assoc);
+         when OE_Alloca =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'alloca (");
+            Disp_Enode (E.A_Size, O_Tnode_Null);
+            Put (')');
+         when OE_Value =>
+            Disp_Lnode (E.Value);
+         when OE_Nil =>
+            null;
+      end case;
+   end Disp_Enode;
+
+   procedure Disp_Lnode (Node : O_Lnode) is
+   begin
+      case Node.Kind is
+         when OL_Obj =>
+            Disp_Dnode_Name (Node.Obj);
+         when OL_Access_Element =>
+            Disp_Enode (Node.Acc_Base, O_Tnode_Null);
+            Put (".all");
+         when OL_Indexed_Element =>
+            Disp_Lnode (Node.Array_Base);
+            Put ('[');
+            Disp_Enode (Node.Index, O_Tnode_Null);
+            Put (']');
+         when OL_Slice =>
+            Disp_Lnode (Node.Slice_Base);
+            Put ('[');
+            Disp_Enode (Node.Slice_Index, O_Tnode_Null);
+            Put ("...]");
+         when OL_Selected_Element =>
+            Disp_Lnode (Node.Rec_Base);
+            Put ('.');
+            Disp_Ident (Node.Rec_El.Ident);
+--          when OL_Var_Ref
+--            | OL_Const_Ref
+--            | OL_Param_Ref =>
+--             Disp_Dnode_Name (Node.Decl);
+      end case;
+   end Disp_Lnode;
+
+   procedure Disp_Fnodes (First : O_Fnode)
+   is
+      El : O_Fnode;
+   begin
+      Add_Tab;
+      El := First;
+      while El /= null loop
+         Disp_Ident (El.Ident);
+         Put (": ");
+         Disp_Tnode (El.Ftype, False);
+         Put_Line ("; ");
+         El := El.Next;
+      end loop;
+      Rem_Tab;
+   end Disp_Fnodes;
+
+   procedure Disp_Tnode (Atype : O_Tnode; Full : Boolean) is
+   begin
+      if not Full and Atype.Decl /= null then
+         Disp_Ident (Atype.Decl.Name);
+         return;
+      end if;
+      case Atype.Kind is
+         when ON_Boolean_Type =>
+            Put ("boolean {");
+            Disp_Ident (Atype.False_N.B_Id);
+            Put (", ");
+            Disp_Ident (Atype.True_N.B_Id);
+            Put ("}");
+         when ON_Unsigned_Type =>
+            Put ("unsigned (");
+            Put_Trim (Natural'Image (Atype.Int_Size));
+            Put (")");
+         when ON_Signed_Type =>
+            Put ("signed (");
+            Put_Trim (Natural'Image (Atype.Int_Size));
+            Put (")");
+         when ON_Float_Type =>
+            Put ("float");
+         when ON_Enum_Type =>
+            declare
+               El : O_Cnode;
+            begin
+               Put ("enum {");
+               El := Atype.Literals;
+               while El /= O_Cnode_Null loop
+                  Set_Mark;
+                  Disp_Ident (El.E_Name);
+                  Put (" = ");
+                  Put (Image (El.E_Val));
+                  El := El.E_Next;
+                  exit when El = O_Cnode_Null;
+                  Put (", ");
+               end loop;
+               Put ("}");
+            end;
+         when ON_Array_Type =>
+            Put ("array [");
+            Disp_Tnode (Atype.Index_Type, False);
+            Put ("] of ");
+            Disp_Tnode (Atype.El_Type, False);
+         when ON_Access_Type =>
+            Put ("access ");
+            if Atype.D_Type /= O_Tnode_Null then
+               Disp_Tnode (Atype.D_Type, False);
+            end if;
+         when ON_Record_Type =>
+            Put_Line ("record ");
+            Disp_Fnodes (Atype.Elements);
+            Put ("end record");
+         when ON_Union_Type =>
+            Put_Line ("union ");
+            Disp_Fnodes (Atype.Elements);
+            Put ("end union");
+         when ON_Array_Sub_Type =>
+            Put ("subarray ");
+            Disp_Tnode_Name (Atype.Base_Type);
+            Put ("[");
+            Disp_Cnode (Atype.Length, Atype.Base_Type.Index_Type);
+            Put ("]");
+      end case;
+   end Disp_Tnode;
+
+   procedure Disp_Storage_Name (Storage : O_Storage) is
+   begin
+      case Storage is
+         when O_Storage_External =>
+            Put ("external");
+         when O_Storage_Public =>
+            Put ("public");
+         when O_Storage_Private =>
+            Put ("private");
+         when O_Storage_Local =>
+            Put ("local");
+      end case;
+   end Disp_Storage_Name;
+
+   procedure Disp_Decls (Decls : O_Dnode)
+   is
+      El : O_Dnode;
+   begin
+      El := Decls;
+      while El /= null loop
+         Disp_Dnode (El);
+         El := El.Next;
+         if Is_Top then
+            -- NOTE: some declaration does not disp anything, so there may be
+            -- double new line.
+            New_Line;
+         end if;
+      end loop;
+   end Disp_Decls;
+
+   procedure Disp_Function_Decl (Decl : O_Dnode) is
+   begin
+      Disp_Storage_Name (Decl.Storage);
+      Put (" ");
+      if Decl.Dtype = null then
+         Put ("procedure ");
+      else
+         Put ("function ");
+      end if;
+      Disp_Ident (Decl.Name);
+      Put_Line (" (");
+      Add_Tab;
+      declare
+         El : O_Dnode;
+      begin
+         El := Decl.Interfaces;
+         if El /= null then
+            loop
+               Disp_Dnode (El);
+               El := El.Next;
+               exit when El = null;
+               Put_Line (";");
+            end loop;
+         end if;
+         Put (")");
+      end;
+      if Decl.Dtype /= null then
+         New_Line;
+         Put ("return ");
+         Disp_Tnode (Decl.Dtype, False);
+      end if;
+      Rem_Tab;
+   end Disp_Function_Decl;
+
+   procedure Disp_Dnode (Decl : O_Dnode) is
+   begin
+      case Decl.Kind is
+         when ON_Type_Decl =>
+            Put ("type ");
+            Disp_Ident (Decl.Name);
+            Put (" is ");
+            if not Decl.Dtype.Uncomplete then
+               Disp_Tnode (Decl.Dtype, True);
+            else
+               case Decl.Dtype.Kind is
+                  when ON_Record_Type =>
+                     Put ("record");
+                  when ON_Access_Type =>
+                     Put ("access");
+                  when others =>
+                     raise Program_Error;
+               end case;
+            end if;
+            Put_Line (";");
+         when ON_Completed_Type_Decl =>
+            Put ("type ");
+            Disp_Ident (Decl.Name);
+            Put (" is ");
+            Disp_Tnode (Decl.Dtype, True);
+            Put_Line (";");
+         when ON_Const_Decl =>
+            Disp_Storage_Name (Decl.Storage);
+            Put (" ");
+            Put ("constant ");
+            Disp_Ident (Decl.Name);
+            Put (" : ");
+            Disp_Tnode_Name (Decl.Dtype);
+            Put_Line (";");
+         when ON_Const_Value =>
+            Put ("constant ");
+            Disp_Ident (Decl.Name);
+            Put (" := ");
+            Disp_Cnode (Decl.Value, Decl.Dtype);
+            Put_Line (";");
+         when ON_Var_Decl =>
+            Disp_Storage_Name (Decl.Storage);
+            Put (" ");
+            Put ("var ");
+            Disp_Ident (Decl.Name);
+            Put (" : ");
+            Disp_Tnode_Name (Decl.Dtype);
+            Put_Line (";");
+         when ON_Function_Decl =>
+            if Decl.Next = null or Decl.Next /= Decl.Func_Body then
+               --  This is a forward/external declaration.
+               Disp_Function_Decl (Decl);
+               Put_Line (";");
+            end if;
+         when ON_Function_Body =>
+            Disp_Function_Decl (Decl.Func_Decl);
+            New_Line;
+            Disp_Snode (Decl.Func_Stmt, Decl.Func_Stmt);
+         when ON_Interface_Decl =>
+            Disp_Ident (Decl.Name);
+            Put (": ");
+            Disp_Tnode (Decl.Dtype, False);
+         when ON_Debug_Line_Decl =>
+            Put_Line ("--#" & Natural'Image (Decl.Line));
+         when ON_Debug_Comment_Decl =>
+            Put_Line ("-- " & Decl.Comment.all);
+         when ON_Debug_Filename_Decl =>
+            Put_Line ("--F " & Decl.Filename.all);
+      end case;
+   end Disp_Dnode;
+
+   procedure Disp_Snode (First : O_Snode; Last : O_Snode) is
+      Stmt : O_Snode;
+   begin
+      Stmt := First;
+      loop
+         --if Stmt.Kind = ON_Elsif_Stmt or Stmt.Kind = ON_When_Stmt then
+         --   Put_Indent (Tab - 1);
+         --else
+         --   Put_Indent (Tab);
+         --end if;
+         case Stmt.Kind is
+            when ON_Declare_Stmt =>
+               Put_Line ("declare");
+               Add_Tab;
+               Disp_Decls (Stmt.Decls);
+               Rem_Tab;
+               Put_Line ("begin");
+               Add_Tab;
+               if Stmt.Stmts /= null then
+                  Disp_Snode (Stmt.Stmts, null);
+               end if;
+               Rem_Tab;
+               Put_Line ("end;");
+            when ON_Assign_Stmt =>
+               Disp_Lnode (Stmt.Target);
+               Put (" := ");
+               Disp_Enode (Stmt.Value, Stmt.Target.Rtype);
+               Put_Line (";");
+            when ON_Return_Stmt =>
+               Put ("return ");
+               if Stmt.Ret_Val /= null then
+                  Disp_Enode (Stmt.Ret_Val, O_Tnode_Null);
+               end if;
+               Put_Line (";");
+            when ON_If_Stmt =>
+               Add_Tab;
+               Disp_Snode (Stmt.Next, Stmt.If_Last);
+               Stmt := Stmt.If_Last;
+               Rem_Tab;
+               Put_Line ("end if;");
+            when ON_Elsif_Stmt =>
+               Rem_Tab;
+               if Stmt.Cond = null then
+                  Put_Line ("else");
+               else
+                  if First = Stmt then
+                     Put ("if ");
+                  else
+                     Put ("elsif ");
+                  end if;
+                  Disp_Enode (Stmt.Cond, O_Tnode_Null);
+                  Put_Line (" then");
+               end if;
+               Add_Tab;
+            when ON_Loop_Stmt =>
+               Disp_Loop_Name (Stmt);
+               Put_Line (":");
+               Add_Tab;
+               Disp_Snode (Stmt.Next, Stmt.Loop_Last);
+               Stmt := Stmt.Loop_Last;
+               Rem_Tab;
+               Put_Line ("end loop;");
+            when ON_Exit_Stmt =>
+               Put ("exit ");
+               Disp_Loop_Name (Stmt.Loop_Id);
+               Put_Line (";");
+            when ON_Next_Stmt =>
+               Put ("next ");
+               Disp_Loop_Name (Stmt.Loop_Id);
+               Put_Line (";");
+            when ON_Case_Stmt =>
+               Put ("case ");
+               Disp_Enode (Stmt.Selector, O_Tnode_Null);
+               Put_Line (" is");
+               Add_Tab;
+               Disp_Snode (Stmt.Next, Stmt.Case_Last);
+               Stmt := Stmt.Case_Last;
+               Rem_Tab;
+               Put_Line ("end case;");
+            when ON_When_Stmt =>
+               declare
+                  Choice: O_Choice;
+                  Choice_Type : constant O_Tnode :=
+                    Stmt.Branch_Parent.Selector.Rtype;
+               begin
+                  Rem_Tab;
+                  Choice := Stmt.Choice_List;
+                  Put ("when ");
+                  loop
+                     case Choice.Kind is
+                        when ON_Choice_Expr =>
+                           Disp_Cnode (Choice.Expr, Choice_Type);
+                        when ON_Choice_Range =>
+                           Disp_Cnode (Choice.Low, Choice_Type);
+                           Put (" ... ");
+                           Disp_Cnode (Choice.High, Choice_Type);
+                        when ON_Choice_Default =>
+                           Put ("default");
+                     end case;
+                     Choice := Choice.Next;
+                     exit when Choice = null;
+                     Put_Line (",");
+                     Put ("     ");
+                  end loop;
+                  Put_Line (" =>");
+                  Add_Tab;
+               end;
+            when ON_Call_Stmt =>
+               Disp_Dnode_Name (Stmt.Proc);
+               Put (' ');
+               Disp_Assoc_List (Stmt.Assoc);
+               Put_Line (";");
+            when ON_Debug_Line_Stmt =>
+               Put_Line ("--#" & Natural'Image (Stmt.Line));
+            when ON_Debug_Comment_Stmt =>
+               Put_Line ("-- " & Stmt.Comment.all);
+         end case;
+         exit when Stmt = Last;
+         Stmt := Stmt.Next;
+         exit when Stmt = null and Last = null;
+      end loop;
+   end Disp_Snode;
+
+   procedure Disp_Ortho (Decls : O_Snode) is
+   begin
+      Disp_Decls (Decls.Decls);
+      Flush;
+   end Disp_Ortho;
+
+   procedure Disp_Tnode_Decl (N : O_Tnode) is
+   begin
+      Disp_Ident (N.Decl.Name);
+      Put (" : ");
+      Disp_Tnode (N, True);
+   end Disp_Tnode_Decl;
+
+   procedure Debug_Tnode (N : O_Tnode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Tnode_Decl (N);
+      Pop_Context (Ctx);
+   end Debug_Tnode;
+
+   procedure Debug_Enode (N : O_Enode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Enode (N, O_Tnode_Null);
+      Put (" : ");
+      Disp_Tnode_Decl (N.Rtype);
+      Pop_Context (Ctx);
+   end Debug_Enode;
+
+   procedure Debug_Fnode (N : O_Fnode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Ident (N.Ident);
+      Put (": ");
+      Disp_Tnode (N.Ftype, False);
+      Pop_Context (Ctx);
+   end Debug_Fnode;
+
+   procedure Debug_Dnode (N : O_Dnode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Dnode (N);
+      Pop_Context (Ctx);
+   end Debug_Dnode;
+
+   procedure Debug_Lnode (N : O_Lnode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Lnode (N);
+      Put (" : ");
+      Disp_Tnode_Decl (N.Rtype);
+      Pop_Context (Ctx);
+   end Debug_Lnode;
+
+   procedure Debug_Snode (N : O_Snode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Snode (N, null);
+      Pop_Context (Ctx);
+   end Debug_Snode;
+
+   pragma Unreferenced (Debug_Tnode, Debug_Enode, Debug_Fnode,
+                        Debug_Dnode, Debug_Lnode, Debug_Snode);
+end Ortho_Debug.Disp;
diff --git a/src/ortho/debug/ortho_debug-disp.ads b/src/ortho/debug/ortho_debug-disp.ads
new file mode 100644
index 000000000..c365a3530
--- /dev/null
+++ b/src/ortho/debug/ortho_debug-disp.ads
@@ -0,0 +1,29 @@
+--  Display the ortho codes from a tree.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces.C_Streams;
+
+package Ortho_Debug.Disp is
+   --  Initialize the current context.
+   --  Must be called before any use of the DISP_* subprograms.
+   procedure Init_Context (File : Interfaces.C_Streams.FILEs);
+
+   --  Disp nodes in a pseudo-language.
+   procedure Disp_Ortho (Decls : O_Snode);
+
+private
+end Ortho_Debug.Disp;
diff --git a/src/ortho/debug/ortho_debug-main.adb b/src/ortho/debug/ortho_debug-main.adb
new file mode 100644
index 000000000..b470deaab
--- /dev/null
+++ b/src/ortho/debug/ortho_debug-main.adb
@@ -0,0 +1,151 @@
+--  Main procedure of ortho debug back-end.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Unchecked_Deallocation;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ortho_Debug; use Ortho_Debug;
+with Ortho_Debug_Front; use Ortho_Debug_Front;
+with Ortho_Debug.Disp;
+with System; use System;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
+
+procedure Ortho_Debug.Main is
+   --  Do not output the ortho code.
+   Flag_Silent : Boolean := False;
+
+   --  Force output, even in case of crash.
+   Flag_Force : Boolean := False;
+
+   I : Natural;
+   Argc : Natural;
+   Arg : String_Acc;
+   Opt : String_Acc;
+   Res : Natural;
+   File : String_Acc;
+   Output : FILEs;
+   R : Boolean;
+
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => String_Acc, Object => String);
+begin
+   Ortho_Debug_Front.Init;
+   Output := NULL_Stream;
+
+   Set_Exit_Status (Failure);
+
+   --  Decode options.
+   Argc := Argument_Count;
+   I := 1;
+   loop
+      exit when I > Argc;
+      exit when Argument (I) (1) /= '-';
+      if Argument (I) = "--silent" or else Argument (I) = "-quiet" then
+         Flag_Silent := True;
+         I := I + 1;
+      elsif Argument (I) = "--force" then
+         Flag_Force := True;
+         I := I + 1;
+      elsif Argument (I)'Length >= 2 and then Argument (I)(2) = 'g' then
+         --  Skip -g[XXX] flags.
+         I := I + 1;
+      elsif Argument (I) = "-o" and then I + 1 <= Argc then
+         --  TODO: write the output to the file ?
+         if Output /= NULL_Stream then
+            Put_Line (Command_Name & ": only one output allowed");
+            return;
+         end if;
+         declare
+            Name : String := Argument (I + 1) & ASCII.Nul;
+            Mode : String := 'w' & ASCII.Nul;
+         begin
+            Output := fopen (Name'Address, Mode'Address);
+            if Output = NULL_Stream then
+               Put_Line (Command_Name & ": cannot open " & Argument (I + 1));
+               return;
+            end if;
+         end;
+         I := I + 2;
+      else
+         Opt := new String'(Argument (I));
+         if I < Argc then
+            Arg := new String'(Argument (I + 1));
+         else
+            Arg := null;
+         end if;
+         Res := Ortho_Debug_Front.Decode_Option (Opt, Arg);
+         Unchecked_Deallocation (Opt);
+         Unchecked_Deallocation (Arg);
+         if Res = 0 then
+            Put_Line (Argument (I) & ": unknown option");
+            return;
+         else
+            I := I + Res;
+         end if;
+      end if;
+   end loop;
+
+   --  Initialize tree.
+   begin
+      Ortho_Debug.Init;
+
+      if I <= Argc then
+         R := True;
+         for J in I .. Argc loop
+            File := new String'(Argument (J));
+            R := R and Ortho_Debug_Front.Parse (File);
+            Unchecked_Deallocation (File);
+         end loop;
+      else
+         R := Ortho_Debug_Front.Parse (null);
+      end if;
+      Ortho_Debug.Finish;
+   exception
+      when others =>
+         if not Flag_Force then
+            raise;
+         else
+            R := False;
+         end if;
+   end;
+
+   --  Write down the result.
+   if (R and (Output /= NULL_Stream or not Flag_Silent))
+     or Flag_Force
+   then
+      if Output = NULL_Stream then
+         Ortho_Debug.Disp.Init_Context (stdout);
+      else
+         Ortho_Debug.Disp.Init_Context (Output);
+      end if;
+      Ortho_Debug.Disp.Disp_Ortho (Ortho_Debug.Top);
+      if Output /= NULL_Stream then
+         declare
+            Status : int;
+            pragma Unreferenced (Status);
+         begin
+            Status := fclose (Output);
+         end;
+      end if;
+   end if;
+
+   if R then
+      Set_Exit_Status (Success);
+   else
+      Set_Exit_Status (Failure);
+   end if;
+end Ortho_Debug.Main;
diff --git a/src/ortho/debug/ortho_debug.adb b/src/ortho/debug/ortho_debug.adb
new file mode 100644
index 000000000..8285a6473
--- /dev/null
+++ b/src/ortho/debug/ortho_debug.adb
@@ -0,0 +1,1931 @@
+--  Ortho debug back-end.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Unchecked_Deallocation;
+
+package body Ortho_Debug is
+   --  If True, disable some checks so that the output can be generated.
+   Disable_Checks : constant Boolean := False;
+
+   type ON_Op_To_OE_Type is array (ON_Op_Kind) of OE_Kind;
+   ON_Op_To_OE : constant ON_Op_To_OE_Type :=
+     (
+      ON_Nil => OE_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov => OE_Add_Ov,
+      ON_Sub_Ov => OE_Sub_Ov,
+      ON_Mul_Ov => OE_Mul_Ov,
+      ON_Div_Ov => OE_Div_Ov,
+      ON_Rem_Ov => OE_Rem_Ov,
+      ON_Mod_Ov => OE_Mod_Ov,
+
+      --  Binary operations.
+      ON_And => OE_And,
+      ON_Or => OE_Or,
+      ON_Xor => OE_Xor,
+
+      --  Monadic operations.
+      ON_Not => OE_Not,
+      ON_Neg_Ov => OE_Neg_Ov,
+      ON_Abs_Ov => OE_Abs_Ov,
+
+      --  Comparaisons
+      ON_Eq => OE_Eq,
+      ON_Neq => OE_Neq,
+      ON_Le => OE_Le,
+      ON_Lt => OE_Lt,
+      ON_Ge => OE_Ge,
+      ON_Gt => OE_Gt
+      );
+
+   type Decl_Scope_Type is record
+      --  Declarations are chained.
+      Parent : O_Snode;
+      Last_Decl : O_Dnode;
+      Last_Stmt : O_Snode;
+
+      --  If this scope corresponds to a function, PREV_FUNCTION contains
+      --  the previous function.
+      Prev_Function : O_Dnode;
+
+      --  Declaration scopes are chained.
+      Prev : Decl_Scope_Acc;
+   end record;
+
+   type Stmt_Kind is
+     (Stmt_Function, Stmt_Declare, Stmt_If, Stmt_Loop, Stmt_Case);
+   type Stmt_Scope_Type (Kind : Stmt_Kind);
+   type Stmt_Scope_Acc is access Stmt_Scope_Type;
+   type Stmt_Scope_Type (Kind : Stmt_Kind) is record
+      --  Statement which created this scope.
+      Parent : O_Snode;
+      --  Previous (parent) scope.
+      Prev : Stmt_Scope_Acc;
+      case Kind is
+         when Stmt_Function =>
+            Prev_Function : Stmt_Scope_Acc;
+            --  Declaration for the function.
+            Decl : O_Dnode;
+         when Stmt_Declare =>
+            null;
+         when Stmt_If =>
+            Last_Elsif : O_Snode;
+         when Stmt_Loop =>
+            null;
+         when Stmt_Case =>
+            Last_Branch : O_Snode;
+            Last_Choice : O_Choice;
+            Case_Type : O_Tnode;
+      end case;
+   end record;
+   subtype Stmt_Function_Scope_Type is Stmt_Scope_Type (Stmt_Function);
+   subtype Stmt_Declare_Scope_Type is Stmt_Scope_Type (Stmt_Declare);
+   subtype Stmt_If_Scope_Type is Stmt_Scope_Type (Stmt_If);
+   subtype Stmt_Loop_Scope_Type is Stmt_Scope_Type (Stmt_Loop);
+   subtype Stmt_Case_Scope_Type is Stmt_Scope_Type (Stmt_Case);
+
+   Current_Stmt_Scope : Stmt_Scope_Acc := null;
+   Current_Function : Stmt_Scope_Acc := null;
+   Current_Decl_Scope : Decl_Scope_Acc := null;
+   Current_Loop_Level : Natural := 0;
+
+   procedure Push_Decl_Scope (Parent : O_Snode)
+   is
+      Res : Decl_Scope_Acc;
+   begin
+      Res := new Decl_Scope_Type'(Parent => Parent,
+                                  Last_Decl => null,
+                                  Last_Stmt => null,
+                                  Prev_Function => null,
+                                  Prev => Current_Decl_Scope);
+      Parent.Alive := True;
+      Current_Decl_Scope := Res;
+   end Push_Decl_Scope;
+
+   procedure Pop_Decl_Scope
+   is
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Object => Decl_Scope_Type, Name => Decl_Scope_Acc);
+      Old : Decl_Scope_Acc;
+   begin
+      Old := Current_Decl_Scope;
+      Old.Parent.Alive := False;
+      Current_Decl_Scope := Old.Prev;
+      Unchecked_Deallocation (Old);
+   end Pop_Decl_Scope;
+
+   procedure Add_Decl (El : O_Dnode; Check_Dup : Boolean := True) is
+   begin
+      if Current_Decl_Scope = null then
+         --  Not yet initialized, or after compilation.
+         raise Program_Error;
+      end if;
+
+      --  Note: this requires an hashed ident table.
+      --  Use ortho_ident_hash.
+      if False and then Check_Dup
+        and then not Is_Nul (El.Name)
+      then
+         --  Check the name is not already defined.
+         declare
+            E : O_Dnode;
+         begin
+            E := Current_Decl_Scope.Parent.Decls;
+            while E /= O_Dnode_Null loop
+               if Is_Equal (E.Name, El.Name) then
+                  raise Syntax_Error;
+               end if;
+               E := E.Next;
+            end loop;
+         end;
+      end if;
+
+      if Current_Decl_Scope.Last_Decl = null then
+         if Current_Decl_Scope.Parent.Kind = ON_Declare_Stmt then
+            Current_Decl_Scope.Parent.Decls := El;
+         else
+            raise Type_Error;
+         end if;
+      else
+         Current_Decl_Scope.Last_Decl.Next := El;
+      end if;
+      El.Next := null;
+      Current_Decl_Scope.Last_Decl := El;
+   end Add_Decl;
+
+   procedure Add_Stmt (Stmt : O_Snode)
+   is
+   begin
+      if Current_Decl_Scope = null or Current_Function = null then
+         --  You are adding a statement at the global level, ie not inside
+         --  a function.
+         raise Syntax_Error;
+      end if;
+
+      Stmt.Next := null;
+      if Current_Decl_Scope.Last_Stmt = null then
+         if Current_Decl_Scope.Parent.Kind = ON_Declare_Stmt then
+            Current_Decl_Scope.Parent.Stmts := Stmt;
+         else
+            raise Syntax_Error;
+         end if;
+      else
+         Current_Decl_Scope.Last_Stmt.Next := Stmt;
+      end if;
+      Current_Decl_Scope.Last_Stmt := Stmt;
+   end Add_Stmt;
+
+   procedure Push_Stmt_Scope (Scope : Stmt_Scope_Acc)
+   is
+   begin
+      if Scope.Prev /= Current_Stmt_Scope then
+         --  SCOPE was badly initialized.
+         raise Program_Error;
+      end if;
+      Current_Stmt_Scope := Scope;
+   end Push_Stmt_Scope;
+
+   procedure Pop_Stmt_Scope (Kind : Stmt_Kind)
+   is
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Object => Stmt_Scope_Type, Name => Stmt_Scope_Acc);
+      Old : Stmt_Scope_Acc;
+   begin
+      Old := Current_Stmt_Scope;
+      if Old.Kind /= Kind then
+         raise Syntax_Error;
+      end if;
+      --Old.Parent.Last_Stmt := Current_Decl_Scope.Last_Stmt;
+      Current_Stmt_Scope := Old.Prev;
+      Unchecked_Deallocation (Old);
+   end Pop_Stmt_Scope;
+
+   --  Check declaration DECL is reachable, ie its scope is in the current
+   --  stack of scopes.
+   procedure Check_Scope (Decl : O_Dnode)
+   is
+      Res : Boolean;
+   begin
+      case Decl.Kind is
+         when ON_Interface_Decl =>
+            Res := Decl.Func_Scope.Alive;
+         when others =>
+            Res := Decl.Scope.Alive;
+      end case;
+      if not Res then
+         raise Syntax_Error;
+      end if;
+   end Check_Scope;
+
+   --  Raise SYNTAX_ERROR if OBJ is not at a constant address.
+--    procedure Check_Const_Address (Obj : O_Lnode) is
+--    begin
+--       case Obj.Kind is
+--          when OL_Const_Ref
+--            | OL_Var_Ref =>
+--             case Obj.Decl.Storage is
+--                when O_Storage_External
+--                  | O_Storage_Public
+--                  | O_Storage_Private =>
+--                   null;
+--                when O_Storage_Local =>
+--                   raise Syntax_Error;
+--             end case;
+--          when others =>
+--             --  FIXME: constant indexed element, selected element maybe
+--             --   of const address.
+--             raise Syntax_Error;
+--       end case;
+--    end Check_Const_Address;
+
+   procedure Check_Type (T1, T2 : O_Tnode) is
+   begin
+      if T1 = T2 then
+         return;
+      end if;
+      if T1.Kind = ON_Array_Sub_Type and then T2.Kind = ON_Array_Sub_Type
+        and then T1.Base_Type = T2.Base_Type
+        and then T1.Length.all = T2.Length.all
+      then
+         return;
+      end if;
+      raise Type_Error;
+   end Check_Type;
+
+   procedure Check_Ref (N : O_Enode) is
+   begin
+      if N.Ref then
+         --  Already referenced.
+         raise Syntax_Error;
+      end if;
+      N.Ref := True;
+   end Check_Ref;
+
+   procedure Check_Ref (N : O_Lnode) is
+   begin
+      if N.Ref then
+         raise Syntax_Error;
+      end if;
+      N.Ref := True;
+   end Check_Ref;
+
+   procedure Check_Complete_Type (T : O_Tnode) is
+   begin
+      if not T.Complete then
+         --  Uncomplete type cannot be used here (since its size is required,
+         --   for example).
+         raise Syntax_Error;
+      end if;
+   end Check_Complete_Type;
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode
+   is
+      K : constant OE_Kind := ON_Op_To_OE (Kind);
+      Res : O_Enode;
+   begin
+      Check_Type (Left.Rtype, Right.Rtype);
+      Check_Ref (Left);
+      Check_Ref (Right);
+      Res := new O_Enode_Type (K);
+      Res.Rtype := Left.Rtype;
+      Res.Ref := False;
+      Res.Left := Left;
+      Res.Right := Right;
+      return Res;
+   end New_Dyadic_Op;
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode
+   is
+      Res : O_Enode;
+   begin
+      Check_Ref (Operand);
+      Res := new O_Enode_Type (ON_Op_To_OE (Kind));
+      Res.Ref := False;
+      Res.Operand := Operand;
+      Res.Rtype := Operand.Rtype;
+      return Res;
+   end New_Monadic_Op;
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode
+   is
+      Res : O_Enode;
+   begin
+      if Ntype.Kind /= ON_Boolean_Type then
+         raise Type_Error;
+      end if;
+      if Left.Rtype /= Right.Rtype then
+         raise Type_Error;
+      end if;
+      Check_Ref (Left);
+      Check_Ref (Right);
+      Res := new O_Enode_Type (ON_Op_To_OE (Kind));
+      Res.Ref := False;
+      Res.Left := Left;
+      Res.Right := Right;
+      Res.Rtype := Ntype;
+      return Res;
+   end New_Compare_Op;
+
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode
+   is
+      subtype O_Cnode_Signed_Lit is O_Cnode_Type (OC_Signed_Lit);
+   begin
+      if Ltype.Kind = ON_Signed_Type then
+         return new O_Cnode_Signed_Lit'(Kind => OC_Signed_Lit,
+                                        Ctype => Ltype,
+                                        Ref => False,
+                                        S_Val => Value);
+      else
+         raise Type_Error;
+      end if;
+   end New_Signed_Literal;
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode
+   is
+      subtype O_Cnode_Unsigned_Lit is O_Cnode_Type (OC_Unsigned_Lit);
+   begin
+      if Ltype.Kind = ON_Unsigned_Type then
+         return new O_Cnode_Unsigned_Lit'(Kind => OC_Unsigned_Lit,
+                                          Ctype => Ltype,
+                                          Ref => False,
+                                          U_Val => Value);
+      else
+         raise Type_Error;
+      end if;
+   end New_Unsigned_Literal;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode
+   is
+      subtype O_Cnode_Float_Lit is O_Cnode_Type (OC_Float_Lit);
+   begin
+      if Ltype.Kind = ON_Float_Type then
+         return new O_Cnode_Float_Lit'(Kind => OC_Float_Lit,
+                                       Ctype => Ltype,
+                                       Ref => False,
+                                       F_Val => Value);
+      else
+         raise Type_Error;
+      end if;
+   end New_Float_Literal;
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Null_Lit_Type is O_Cnode_Type (OC_Null_Lit);
+   begin
+      if Ltype.Kind /= ON_Access_Type then
+         raise Type_Error;
+      end if;
+      return  new O_Cnode_Null_Lit_Type'(Kind => OC_Null_Lit,
+                                         Ctype => Ltype,
+                                         Ref => False);
+   end New_Null_Access;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Sizeof_Type is O_Cnode_Type (OC_Sizeof_Lit);
+   begin
+      if Rtype.Kind /= ON_Unsigned_Type
+        and then Rtype.Kind /= ON_Access_Type
+      then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      if Atype.Kind = ON_Array_Type then
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Sizeof_Type'(Kind => OC_Sizeof_Lit,
+                                      Ctype => Rtype,
+                                      Ref => False,
+                                      S_Type => Atype);
+   end New_Sizeof;
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Alignof_Type is O_Cnode_Type (OC_Alignof_Lit);
+   begin
+      if Rtype.Kind /= ON_Unsigned_Type then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      return new O_Cnode_Alignof_Type'(Kind => OC_Alignof_Lit,
+                                       Ctype => Rtype,
+                                       Ref => False,
+                                       S_Type => Atype);
+   end New_Alignof;
+
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode
+   is
+      subtype O_Cnode_Offsetof_Type is O_Cnode_Type (OC_Offsetof_Lit);
+   begin
+      if Rtype.Kind /= ON_Unsigned_Type
+        and then Rtype.Kind /= ON_Access_Type
+      then
+         raise Type_Error;
+      end if;
+      if Field.Parent /= Atype then
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Offsetof_Type'(Kind => OC_Offsetof_Lit,
+                                        Ctype => Rtype,
+                                        Ref => False,
+                                        Off_Field => Field);
+   end New_Offsetof;
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      subtype O_Enode_Alloca_Type is O_Enode_Type (OE_Alloca);
+      Res : O_Enode;
+   begin
+      if Rtype.Kind /= ON_Access_Type then
+         raise Type_Error;
+      end if;
+      if Size.Rtype.Kind /= ON_Unsigned_Type then
+         raise Type_Error;
+      end if;
+      Res := new O_Enode_Alloca_Type'(Kind => OE_Alloca,
+                                      Rtype => Rtype,
+                                      Ref => False,
+                                      A_Size => Size);
+      return Res;
+   end New_Alloca;
+
+   procedure Check_Constrained_Type (Atype : O_Tnode) is
+   begin
+      case Atype.Kind is
+         when ON_Array_Type =>
+            raise Type_Error;
+         when ON_Unsigned_Type
+           | ON_Signed_Type
+           | ON_Boolean_Type
+           | ON_Record_Type
+           | ON_Union_Type
+           | ON_Access_Type
+           | ON_Float_Type
+           | ON_Array_Sub_Type
+           | ON_Enum_Type =>
+            null;
+      end case;
+   end Check_Constrained_Type;
+
+   procedure New_Completed_Type_Decl (Atype : O_Tnode)
+   is
+      N : O_Dnode;
+   begin
+      if Atype.Decl = null then
+         --  The uncompleted type must have been declared.
+         raise Type_Error;
+      end if;
+      N := new O_Dnode_Type (ON_Completed_Type_Decl);
+      N.Name := Atype.Decl.Name;
+      N.Dtype := Atype;
+      Add_Decl (N, False);
+   end New_Completed_Type_Decl;
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode)
+   is
+      subtype O_Tnode_Record_Type is O_Tnode_Type (ON_Record_Type);
+   begin
+      Res := new O_Tnode_Record_Type'(Kind => ON_Record_Type,
+                                      Decl => O_Dnode_Null,
+                                      Uncomplete => True,
+                                      Complete => False,
+                                      Elements => O_Fnode_Null);
+   end New_Uncomplete_Record_Type;
+
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List) is
+   begin
+      if not Res.Uncomplete then
+         --  RES record type is not an uncomplete record type.
+         raise Syntax_Error;
+      end if;
+      if Res.Elements /= O_Fnode_Null then
+         --  RES record type already has elements...
+         raise Syntax_Error;
+      end if;
+      Elements.Res := Res;
+      Elements.Last := null;
+   end Start_Uncomplete_Record_Type;
+
+   procedure Start_Record_Type (Elements : out O_Element_List)
+   is
+      subtype O_Tnode_Record_Type is O_Tnode_Type (ON_Record_Type);
+   begin
+      Elements.Res := new O_Tnode_Record_Type'(Kind => ON_Record_Type,
+                                               Decl => O_Dnode_Null,
+                                               Uncomplete => False,
+                                               Complete => False,
+                                               Elements => O_Fnode_Null);
+      Elements.Last := null;
+   end Start_Record_Type;
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+   is
+   begin
+      Check_Complete_Type (Etype);
+      Check_Constrained_Type (Etype);
+      El := new O_Fnode_Type'(Parent => Elements.Res,
+                              Next => null,
+                              Ident => Ident,
+                              Ftype => Etype,
+                              Offset => 0);
+      --  Append EL.
+      if Elements.Last = null then
+         Elements.Res.Elements := El;
+      else
+         Elements.Last.Next := El;
+      end if;
+      Elements.Last := El;
+   end New_Record_Field;
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      --  Align the structure.
+      Res := Elements.Res;
+      if Res.Uncomplete then
+         New_Completed_Type_Decl (Res);
+      end if;
+      Res.Complete := True;
+   end Finish_Record_Type;
+
+   procedure Start_Union_Type (Elements : out O_Element_List)
+   is
+      subtype O_Tnode_Union_Type is O_Tnode_Type (ON_Union_Type);
+   begin
+      Elements.Res := new O_Tnode_Union_Type'(Kind => ON_Union_Type,
+                                              Decl => O_Dnode_Null,
+                                              Uncomplete => False,
+                                              Complete => False,
+                                              Elements => O_Fnode_Null);
+      Elements.Last := null;
+   end Start_Union_Type;
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+   is
+   begin
+      New_Record_Field (Elements, El, Ident, Etype);
+   end New_Union_Field;
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Res := Elements.Res;
+      Res.Complete := True;
+   end Finish_Union_Type;
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode
+   is
+      subtype O_Tnode_Access is O_Tnode_Type (ON_Access_Type);
+      Res : O_Tnode;
+   begin
+      if Dtype /= O_Tnode_Null
+        and then Dtype.Kind = ON_Array_Sub_Type
+      then
+         --  Access to sub array are not allowed, use access to array.
+         raise Type_Error;
+      end if;
+      Res := new O_Tnode_Access'(Kind => ON_Access_Type,
+                                 Decl => O_Dnode_Null,
+                                 Uncomplete => Dtype = O_Tnode_Null,
+                                 Complete => True,
+                                 D_Type => Dtype);
+      return Res;
+   end New_Access_Type;
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode)
+   is
+   begin
+      if Dtype.Kind = ON_Array_Sub_Type then
+         --  Access to sub array are not allowed, use access to array.
+         raise Type_Error;
+      end if;
+      if Atype.D_Type /= O_Tnode_Null
+        or Atype.Uncomplete = False
+      then
+         --  Type already completed.
+         raise Syntax_Error;
+      end if;
+      Atype.D_Type := Dtype;
+      New_Completed_Type_Decl (Atype);
+   end Finish_Access_Type;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode
+   is
+      subtype O_Tnode_Array is O_Tnode_Type (ON_Array_Type);
+   begin
+      Check_Constrained_Type (El_Type);
+      Check_Complete_Type (El_Type);
+      return new O_Tnode_Array'(Kind => ON_Array_Type,
+                                Decl => O_Dnode_Null,
+                                Uncomplete => False,
+                                Complete => True,
+                                El_Type => El_Type,
+                                Index_Type => Index_Type);
+   end New_Array_Type;
+
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode
+   is
+      subtype O_Tnode_Sub_Array is O_Tnode_Type (ON_Array_Sub_Type);
+   begin
+      if Atype.Kind /= ON_Array_Type then
+         raise Type_Error;
+      end if;
+      return new O_Tnode_Sub_Array'(Kind => ON_Array_Sub_Type,
+                                    Decl => O_Dnode_Null,
+                                    Uncomplete => False,
+                                    Complete => True,
+                                    Base_Type => Atype,
+                                    Length => Length);
+   end New_Constrained_Array_Type;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode
+   is
+      subtype O_Tnode_Unsigned is O_Tnode_Type (ON_Unsigned_Type);
+   begin
+      return new O_Tnode_Unsigned'(Kind => ON_Unsigned_Type,
+                                   Decl => O_Dnode_Null,
+                                   Uncomplete => False,
+                                   Complete => True,
+                                   Int_Size => Size);
+   end New_Unsigned_Type;
+
+   function New_Signed_Type (Size : Natural) return O_Tnode
+   is
+      subtype O_Tnode_Signed is O_Tnode_Type (ON_Signed_Type);
+   begin
+      return new O_Tnode_Signed'(Kind => ON_Signed_Type,
+                                 Decl => O_Dnode_Null,
+                                 Uncomplete => False,
+                                 Complete => True,
+                                 Int_Size => Size);
+   end New_Signed_Type;
+
+   function New_Float_Type return O_Tnode
+   is
+      subtype O_Tnode_Float is O_Tnode_Type (ON_Float_Type);
+   begin
+      return new O_Tnode_Float'(Kind => ON_Float_Type,
+                                Decl => O_Dnode_Null,
+                                Uncomplete => False,
+                                Complete => True);
+   end New_Float_Type;
+
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode)
+   is
+      subtype O_Tnode_Boolean is O_Tnode_Type (ON_Boolean_Type);
+      subtype O_Cnode_Boolean_Lit is O_Cnode_Type (OC_Boolean_Lit);
+   begin
+      Res := new O_Tnode_Boolean'(Kind => ON_Boolean_Type,
+                                  Decl => O_Dnode_Null,
+                                  Uncomplete => False,
+                                  Complete => True,
+                                  True_N => O_Cnode_Null,
+                                  False_N => O_Cnode_Null);
+      True_E := new O_Cnode_Boolean_Lit'(Kind => OC_Boolean_Lit,
+                                         Ctype => Res,
+                                         Ref => False,
+                                         B_Val => True,
+                                         B_Id => True_Id);
+      False_E := new O_Cnode_Boolean_Lit'(Kind => OC_Boolean_Lit,
+                                          Ctype => Res,
+                                          Ref => False,
+                                          B_Val => False,
+                                          B_Id => False_Id);
+      Res.True_N := True_E;
+      Res.False_N := False_E;
+   end New_Boolean_Type;
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+      pragma Unreferenced (Size);
+      subtype O_Tnode_Enum is O_Tnode_Type (ON_Enum_Type);
+      Res : O_Tnode;
+   begin
+      Res := new O_Tnode_Enum'(Kind => ON_Enum_Type,
+                               Decl => O_Dnode_Null,
+                               Uncomplete => False,
+                               Complete => False,
+                               Nbr => 0,
+                               Literals => O_Cnode_Null);
+      List.Res := Res;
+      List.Last := O_Cnode_Null;
+   end Start_Enum_Type;
+
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident;
+                               Res : out O_Cnode)
+   is
+      subtype O_Cnode_Enum_Lit is O_Cnode_Type (OC_Enum_Lit);
+   begin
+      Res := new O_Cnode_Enum_Lit'(Kind => OC_Enum_Lit,
+                                   Ctype => List.Res,
+                                   Ref => False,
+                                   E_Val => List.Res.Nbr,
+                                   E_Name => Ident,
+                                   E_Next => O_Cnode_Null);
+      --  Link it.
+      if List.Last = O_Cnode_Null then
+         List.Res.Literals := Res;
+      else
+         List.Last.E_Next := Res;
+      end if;
+      List.Last := Res;
+
+      List.Res.Nbr := List.Res.Nbr + 1;
+   end New_Enum_Literal;
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := List.Res;
+      Res.Complete := True;
+   end Finish_Enum_Type;
+
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode
+   is
+   begin
+      case Atype.Kind is
+         when ON_Array_Sub_Type =>
+            return Atype.Base_Type;
+         when others =>
+            return Atype;
+      end case;
+   end Get_Base_Type;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List; Atype : O_Tnode)
+   is
+      subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Aggregate);
+      Res : O_Cnode;
+   begin
+      if Atype.Kind /= ON_Record_Type then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      Res := new O_Cnode_Aggregate'(Kind => OC_Aggregate,
+                                    Ctype => Atype,
+                                    Ref => False,
+                                    Aggr_Els => null);
+      List.Res := Res;
+      List.Last := null;
+      List.Field := Atype.Elements;
+   end Start_Record_Aggr;
+
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode)
+   is
+      subtype O_Cnode_Aggrel_Type is O_Cnode_Type (OC_Aggr_Element);
+      El : O_Cnode;
+   begin
+      if List.Field = O_Fnode_Null then
+         --  No more element in the aggregate.
+         raise Syntax_Error;
+      end if;
+      Check_Type (Value.Ctype, List.Field.Ftype);
+      El := new O_Cnode_Aggrel_Type'(Kind => OC_Aggr_Element,
+                                     Ctype => Value.Ctype,
+                                     Ref => False,
+                                     Aggr_Value => Value,
+                                     Aggr_Next => null);
+      if List.Last = null then
+         List.Res.Aggr_Els := El;
+      else
+         List.Last.Aggr_Next := El;
+      end if;
+      List.Last := El;
+      List.Field := List.Field.Next;
+   end New_Record_Aggr_El;
+
+   procedure Finish_Record_Aggr
+     (List : in out O_Record_Aggr_List; Res : out O_Cnode)
+   is
+   begin
+      if List.Field /= null then
+         --  Not enough elements in aggregate.
+         raise Type_Error;
+      end if;
+      Res := List.Res;
+   end Finish_Record_Aggr;
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode)
+   is
+      subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Aggregate);
+      Res : O_Cnode;
+   begin
+      if Atype.Kind /= ON_Array_Sub_Type then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      Res := new O_Cnode_Aggregate'(Kind => OC_Aggregate,
+                                    Ctype => Atype,
+                                    Ref => False,
+                                    Aggr_Els => null);
+      List.Res := Res;
+      List.Last := null;
+      List.El_Type := Atype.Base_Type.El_Type;
+   end Start_Array_Aggr;
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode)
+   is
+      subtype O_Cnode_Aggrel_Type is O_Cnode_Type (OC_Aggr_Element);
+      El : O_Cnode;
+   begin
+      Check_Type (Value.Ctype, List.El_Type);
+      El := new O_Cnode_Aggrel_Type'(Kind => OC_Aggr_Element,
+                                     Ctype => Value.Ctype,
+                                     Ref => False,
+                                     Aggr_Value => Value,
+                                     Aggr_Next => null);
+      if List.Last = null then
+         List.Res.Aggr_Els := El;
+      else
+         List.Last.Aggr_Next := El;
+      end if;
+      List.Last := El;
+   end New_Array_Aggr_El;
+
+   procedure Finish_Array_Aggr
+     (List : in out O_Array_Aggr_List; Res : out O_Cnode) is
+   begin
+      Res := List.Res;
+   end Finish_Array_Aggr;
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      subtype O_Cnode_Union_Aggr is O_Cnode_Type (OC_Union_Aggr);
+      Res : O_Cnode;
+   begin
+      if Atype.Kind /= ON_Union_Type then
+         raise Type_Error;
+      end if;
+      Check_Type (Value.Ctype, Field.Ftype);
+
+      Res := new O_Cnode_Union_Aggr'(Kind => OC_Union_Aggr,
+                                     Ctype => Atype,
+                                     Ref => False,
+                                     Uaggr_Field => Field,
+                                     Uaggr_Value => Value);
+      return Res;
+   end New_Union_Aggr;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode
+   is
+      subtype O_Lnode_Obj is O_Lnode_Type (OL_Obj);
+   begin
+      case Obj.Kind is
+         when ON_Const_Decl
+           | ON_Var_Decl
+           | ON_Interface_Decl =>
+            null;
+         when others =>
+            raise Program_Error;
+      end case;
+      Check_Scope (Obj);
+      return new O_Lnode_Obj'(Kind => OL_Obj,
+                              Rtype => Obj.Dtype,
+                              Ref => False,
+                              Obj => Obj);
+   end New_Obj;
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode
+   is
+      subtype O_Lnode_Indexed is O_Lnode_Type (OL_Indexed_Element);
+      Res : O_Lnode;
+   begin
+      Check_Ref (Arr);
+      Res := new O_Lnode_Indexed'(Kind => OL_Indexed_Element,
+                                  Rtype => Get_Base_Type (Arr.Rtype).El_Type,
+                                  Ref => False,
+                                  Array_Base => Arr,
+                                  Index => Index);
+      return Res;
+   end New_Indexed_Element;
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode
+   is
+      subtype O_Lnode_Slice is O_Lnode_Type (OL_Slice);
+      Res : O_Lnode;
+   begin
+      if Res_Type.Kind /= ON_Array_Type
+        and then Res_Type.Kind /= ON_Array_Sub_Type
+      then
+         raise Type_Error;
+      end if;
+      Check_Ref (Arr);
+      Check_Ref (Index);
+      -- FIXME: check type.
+      Res := new O_Lnode_Slice'(Kind => OL_Slice,
+                                Rtype => Res_Type,
+                                Ref => False,
+                                Slice_Base => Arr,
+                                Slice_Index => Index);
+      return Res;
+   end New_Slice;
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode
+   is
+      subtype O_Lnode_Selected_Element is O_Lnode_Type (OL_Selected_Element);
+   begin
+      if Rec.Rtype.Kind /= ON_Record_Type then
+         raise Type_Error;
+      end if;
+      if Rec.Rtype /= El.Parent then
+         raise Type_Error;
+      end if;
+      Check_Ref (Rec);
+      return new O_Lnode_Selected_Element'(Kind => OL_Selected_Element,
+                                           Rtype => El.Ftype,
+                                           Ref => False,
+                                           Rec_Base => Rec,
+                                           Rec_El => El);
+   end New_Selected_Element;
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      subtype O_Lnode_Access_Element is O_Lnode_Type (OL_Access_Element);
+   begin
+      if Acc.Rtype.Kind /= ON_Access_Type then
+         raise Type_Error;
+      end if;
+      Check_Ref (Acc);
+      return new O_Lnode_Access_Element'(Kind => OL_Access_Element,
+                                         Rtype => Acc.Rtype.D_Type,
+                                         Ref => False,
+                                         Acc_Base => Acc);
+   end New_Access_Element;
+
+   function Check_Conv (Source : ON_Type_Kind; Target : ON_Type_Kind)
+     return Boolean
+   is
+      type Conv_Array is array (ON_Type_Kind, ON_Type_Kind) of Boolean;
+      T : constant Boolean := True;
+      F : constant Boolean := False;
+      Conv_Allowed : constant Conv_Array :=
+        (ON_Boolean_Type =>  (T, F, T, T, F, F, F, F, F, F),
+         ON_Enum_Type =>     (F, F, T, T, F, F, F, F, F, F),
+         ON_Unsigned_Type => (T, T, T, T, F, F, F, F, F, F),
+         ON_Signed_Type =>   (T, T, T, T, T, F, F, F, F, F),
+         ON_Float_Type =>    (F, F, F, T, T, F, F, F, F, F),
+         ON_Array_Type =>    (F, F, F, F, F, F, T, F, F, F),
+         ON_Array_Sub_Type =>(F, F, F, F, F, T, T, F, F, F),
+         ON_Record_Type =>   (F, F, F, F, F, F, F, F, F, F),
+         ON_Union_Type =>    (F, F, F, F, F, F, F, F, F, F),
+         ON_Access_Type =>   (F, F, F, F, F, F, F, F, F, T));
+   begin
+      if Source = Target then
+         return True;
+      else
+         return Conv_Allowed (Source, Target);
+      end if;
+   end Check_Conv;
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode
+   is
+      subtype O_Enode_Convert is O_Enode_Type (OE_Convert_Ov);
+      Res : O_Enode;
+   begin
+      Check_Ref (Val);
+      if not Check_Conv (Val.Rtype.Kind, Rtype.Kind) then
+         raise Type_Error;
+      end if;
+      Res := new O_Enode_Convert'(Kind => OE_Convert_Ov,
+                                  Rtype => Rtype,
+                                  Ref => False,
+                                  Conv => Val);
+      return Res;
+   end New_Convert_Ov;
+
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode
+   is
+      subtype O_Enode_Address is O_Enode_Type (OE_Unchecked_Address);
+   begin
+      Check_Ref (Lvalue);
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      return new O_Enode_Address'(Kind => OE_Unchecked_Address,
+                                  Rtype => Atype,
+                                  Ref => False,
+                                  Lvalue => Lvalue);
+   end New_Unchecked_Address;
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode
+   is
+      subtype O_Enode_Address is O_Enode_Type (OE_Address);
+   begin
+      Check_Ref (Lvalue);
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      if Get_Base_Type (Lvalue.Rtype) /= Get_Base_Type (Atype.D_Type) then
+         if not Disable_Checks then
+            raise Type_Error;
+         end if;
+      end if;
+      return new O_Enode_Address'(Kind => OE_Address,
+                                  Rtype => Atype,
+                                  Ref => False,
+                                  Lvalue => Lvalue);
+   end New_Address;
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode
+   is
+      subtype O_Cnode_Address is O_Cnode_Type (OC_Unchecked_Address);
+   begin
+      Check_Scope (Decl);
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Address'(Kind => OC_Unchecked_Address,
+                                  Ctype => Atype,
+                                  Ref => False,
+                                  Decl => Decl);
+   end New_Global_Unchecked_Address;
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Address is O_Cnode_Type (OC_Address);
+   begin
+      Check_Scope (Decl);
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      if Get_Base_Type (Decl.Dtype) /= Get_Base_Type (Atype.D_Type) then
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Address'(Kind => OC_Address,
+                                  Ctype => Atype,
+                                  Ref => False,
+                                  Decl => Decl);
+   end New_Global_Address;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode
+   is
+      subtype O_Cnode_Subprg_Address is O_Cnode_Type (OC_Subprogram_Address);
+   begin
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Subprg_Address'(Kind => OC_Subprogram_Address,
+                                         Ctype => Atype,
+                                         Ref => False,
+                                         Decl => Subprg);
+   end New_Subprogram_Address;
+
+   --  Raise TYPE_ERROR is ATYPE is a composite type.
+   procedure Check_Not_Composite (Atype : O_Tnode) is
+   begin
+      case Atype.Kind is
+         when ON_Boolean_Type
+           | ON_Unsigned_Type
+           | ON_Signed_Type
+           | ON_Float_Type
+           | ON_Enum_Type
+           | ON_Access_Type=>
+            return;
+         when ON_Array_Type
+           | ON_Record_Type
+           | ON_Union_Type
+           | ON_Array_Sub_Type =>
+            raise Type_Error;
+      end case;
+   end Check_Not_Composite;
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode is
+      subtype O_Enode_Value is O_Enode_Type (OE_Value);
+   begin
+      Check_Not_Composite (Lvalue.Rtype);
+      Check_Ref (Lvalue);
+      return new O_Enode_Value'(Kind => OE_Value,
+                                Rtype => Lvalue.Rtype,
+                                Ref => False,
+                                Value => Lvalue);
+   end New_Value;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return New_Value (New_Obj (Obj));
+   end New_Obj_Value;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+      subtype O_Enode_Lit is O_Enode_Type (OE_Lit);
+   begin
+      Check_Not_Composite (Lit.Ctype);
+      return new O_Enode_Lit'(Kind => OE_Lit,
+                              Rtype => Lit.Ctype,
+                              Ref => False,
+                              Lit => Lit);
+   end New_Lit;
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   procedure New_Debug_Filename_Decl (Filename : String)
+   is
+      subtype O_Dnode_Filename_Decl is O_Dnode_Type (ON_Debug_Filename_Decl);
+      N : O_Dnode;
+   begin
+      N := new O_Dnode_Filename_Decl;
+      N.Filename := new String'(Filename);
+      Add_Decl (N, False);
+   end New_Debug_Filename_Decl;
+
+   procedure New_Debug_Line_Decl (Line : Natural)
+   is
+      subtype O_Dnode_Line_Decl is O_Dnode_Type (ON_Debug_Line_Decl);
+      N : O_Dnode;
+   begin
+      N := new O_Dnode_Line_Decl;
+      N.Line := Line;
+      Add_Decl (N, False);
+   end New_Debug_Line_Decl;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      subtype O_Dnode_Comment_Decl is O_Dnode_Type (ON_Debug_Comment_Decl);
+      N : O_Dnode;
+   begin
+      N := new O_Dnode_Comment_Decl;
+      N.Comment := new String'(Comment);
+      Add_Decl (N, False);
+   end New_Debug_Comment_Decl;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode)
+   is
+      N : O_Dnode;
+   begin
+      if Atype.Decl /= null then
+         --  Type was already declared.
+         raise Type_Error;
+      end if;
+      N := new O_Dnode_Type (ON_Type_Decl);
+      N.Name := Ident;
+      N.Dtype := Atype;
+      Atype.Decl := N;
+      Add_Decl (N);
+   end New_Type_Decl;
+
+   procedure Check_Object_Storage (Storage : O_Storage) is
+   begin
+      if Current_Function /= null then
+         --  Inside a subprogram.
+         case Storage is
+            when O_Storage_Public =>
+               --  Cannot create public variables inside a subprogram.
+               raise Syntax_Error;
+            when O_Storage_Private
+              | O_Storage_Local
+              | O_Storage_External =>
+               null;
+         end case;
+      else
+         --  Global scope.
+         case Storage is
+            when O_Storage_Public
+              | O_Storage_Private
+              | O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               --  Cannot create a local variables outside a subprogram.
+               raise Syntax_Error;
+         end case;
+      end if;
+   end Check_Object_Storage;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+      subtype O_Dnode_Const is O_Dnode_Type (ON_Const_Decl);
+   begin
+      Check_Complete_Type (Atype);
+      if Storage = O_Storage_Local then
+         --  A constant cannot be local.
+         raise Syntax_Error;
+      end if;
+      Check_Object_Storage (Storage);
+      Res := new O_Dnode_Const'(Kind => ON_Const_Decl,
+                                Name => Ident,
+                                Next => null,
+                                Dtype => Atype,
+                                Storage => Storage,
+                                Scope => Current_Decl_Scope.Parent,
+                                Lineno => 0,
+                                Const_Value => O_Dnode_Null);
+      Add_Decl (Res);
+   end New_Const_Decl;
+
+   procedure Start_Const_Value (Const : in out O_Dnode)
+   is
+      subtype O_Dnode_Const_Value is O_Dnode_Type (ON_Const_Value);
+      N : O_Dnode;
+   begin
+      if Const.Const_Value /= O_Dnode_Null then
+         --  Constant already has a value.
+         raise Syntax_Error;
+      end if;
+
+      if Const.Storage = O_Storage_External then
+         --  An external constant must not have a value.
+         raise Syntax_Error;
+      end if;
+
+      --  FIXME: check scope is the same.
+
+      N := new O_Dnode_Const_Value'(Kind => ON_Const_Value,
+                                    Name => Const.Name,
+                                    Next => null,
+                                    Dtype => Const.Dtype,
+                                    Storage => Const.Storage,
+                                    Scope => Current_Decl_Scope.Parent,
+                                    Lineno => 0,
+                                    Const_Decl => Const,
+                                    Value => O_Cnode_Null);
+      Const.Const_Value := N;
+      Add_Decl (N, False);
+   end Start_Const_Value;
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
+   is
+   begin
+      if Const.Const_Value = O_Dnode_Null then
+         --  Start_Const_Value not called.
+         raise Syntax_Error;
+      end if;
+      if Const.Const_Value.Value /= O_Cnode_Null then
+         --  Finish_Const_Value already called.
+         raise Syntax_Error;
+      end if;
+      if Val = O_Cnode_Null then
+         --  No value or bad type.
+         raise Type_Error;
+      end if;
+      Check_Type (Val.Ctype, Const.Dtype);
+      Const.Const_Value.Value := Val;
+   end Finish_Const_Value;
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+      subtype O_Dnode_Var is O_Dnode_Type (ON_Var_Decl);
+   begin
+      Check_Complete_Type (Atype);
+      Check_Object_Storage (Storage);
+      Res := new O_Dnode_Var'(Kind => ON_Var_Decl,
+                              Name => Ident,
+                              Next => null,
+                              Dtype => Atype,
+                              Storage => Storage,
+                              Lineno => 0,
+                              Scope => Current_Decl_Scope.Parent);
+      Add_Decl (Res);
+   end New_Var_Decl;
+
+   procedure Start_Subprogram_Decl_1
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+      subtype O_Dnode_Function is O_Dnode_Type (ON_Function_Decl);
+      N : O_Dnode;
+   begin
+      N := new O_Dnode_Function'(Kind => ON_Function_Decl,
+                                 Next => null,
+                                 Name => Ident,
+                                 Dtype => Rtype,
+                                 Storage => Storage,
+                                 Scope => Current_Decl_Scope.Parent,
+                                 Lineno => 0,
+                                 Interfaces => null,
+                                 Func_Body => null,
+                                 Alive => False);
+      Add_Decl (N);
+      Interfaces.Func := N;
+      Interfaces.Last := null;
+   end Start_Subprogram_Decl_1;
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Check_Not_Composite (Rtype);
+      Check_Complete_Type (Rtype);
+      Start_Subprogram_Decl_1 (Interfaces, Ident, Storage, Rtype);
+   end Start_Function_Decl;
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage) is
+   begin
+      Start_Subprogram_Decl_1 (Interfaces, Ident, Storage, null);
+   end Start_Procedure_Decl;
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode)
+   is
+      subtype O_Dnode_Interface is O_Dnode_Type (ON_Interface_Decl);
+   begin
+      Check_Not_Composite (Atype);
+      Check_Complete_Type (Atype);
+      Res := new O_Dnode_Interface'(Kind => ON_Interface_Decl,
+                                    Next => null,
+                                    Name => Ident,
+                                    Dtype => Atype,
+                                    Storage => O_Storage_Private,
+                                    Scope => Current_Decl_Scope.Parent,
+                                    Lineno => 0,
+                                    Func_Scope => Interfaces.Func);
+      if Interfaces.Last = null then
+         Interfaces.Func.Interfaces := Res;
+      else
+         Interfaces.Last.Next := Res;
+      end if;
+      Interfaces.Last := Res;
+   end New_Interface_Decl;
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode)
+   is
+   begin
+      Res := Interfaces.Func;
+   end Finish_Subprogram_Decl;
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+      B : O_Dnode;
+      S : O_Snode;
+   begin
+      if Func.Func_Body /= null then
+         --  Function was already declared.
+         raise Syntax_Error;
+      end if;
+      S := new O_Snode_Type (ON_Declare_Stmt);
+      S.all := O_Snode_Type'(Kind => ON_Declare_Stmt,
+                             Next => null,
+                             Decls => null,
+                             Stmts => null,
+                             Lineno => 0,
+                             Alive => True);
+      B := new O_Dnode_Type (ON_Function_Body);
+      B.all := O_Dnode_Type'(ON_Function_Body,
+                             Name => Func.Name,
+                             Dtype => Func.Dtype,
+                             Storage => Func.Storage,
+                             Scope => Current_Decl_Scope.Parent,
+                             Lineno => 0,
+                             Func_Decl => Func,
+                             Func_Stmt => S,
+                             Next => null);
+      Add_Decl (B, False);
+      Func.Func_Body := B;
+      Push_Decl_Scope (S);
+      Push_Stmt_Scope
+        (new Stmt_Function_Scope_Type'(Kind => Stmt_Function,
+                                       Parent => S,
+                                       Prev => Current_Stmt_Scope,
+                                       Prev_Function => Current_Function,
+                                       Decl => Func));
+      Current_Function := Current_Stmt_Scope;
+      Func.Alive := True;
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body is
+   begin
+      Pop_Decl_Scope;
+      if Current_Function.Kind /= Stmt_Function then
+         --  Internal error.
+         raise Syntax_Error;
+      end if;
+      Current_Function.Decl.Alive := False;
+      Current_Function := Current_Function.Prev_Function;
+      Pop_Stmt_Scope (Stmt_Function);
+   end Finish_Subprogram_Body;
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural)
+   is
+      subtype O_Snode_Line_Stmt is O_Snode_Type (ON_Debug_Line_Stmt);
+   begin
+      Add_Stmt (new O_Snode_Line_Stmt'(Kind => ON_Debug_Line_Stmt,
+                                       Next => null,
+                                       Lineno => 0,
+                                       Line => Line));
+   end New_Debug_Line_Stmt;
+
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      subtype O_Snode_Comment_Stmt is O_Snode_Type (ON_Debug_Comment_Stmt);
+   begin
+      Add_Stmt (new O_Snode_Comment_Stmt'(Kind => ON_Debug_Comment_Stmt,
+                                          Next => null,
+                                          Lineno => 0,
+                                          Comment => new String'(Comment)));
+   end New_Debug_Comment_Stmt;
+
+   procedure Start_Declare_Stmt
+   is
+      N : O_Snode;
+   begin
+      N := new O_Snode_Type (ON_Declare_Stmt);
+      Add_Stmt (N);
+      Push_Decl_Scope (N);
+      Push_Stmt_Scope
+        (new Stmt_Declare_Scope_Type'(Kind => Stmt_Declare,
+                                      Parent => N,
+                                      Prev => Current_Stmt_Scope));
+   end Start_Declare_Stmt;
+
+   procedure Finish_Declare_Stmt is
+   begin
+      Pop_Decl_Scope;
+      Pop_Stmt_Scope (Stmt_Declare);
+   end Finish_Declare_Stmt;
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      N : O_Snode;
+   begin
+      Check_Type (Target.Rtype, Value.Rtype);
+      Check_Not_Composite (Target.Rtype);
+      Check_Ref (Target);
+      Check_Ref (Value);
+      N := new O_Snode_Type (ON_Assign_Stmt);
+      N.all := O_Snode_Type'(Kind => ON_Assign_Stmt,
+                             Next => null,
+                             Lineno => 0,
+                             Target => Target,
+                             Value => Value);
+      Add_Stmt (N);
+   end New_Assign_Stmt;
+
+   procedure New_Return_Stmt_1 (Value : O_Enode)
+   is
+      subtype O_Snode_Return_Stmt is O_Snode_Type (ON_Return_Stmt);
+      N : O_Snode;
+   begin
+      N := new O_Snode_Return_Stmt'(Kind => ON_Return_Stmt,
+                                    Next => null,
+                                    Lineno => 0,
+                                    Ret_Val => Value);
+      Add_Stmt (N);
+   end New_Return_Stmt_1;
+
+   procedure New_Return_Stmt (Value : O_Enode)
+   is
+   begin
+      if Current_Function = null
+        or else Current_Function.Decl.Dtype = O_Tnode_Null
+      then
+         -- Either not in a function or in a procedure.
+         raise Syntax_Error;
+      end if;
+      Check_Type (Value.Rtype, Current_Function.Decl.Dtype);
+      Check_Ref (Value);
+      New_Return_Stmt_1 (Value);
+   end New_Return_Stmt;
+
+   procedure New_Return_Stmt is
+   begin
+      if Current_Function = null
+        or else Current_Function.Decl.Dtype /= O_Tnode_Null
+      then
+         -- Not in a procedure.
+         raise Syntax_Error;
+      end if;
+      New_Return_Stmt_1 (null);
+   end New_Return_Stmt;
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+   begin
+      Check_Scope (Subprg);
+      Assocs.Subprg := Subprg;
+      Assocs.Interfaces := Subprg.Interfaces;
+      Assocs.First := null;
+      Assocs.Last := null;
+   end Start_Association;
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode)
+   is
+      N : O_Anode;
+   begin
+      Check_Type (Assocs.Interfaces.Dtype, Val.Rtype);
+      Check_Ref (Val);
+      N := new O_Anode_Type'(Next => null,
+                             Formal => Assocs.Interfaces, Actual => Val);
+      Assocs.Interfaces := Assocs.Interfaces.Next;
+      if Assocs.Last = null then
+         Assocs.First := N;
+      else
+         Assocs.Last.Next := N;
+      end if;
+      Assocs.Last := N;
+   end New_Association;
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+      subtype O_Enode_Call is O_Enode_Type (OE_Function_Call);
+      Res : O_Enode;
+   begin
+      if Assocs.Interfaces /= null then
+         --  Not enough arguments.
+         raise Syntax_Error;
+      end if;
+      if Assocs.Subprg.Dtype = null then
+         --  This is a procedure.
+         raise Syntax_Error;
+      end if;
+
+      Res := new O_Enode_Call'(Kind => OE_Function_Call,
+                               Rtype => Assocs.Subprg.Dtype,
+                               Ref => False,
+                               Func => Assocs.Subprg,
+                               Assoc => Assocs.First);
+      return Res;
+   end New_Function_Call;
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List)
+   is
+      N : O_Snode;
+   begin
+      if Assocs.Interfaces /= null then
+         --  Not enough arguments.
+         raise Syntax_Error;
+      end if;
+      if Assocs.Subprg.Dtype /= null then
+         --  This is a function.
+         raise Syntax_Error;
+      end if;
+      N := new O_Snode_Type (ON_Call_Stmt);
+      N.Proc := Assocs.Subprg;
+      N.Assoc := Assocs.First;
+      Add_Stmt (N);
+   end New_Procedure_Call;
+
+   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode)
+   is
+      subtype O_Snode_If is O_Snode_Type (ON_If_Stmt);
+      N : O_Snode;
+   begin
+      --  Note: no checks are performed here, since they are done in
+      --  new_elsif_stmt.
+      N := new O_Snode_If'(Kind => ON_If_Stmt,
+                           Next => null,
+                           Lineno => 0,
+                           Elsifs => null,
+                           If_Last => null);
+      Add_Stmt (N);
+      Push_Stmt_Scope (new Stmt_If_Scope_Type'(Kind => Stmt_If,
+                                               Parent => N,
+                                               Prev => Current_Stmt_Scope,
+                                               Last_Elsif => null));
+      New_Elsif_Stmt (Block, Cond);
+   end Start_If_Stmt;
+
+   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode)
+   is
+      pragma Unreferenced (Block);
+      N : O_Snode;
+   begin
+      if Cond /= null then
+         if Cond.Rtype.Kind /= ON_Boolean_Type then
+            raise Type_Error;
+         end if;
+         Check_Ref (Cond);
+      end if;
+      N := new O_Snode_Type (ON_Elsif_Stmt);
+      N.all := O_Snode_Type'(Kind => ON_Elsif_Stmt,
+                             Next => null,
+                             Lineno => 0,
+                             Cond => Cond,
+                             Next_Elsif => null);
+      if Current_Stmt_Scope.Kind /= Stmt_If then
+         raise Syntax_Error;
+      end if;
+      Add_Stmt (N);
+      if Current_Stmt_Scope.Last_Elsif = null then
+         Current_Stmt_Scope.Parent.Elsifs := N;
+      else
+         --  Check for double 'else'
+         if Current_Stmt_Scope.Last_Elsif.Cond = null then
+            raise Syntax_Error;
+         end if;
+         Current_Stmt_Scope.Last_Elsif.Next_Elsif := N;
+      end if;
+      Current_Stmt_Scope.Last_Elsif := N;
+   end New_Elsif_Stmt;
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+   begin
+      New_Elsif_Stmt (Block, null);
+   end New_Else_Stmt;
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block)
+   is
+      pragma Unreferenced (Block);
+      Parent : O_Snode;
+   begin
+      Parent := Current_Stmt_Scope.Parent;
+      Pop_Stmt_Scope (Stmt_If);
+      Parent.If_Last := Current_Decl_Scope.Last_Stmt;
+   end Finish_If_Stmt;
+
+   procedure Start_Loop_Stmt (Label : out O_Snode)
+   is
+      subtype O_Snode_Loop_Type is O_Snode_Type (ON_Loop_Stmt);
+   begin
+      Current_Loop_Level := Current_Loop_Level + 1;
+      Label := new O_Snode_Loop_Type'(Kind => ON_Loop_Stmt,
+                                      Next => null,
+                                      Lineno => 0,
+                                      Loop_Last => null,
+                                      Loop_Level => Current_Loop_Level);
+      Add_Stmt (Label);
+      Push_Stmt_Scope (new Stmt_Loop_Scope_Type'(Kind => Stmt_Loop,
+                                                 Parent => Label,
+                                                 Prev => Current_Stmt_Scope));
+   end Start_Loop_Stmt;
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode)
+   is
+      pragma Unreferenced (Label);
+      Parent : O_Snode;
+   begin
+      Parent := Current_Stmt_Scope.Parent;
+      Pop_Stmt_Scope (Stmt_Loop);
+      Parent.Loop_Last := Current_Decl_Scope.Last_Stmt;
+      Current_Loop_Level := Current_Loop_Level - 1;
+   end Finish_Loop_Stmt;
+
+   procedure New_Exit_Next_Stmt (Kind : ON_Stmt_Kind; L : O_Snode)
+   is
+      N : O_Snode;
+   begin
+      N := new O_Snode_Type (Kind);
+      N.Next := null;
+      N.Loop_Id := L;
+      Add_Stmt (N);
+   end New_Exit_Next_Stmt;
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+   begin
+      New_Exit_Next_Stmt (ON_Exit_Stmt, L);
+   end New_Exit_Stmt;
+
+   procedure New_Next_Stmt (L : O_Snode) is
+   begin
+      New_Exit_Next_Stmt (ON_Next_Stmt, L);
+   end New_Next_Stmt;
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode)
+   is
+      subtype O_Snode_Case_Type is O_Snode_Type (ON_Case_Stmt);
+      N : O_Snode;
+   begin
+      case Value.Rtype.Kind is
+         when ON_Boolean_Type
+           | ON_Unsigned_Type
+           | ON_Signed_Type
+           | ON_Enum_Type =>
+            null;
+         when others =>
+            raise Type_Error;
+      end case;
+      Check_Ref (Value);
+      N := new O_Snode_Case_Type'(Kind => ON_Case_Stmt,
+                                  Next => null,
+                                  Lineno => 0,
+                                  Case_Last => null,
+                                  Selector => Value,
+                                  Branches => null);
+      Block.Case_Stmt := N;
+      Add_Stmt (N);
+      Push_Stmt_Scope (new Stmt_Case_Scope_Type'(Kind => Stmt_Case,
+                                                 Parent => N,
+                                                 Prev => Current_Stmt_Scope,
+                                                 Last_Branch => null,
+                                                 Last_Choice => null,
+                                                 Case_Type => Value.Rtype));
+   end Start_Case_Stmt;
+
+   procedure Start_Choice (Block : in out O_Case_Block)
+   is
+      N : O_Snode;
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are adding a branch outside a case statment.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Choice /= null then
+         --  You are creating branch while the previous one was not finished.
+         raise Syntax_Error;
+      end if;
+
+      N := new O_Snode_Type (ON_When_Stmt);
+      N.all := O_Snode_Type'(Kind => ON_When_Stmt,
+                             Next => null,
+                             Lineno => 0,
+                             Branch_Parent => Block.Case_Stmt,
+                             Choice_List => null,
+                             Next_Branch => null);
+      if Current_Stmt_Scope.Last_Branch = null then
+         Current_Stmt_Scope.Parent.Branches := N;
+      else
+         Current_Stmt_Scope.Last_Branch.Next_Branch := N;
+      end if;
+      Current_Stmt_Scope.Last_Branch := N;
+      Current_Stmt_Scope.Last_Choice := null;
+      Add_Stmt (N);
+   end Start_Choice;
+
+   procedure Add_Choice (Block : in out O_Case_Block; Choice : O_Choice)
+   is
+      pragma Unreferenced (Block);
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are adding a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Branch = null then
+         --  You are not inside a branch.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Choice = null then
+         if Current_Stmt_Scope.Last_Branch.Choice_List /= null then
+            --  The branch was already closed.
+            raise Syntax_Error;
+         end if;
+         Current_Stmt_Scope.Last_Branch.Choice_List := Choice;
+      else
+         Current_Stmt_Scope.Last_Choice.Next := Choice;
+      end if;
+      Current_Stmt_Scope.Last_Choice := Choice;
+   end Add_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode)
+   is
+      N : O_Choice;
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are creating a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Case_Type /= Expr.Ctype then
+         --  Expr type is not the same as choice type.
+         raise Type_Error;
+      end if;
+
+      N := new O_Choice_Type (ON_Choice_Expr);
+      N.all := O_Choice_Type'(Kind => ON_Choice_Expr,
+                              Next => null,
+                              Expr => Expr);
+      Add_Choice (Block, N);
+   end New_Expr_Choice;
+
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode)
+   is
+      N : O_Choice;
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are creating a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Case_Type /= Low.Ctype
+        or Current_Stmt_Scope.Case_Type /= High.Ctype
+      then
+         --  Low/High type is not the same as choice type.
+         raise Type_Error;
+      end if;
+
+      N := new O_Choice_Type (ON_Choice_Range);
+      N.all := O_Choice_Type'(Kind => ON_Choice_Range,
+                              Next => null,
+                              Low => Low,
+                              High => High);
+      Add_Choice (Block, N);
+   end New_Range_Choice;
+
+   procedure New_Default_Choice (Block : in out O_Case_Block)
+   is
+      N : O_Choice;
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are creating a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+
+      N := new O_Choice_Type (ON_Choice_Default);
+      N.all := O_Choice_Type'(Kind => ON_Choice_Default,
+                             Next => null);
+      Add_Choice (Block, N);
+   end New_Default_Choice;
+
+   procedure Finish_Choice (Block : in out O_Case_Block)
+   is
+      pragma Unreferenced (Block);
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are adding a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Branch = null then
+         --  You are not inside a branch.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Choice = null then
+         --  The branch is empty or you are not inside a branch.
+         raise Syntax_Error;
+      end if;
+      Current_Stmt_Scope.Last_Choice := null;
+   end Finish_Choice;
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block)
+   is
+      pragma Unreferenced (Block);
+      Parent : O_Snode;
+   begin
+      Parent := Current_Stmt_Scope.Parent;
+      Pop_Stmt_Scope (Stmt_Case);
+      Parent.Case_Last := Current_Decl_Scope.Last_Stmt;
+   end Finish_Case_Stmt;
+
+   procedure Init is
+   begin
+      Top := new O_Snode_Type (ON_Declare_Stmt);
+      Push_Decl_Scope (Top);
+   end Init;
+
+   procedure Finish is
+   begin
+      Pop_Decl_Scope;
+   end Finish;
+end Ortho_Debug;
diff --git a/src/ortho/debug/ortho_debug.private.ads b/src/ortho/debug/ortho_debug.private.ads
new file mode 100644
index 000000000..69ee16cf7
--- /dev/null
+++ b/src/ortho/debug/ortho_debug.private.ads
@@ -0,0 +1,467 @@
+--  Ortho debug back-end declarations.
+--  Copyright (C) 2005-2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package Ortho_Debug is
+   procedure Init;
+   procedure Finish;
+
+private
+   --  This back-end supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   --  A node for a type.
+   type O_Tnode_Type (<>);
+   type O_Tnode is access O_Tnode_Type;
+
+   --  A node for a statement.
+   type O_Snode_Type (<>);
+   type O_Snode is access O_Snode_Type;
+
+   Top : O_Snode;
+
+   type Str_Acc is access String;
+
+   type Decl_Scope_Type;
+   type Decl_Scope_Acc is access Decl_Scope_Type;
+
+   type On_Decl_Kind is
+     (ON_Type_Decl, ON_Completed_Type_Decl,
+      ON_Const_Decl, ON_Var_Decl, ON_Interface_Decl,
+      ON_Function_Decl, ON_Function_Body,
+      ON_Const_Value,
+      ON_Debug_Line_Decl, ON_Debug_Comment_Decl, ON_Debug_Filename_Decl);
+
+   type O_Dnode_Type (<>);
+   type O_Dnode is access O_Dnode_Type;
+
+   O_Dnode_Null : constant O_Dnode := null;
+
+   type O_Dnode_Type (Kind : On_Decl_Kind) is record
+      Next : O_Dnode;
+      Name : O_Ident;
+      Dtype : O_Tnode;
+      Storage : O_Storage;
+      --  Declare statement in which the declaration appears.
+      Scope : O_Snode;
+      --  Line number, for regen.
+      Lineno : Natural;
+      case Kind is
+         when ON_Type_Decl =>
+            null;
+         when ON_Completed_Type_Decl =>
+            null;
+         when ON_Const_Decl =>
+            Const_Value : O_Dnode;
+         when ON_Const_Value =>
+            Const_Decl : O_Dnode;
+            Value : O_Cnode;
+         when ON_Var_Decl =>
+            null;
+         when ON_Function_Decl =>
+            Interfaces : O_Dnode;
+            Func_Body : O_Dnode;
+            Alive : Boolean;
+         when ON_Function_Body =>
+            Func_Decl : O_Dnode;
+            Func_Stmt : O_Snode;
+         when ON_Interface_Decl =>
+            Func_Scope : O_Dnode;
+         when ON_Debug_Line_Decl =>
+            Line : Natural;
+         when ON_Debug_Comment_Decl =>
+            Comment : Str_Acc;
+         when ON_Debug_Filename_Decl =>
+            Filename : Str_Acc;
+      end case;
+   end record;
+
+   --  A node for a record element.
+   type O_Fnode_Type;
+   type O_Fnode is access O_Fnode_Type;
+
+   O_Fnode_Null : constant O_Fnode := null;
+
+   type O_Fnode_Type is record
+      --  Record type.
+      Parent : O_Tnode;
+      --  Next field in the record.
+      Next : O_Fnode;
+      --  Name of the record field.
+      Ident : O_Ident;
+      --  Type of the record field.
+      Ftype : O_Tnode;
+      --  Offset in the field.
+      Offset : Unsigned_32;
+   end record;
+
+   type O_Anode_Type;
+   type O_Anode is access O_Anode_Type;
+   type O_Anode_Type is record
+      Next : O_Anode;
+      Formal : O_Dnode;
+      Actual : O_Enode;
+   end record;
+
+   type OC_Kind is
+     (
+      OC_Boolean_Lit,
+      OC_Unsigned_Lit,
+      OC_Signed_Lit,
+      OC_Float_Lit,
+      OC_Enum_Lit,
+      OC_Null_Lit,
+      OC_Sizeof_Lit,
+      OC_Alignof_Lit,
+      OC_Offsetof_Lit,
+      OC_Aggregate,
+      OC_Aggr_Element,
+      OC_Union_Aggr,
+      OC_Address,
+      OC_Unchecked_Address,
+      OC_Subprogram_Address
+     );
+   type O_Cnode_Type (Kind : OC_Kind) is record
+      --  Type of the constant.
+      Ctype : O_Tnode;
+      --  True if referenced.
+      Ref : Boolean;
+      case Kind is
+         when OC_Unsigned_Lit =>
+            U_Val : Unsigned_64;
+         when OC_Signed_Lit =>
+            S_Val : Integer_64;
+         when OC_Float_Lit =>
+            F_Val : IEEE_Float_64;
+         when OC_Boolean_Lit =>
+            B_Val : Boolean;
+            B_Id : O_Ident;
+         when OC_Enum_Lit =>
+            E_Val : Integer;
+            E_Next : O_Cnode;
+            E_Name : O_Ident;
+         when OC_Null_Lit =>
+            null;
+         when OC_Sizeof_Lit
+           | OC_Alignof_Lit =>
+            S_Type : O_Tnode;
+         when OC_Offsetof_Lit =>
+            Off_Field : O_Fnode;
+         when OC_Aggregate =>
+            Aggr_Els : O_Cnode;
+         when OC_Union_Aggr =>
+            Uaggr_Field : O_Fnode;
+            Uaggr_Value : O_Cnode;
+         when OC_Aggr_Element =>
+            Aggr_Value : O_Cnode;
+            Aggr_Next : O_Cnode;
+         when OC_Address
+           | OC_Unchecked_Address
+           | OC_Subprogram_Address =>
+            Decl : O_Dnode;
+      end case;
+   end record;
+
+   type O_Cnode is access O_Cnode_Type;
+   O_Cnode_Null : constant O_Cnode := null;
+
+   type OE_Kind is
+     (
+      --  Literals.
+      OE_Lit,
+
+      --  Dyadic operations.
+      OE_Add_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Sub_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Mul_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Div_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Rem_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Mod_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Exp_Ov,                --  OE_Dyadic_Op_Kind
+
+      --  Binary operations.
+      OE_And,                   --  OE_Dyadic_Op_Kind
+      OE_Or,                    --  OE_Dyadic_Op_Kind
+      OE_Xor,                   --  OE_Dyadic_Op_Kind
+      OE_And_Then,              --  OE_Dyadic_Op_Kind
+      OE_Or_Else,               --  OE_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      OE_Not,                   --  OE_Monadic_Op_Kind
+      OE_Neg_Ov,                --  OE_Monadic_Op_Kind
+      OE_Abs_Ov,                --  OE_Monadic_Op_Kind
+
+      --  Comparaisons
+      OE_Eq,                    --  OE_Compare_Op_Kind
+      OE_Neq,                   --  OE_Compare_Op_Kind
+      OE_Le,                    --  OE_Compare_Op_Kind
+      OE_Lt,                    --  OE_Compare_Op_Kind
+      OE_Ge,                    --  OE_Compare_Op_Kind
+      OE_Gt,                    --  OE_Compare_Op_Kind
+
+      --  Misc.
+      OE_Convert_Ov,
+      OE_Address,
+      OE_Unchecked_Address,
+      OE_Alloca,
+      OE_Function_Call,
+
+      OE_Value,
+      OE_Nil
+      );
+
+   subtype OE_Dyadic_Expr_Kind is OE_Kind range OE_Add_Ov .. OE_Or_Else;
+   subtype OE_Monadic_Expr_Kind is OE_Kind range OE_Not .. OE_Abs_Ov;
+   subtype OE_Compare_Expr_Kind is OE_Kind range OE_Eq .. OE_Gt;
+
+   type O_Enode_Type (Kind : OE_Kind);
+   type O_Enode is access O_Enode_Type;
+   O_Enode_Null : constant O_Enode := null;
+
+   type O_Enode_Type (Kind : OE_Kind) is record
+      --  Type of the result.
+      Rtype : O_Tnode;
+      --  True if referenced.
+      Ref : Boolean;
+      case Kind is
+         when OE_Dyadic_Expr_Kind
+           | OE_Compare_Expr_Kind =>
+            Left : O_Enode;
+            Right : O_Enode;
+         when OE_Monadic_Expr_Kind =>
+            Operand : O_Enode;
+         when OE_Lit =>
+            Lit : O_Cnode;
+         when OE_Address
+           | OE_Unchecked_Address =>
+            Lvalue : O_Lnode;
+         when OE_Convert_Ov =>
+            Conv : O_Enode;
+         when OE_Function_Call =>
+            Func : O_Dnode;
+            Assoc : O_Anode;
+         when OE_Value =>
+            Value : O_Lnode;
+         when OE_Alloca =>
+            A_Size : O_Enode;
+         when OE_Nil =>
+            null;
+      end case;
+   end record;
+   type O_Enode_Array is array (Natural range <>) of O_Enode;
+   type O_Enode_Array_Acc is access O_Enode_Array;
+
+   type OL_Kind is
+     (
+      --  Name.
+      OL_Obj,
+      OL_Indexed_Element,
+      OL_Slice,
+      OL_Selected_Element,
+      OL_Access_Element
+
+      --  Variable, constant, parameter reference.
+      --  This allows to read/write a declaration.
+      --OL_Var_Ref,
+      --OL_Const_Ref,
+      --OL_Param_Ref
+      );
+
+   type O_Lnode_Type (Kind : OL_Kind);
+   type O_Lnode is access O_Lnode_Type;
+   O_Lnode_Null : constant O_Lnode := null;
+
+   type O_Lnode_Type (Kind : OL_Kind) is record
+      --  Type of the result.
+      Rtype : O_Tnode;
+      --  True if referenced.
+      Ref : Boolean;
+      case Kind is
+         when OL_Obj =>
+            Obj : O_Dnode;
+         when OL_Indexed_Element =>
+            Array_Base : O_Lnode;
+            Index : O_Enode;
+         when OL_Slice =>
+            Slice_Base : O_Lnode;
+            Slice_Index : O_Enode;
+         when OL_Selected_Element =>
+            Rec_Base : O_Lnode;
+            Rec_El : O_Fnode;
+         when OL_Access_Element =>
+            Acc_Base : O_Enode;
+--          when OL_Var_Ref
+--            | OL_Const_Ref
+--            | OL_Param_Ref =>
+--             Decl : O_Dnode;
+      end case;
+   end record;
+
+   O_Tnode_Null : constant O_Tnode := null;
+   type ON_Type_Kind is
+     (ON_Boolean_Type, ON_Enum_Type,
+      ON_Unsigned_Type, ON_Signed_Type, ON_Float_Type, ON_Array_Type,
+      ON_Array_Sub_Type, ON_Record_Type, ON_Union_Type, ON_Access_Type);
+   type O_Tnode_Type (Kind : ON_Type_Kind) is record
+      Decl : O_Dnode;
+      --  True if the type was first created as an uncomplete type.
+      Uncomplete : Boolean;
+      --  True if the type is complete.
+      Complete : Boolean;
+      case Kind is
+         when ON_Boolean_Type =>
+            True_N : O_Cnode;
+            False_N : O_Cnode;
+         when ON_Unsigned_Type
+           | ON_Signed_Type =>
+            Int_Size : Natural;
+         when ON_Float_Type =>
+            null;
+         when ON_Enum_Type =>
+            Nbr : Natural;
+            Literals: O_Cnode;
+         when ON_Array_Type =>
+            El_Type : O_Tnode;
+            Index_Type : O_Tnode;
+         when ON_Access_Type =>
+            D_Type : O_Tnode;
+         when ON_Record_Type
+           | ON_Union_Type =>
+            Elements : O_Fnode;
+         when ON_Array_Sub_Type =>
+            Length : O_Cnode;
+            Base_Type : O_Tnode;
+      end case;
+   end record;
+
+   type ON_Choice_Kind is (ON_Choice_Expr, ON_Choice_Range, ON_Choice_Default);
+   type O_Choice_Type (Kind : ON_Choice_Kind);
+   type O_Choice is access O_Choice_Type;
+   type O_Choice_Type (Kind : ON_Choice_Kind) is record
+      Next : O_Choice;
+      case Kind is
+         when ON_Choice_Expr =>
+            Expr : O_Cnode;
+         when ON_Choice_Range =>
+            Low, High : O_Cnode;
+         when ON_Choice_Default =>
+            null;
+      end case;
+   end record;
+
+   O_Snode_Null : constant O_Snode := null;
+   type ON_Stmt_Kind is
+     (ON_Declare_Stmt, ON_Assign_Stmt, ON_Return_Stmt, ON_If_Stmt,
+      ON_Elsif_Stmt, ON_Loop_Stmt, ON_Exit_Stmt, ON_Next_Stmt,
+      ON_Case_Stmt, ON_When_Stmt, ON_Call_Stmt,
+      ON_Debug_Line_Stmt, ON_Debug_Comment_Stmt);
+   type O_Snode_Type (Kind : ON_Stmt_Kind) is record
+      Next : O_Snode;
+      Lineno : Natural;
+      case Kind is
+         when ON_Declare_Stmt =>
+            Decls : O_Dnode;
+            Stmts : O_Snode;
+            --  True if the statement is currently open.
+            Alive : Boolean;
+         when ON_Assign_Stmt =>
+            Target : O_Lnode;
+            Value : O_Enode;
+         when ON_Return_Stmt =>
+            Ret_Val : O_Enode;
+         when ON_If_Stmt =>
+            Elsifs : O_Snode;
+            If_Last : O_Snode;
+         when ON_Elsif_Stmt =>
+            Cond : O_Enode;
+            Next_Elsif : O_Snode;
+         when ON_Loop_Stmt =>
+            Loop_Last : O_Snode;
+            Loop_Level : Natural;
+         when ON_Exit_Stmt
+           | ON_Next_Stmt =>
+            Loop_Id : O_Snode;
+         when ON_Case_Stmt =>
+            Selector : O_Enode;
+            --  Simply linked list of branches
+            Branches : O_Snode;
+            Case_Last : O_Snode;
+         when ON_When_Stmt =>
+            --  The corresponding 'case'
+            Branch_Parent : O_Snode;
+            Choice_List : O_Choice;
+            Next_Branch : O_Snode;
+         when ON_Call_Stmt =>
+            Proc : O_Dnode;
+            Assoc : O_Anode;
+         when ON_Debug_Line_Stmt =>
+            Line : Natural;
+         when ON_Debug_Comment_Stmt =>
+            Comment : Str_Acc;
+      end case;
+   end record;
+
+   type O_Inter_List is record
+      Func : O_Dnode;
+      Last : O_Dnode;
+   end record;
+
+   type O_Element_List is record
+      --  The type definition.
+      Res : O_Tnode;
+      --  The last element added.
+      Last : O_Fnode;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Res : O_Cnode;
+      Last : O_Cnode;
+      Field : O_Fnode;
+   end record;
+
+   type O_Array_Aggr_List is record
+      Res : O_Cnode;
+      Last : O_Cnode;
+      El_Type : O_Tnode;
+   end record;
+
+   type O_Assoc_List is record
+      Subprg : O_Dnode;
+      Interfaces : O_Dnode;
+      First, Last : O_Anode;
+   end record;
+
+   type O_Enum_List is record
+      --  The type built.
+      Res : O_Tnode;
+
+      --  the chain of declarations.
+      Last : O_Cnode;
+   end record;
+   type O_Case_Block is record
+      Case_Stmt : O_Snode;
+   end record;
+
+   type O_If_Block is record
+      null;
+   end record;
+end Ortho_Debug;
diff --git a/src/ortho/debug/ortho_debug_front.ads b/src/ortho/debug/ortho_debug_front.ads
new file mode 100644
index 000000000..17e32c9ed
--- /dev/null
+++ b/src/ortho/debug/ortho_debug_front.ads
@@ -0,0 +1,20 @@
+--  Ortho debug interface with front-end.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ortho_Front;
+package Ortho_Debug_Front renames Ortho_Front;
diff --git a/src/ortho/debug/ortho_ident.ads b/src/ortho/debug/ortho_ident.ads
new file mode 100644
index 000000000..46aa8854d
--- /dev/null
+++ b/src/ortho/debug/ortho_ident.ads
@@ -0,0 +1,20 @@
+--  Ortho debug back-end interface with identifiers package.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ortho_Ident_Simple;
+package Ortho_Ident renames Ortho_Ident_Simple;
diff --git a/src/ortho/debug/ortho_ident_hash.adb b/src/ortho/debug/ortho_ident_hash.adb
new file mode 100644
index 000000000..60ab89586
--- /dev/null
+++ b/src/ortho/debug/ortho_ident_hash.adb
@@ -0,0 +1,72 @@
+--  Ortho debug hashed identifiers implementation.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Ortho_Ident_Hash is
+   type O_Ident_Array is array (Hash_Type range <>) of O_Ident;
+   Hash_Max : constant Hash_Type := 511;
+   Symtable : O_Ident_Array (0 .. Hash_Max - 1) := (others => null);
+
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Hash : Hash_Type;
+      Ent : Hash_Type;
+      Res : O_Ident;
+   begin
+      --  1.  Compute Hash.
+      Hash := 0;
+      for I in Str'Range loop
+         Hash := Hash * 31 + Character'Pos (Str (I));
+      end loop;
+
+      --  2.  Search.
+      Ent := Hash mod Hash_Max;
+      Res := Symtable (Ent);
+      while Res /= null loop
+         if Res.Hash = Hash and then Res.Ident.all = Str then
+            return Res;
+         end if;
+         Res := Res.Next;
+      end loop;
+
+      --  Not found: add.
+      Res := new Ident_Type'(Hash => Hash,
+                             Ident => new String'(Str),
+                             Next => Symtable (Ent));
+      Symtable (Ent) := Res;
+      return Res;
+   end Get_Identifier;
+
+   function Get_String (Id : O_Ident) return String is
+   begin
+      if Id = null then
+         return "?ANON?";
+      else
+         return Id.Ident.all;
+      end if;
+   end Get_String;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = null;
+   end Is_Nul;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean is
+   begin
+      return Id.Ident.all = Str;
+   end Is_Equal;
+end Ortho_Ident_Hash;
diff --git a/src/ortho/debug/ortho_ident_hash.ads b/src/ortho/debug/ortho_ident_hash.ads
new file mode 100644
index 000000000..a6e4a56cc
--- /dev/null
+++ b/src/ortho/debug/ortho_ident_hash.ads
@@ -0,0 +1,46 @@
+--  Ortho debug hashed identifiers implementation.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Ortho_Ident_Hash is
+   type O_Ident is private;
+   O_Ident_Nul : constant O_Ident;
+
+   function Get_Identifier (Str : String) return O_Ident;
+   function Get_String (Id : O_Ident) return String;
+   function Is_Equal (L, R : O_Ident) return Boolean renames "=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   function Is_Nul (Id : O_Ident) return Boolean;
+private
+   type Hash_Type is mod 2**32;
+
+   type String_Acc is access constant String;
+
+   --  Symbol table.
+   type Ident_Type;
+   type O_Ident is access Ident_Type;
+   type Ident_type is record
+      --  The hash for the symbol.
+      Hash : Hash_Type;
+      --  Identification of the symbol.
+      Ident : String_Acc;
+      --  Next symbol with the same collision.
+      Next : O_Ident;
+   end record;
+
+   O_Ident_Nul : constant O_Ident := null;
+end Ortho_Ident_Hash;
diff --git a/src/ortho/debug/ortho_ident_simple.adb b/src/ortho/debug/ortho_ident_simple.adb
new file mode 100644
index 000000000..83b9756f8
--- /dev/null
+++ b/src/ortho/debug/ortho_ident_simple.adb
@@ -0,0 +1,44 @@
+--  Ortho debug identifiers simple implementation.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Ortho_Ident_Simple is
+   function Get_Identifier (Str : String) return O_Ident
+   is
+   begin
+      return new String'(Str);
+   end Get_Identifier;
+
+   function Get_String (Id : O_Ident) return String is
+   begin
+      if Id = null then
+         return "?ANON?";
+      else
+         return Id.all;
+      end if;
+   end Get_String;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = null;
+   end Is_Nul;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean is
+   begin
+      return Id.all = Str;
+   end Is_Equal;
+end Ortho_Ident_Simple;
diff --git a/src/ortho/debug/ortho_ident_simple.ads b/src/ortho/debug/ortho_ident_simple.ads
new file mode 100644
index 000000000..f94fe1938
--- /dev/null
+++ b/src/ortho/debug/ortho_ident_simple.ads
@@ -0,0 +1,31 @@
+--  Ortho debug identifiers simple implementation.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Ortho_Ident_Simple is
+   type O_Ident is private;
+   O_Ident_Nul : constant O_Ident;
+
+   function Get_Identifier (Str : String) return O_Ident;
+   function Get_String (Id : O_Ident) return String;
+   function Is_Equal (L, R : O_Ident) return Boolean renames "=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   function Is_Nul (Id : O_Ident) return Boolean;
+private
+   type O_Ident is access String;
+   O_Ident_Nul : constant O_Ident := null;
+end Ortho_Ident_Simple;
diff --git a/src/ortho/debug/ortho_nodes.ads b/src/ortho/debug/ortho_nodes.ads
new file mode 100644
index 000000000..8ade66722
--- /dev/null
+++ b/src/ortho/debug/ortho_nodes.ads
@@ -0,0 +1,21 @@
+--  Ortho debug back-end interface with front-end.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ortho_Debug;
+
+package Ortho_Nodes renames Ortho_Debug;
diff --git a/src/ortho/gcc/Makefile b/src/ortho/gcc/Makefile
new file mode 100644
index 000000000..5aafb31c7
--- /dev/null
+++ b/src/ortho/gcc/Makefile
@@ -0,0 +1,86 @@
+ortho_srcdir=..
+orthobe_srcdir=$(ortho_srcdir)/gcc
+agcc_objdir=.
+agcc_srcdir=$(ortho_srcdir)/gcc
+SED=sed
+BE=gcc
+GNATMAKE=gnatmake
+CC=gcc
+CXX=g++
+COMPILER=$(CXX)
+LINKER=$(CXX)
+
+# Modify AGCC_GCCSRC_DIR and AGCC_GCCOBJ_DIR for your environment
+AGCC_GCCSRC_DIR:=$(HOME)/Projects/gcc4.9.2/source/gcc-4.9.2/
+AGCC_GCCOBJ_DIR:=$(HOME)/Projects/gcc4.9.2/build/
+
+# Supplied by main GCC Makefile, copied here for compatibility with same
+GMPLIBS = -L$(AGCC_GCCOBJ_DIR)./gmp/.libs -L$(AGCC_GCCOBJ_DIR)./mpfr/.libs \
+  -L$(AGCC_GCCOBJ_DIR)./mpc/src/.libs -lmpc -lmpfr -lgmp
+GMPINC = -I$(AGCC_GCCOBJ_DIR)./gmp -I$(AGCC_GCCSRC_DIR)/gmp \
+  -I$(AGCC_GCCOBJ_DIR)./mpfr -I$(AGCC_GCCSRC_DIR)/mpfr \
+  -I$(AGCC_GCCSRC_DIR)/mpc/src
+
+HOST_LIBS =
+ZLIB=-lz
+
+# Override variables in Makefile.conf for your environment
+-include $(orthobe_srcdir)/Makefile.conf
+
+all: $(ortho_exec)
+
+ORTHO_BASENAME=ortho_gcc
+include $(ortho_srcdir)/Makefile.inc
+
+AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \
+ -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config \
+ -I$(AGCC_GCCSRC_DIR)/libcpp/include $(GMPINC)
+AGCC_CFLAGS=-g -Wall -DIN_GCC $(AGCC_INC_FLAGS)
+
+ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \
+ $(AGCC_GCCOBJ_DIR)gcc/gtype-vhdl.h \
+ $(AGCC_GCCOBJ_DIR)gcc/gt-vhdl-ortho-lang.h
+	$(COMPILER) -c -o $@ $< $(AGCC_CFLAGS) $(INCLUDES)
+
+AGCC_LOCAL_OBJS=ortho-lang.o
+
+AGCC_DEPS := $(AGCC_LOCAL_OBJS)
+AGCC_OBJS := $(AGCC_LOCAL_OBJS) \
+	$(AGCC_GCCOBJ_DIR)gcc/attribs.o \
+	$(AGCC_GCCOBJ_DIR)libcpp/libcpp.a \
+	$(AGCC_GCCOBJ_DIR)libiberty/libiberty.a
+
+LIBBACKTRACE = $(AGCC_GCCOBJ_DIR)/libbacktrace/.libs/libbacktrace.a
+LIBDECNUMBER = $(AGCC_GCCOBJ_DIR)/libdecnumber/libdecnumber.a
+LIBIBERTY = $(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a
+CPPLIB= # Not needed for GHDL
+
+BACKEND = $(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \
+         $(AGCC_GCCOBJ_DIR)/gcc/libcommon-target.a
+
+BACKENDLIBS = $(CLOOGLIBS) $(GMPLIBS) $(PLUGINLIBS) $(HOST_LIBS) \
+	$(ZLIB)
+LIBS =  $(AGCC_GCCOBJ_DIR)/gcc/libcommon.a \
+        $(CPPLIB) $(LIBINTL) $(LIBICONV) $(LIBBACKTRACE) \
+	$(LIBIBERTY) $(LIBDECNUMBER) $(HOST_LIBS)
+
+$(ortho_exec): $(AGCC_DEPS) $(orthobe_srcdir)/ortho_gcc.ads force
+	$(GNATMAKE) -m -o $@ -g -aI$(ortho_srcdir) \
+	 -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \
+	 -bargs -E -largs --LINK=$(LINKER) $(AGCC_OBJS) \
+        $(BACKEND) $(LIBS) $(BACKENDLIBS)
+
+agcc-clean: force
+	$(RM) -f $(agcc_objdir)/*.o
+	$(RM) -f $(agcc_srcdir)/*~
+
+clean: agcc-clean
+	$(RM) -f *.o *.ali ortho_nodes-main
+	$(RM) b~*.ad? *~
+
+distclean: clean agcc-clean
+
+
+force:
+
+.PHONY: force all clean agcc-clean
diff --git a/src/ortho/gcc/Makefile.conf.linux b/src/ortho/gcc/Makefile.conf.linux
new file mode 100644
index 000000000..00ea91728
--- /dev/null
+++ b/src/ortho/gcc/Makefile.conf.linux
@@ -0,0 +1,4 @@
+# Example Makefile.conf
+# Copy this file to Makefile.conf and edit as necessary for your platform
+
+HOST_LIBS = -ldl -lstdc++
diff --git a/src/ortho/gcc/lang.opt b/src/ortho/gcc/lang.opt
new file mode 100644
index 000000000..562fbe08d
--- /dev/null
+++ b/src/ortho/gcc/lang.opt
@@ -0,0 +1,96 @@
+Language
+vhdl
+
+-std=
+vhdl Joined
+Select the vhdl standard
+
+-compile-standard
+vhdl
+Used during compiler build to compile the std.standard package
+
+-bootstrap
+vhdl
+Used during compiler build to compile std packages
+
+-work=
+vhdl Joined
+Set the name of the work library
+
+-workdir=
+vhdl Joined
+Set the directory of the work library
+
+P
+vhdl JoinedOrMissing
+;-P<dir>	Add <dir> to the end of the vhdl library path
+
+-elab
+vhdl Separate
+--elab <name>	Used internally during elaboration of <name>
+
+-anaelab
+vhdl Separate
+--anaelab <name>	Used internally during elaboration of <name>
+
+; -c is a driver option for gcc.  --ghdl-source is used instead.
+;c
+;vhdl Separate
+;-c <filename>	Analyze <filename> for --anaelab
+
+;v
+;vhdl
+;Verbose
+
+-warn-
+vhdl Joined
+--warn-<name>	Warn about <name>
+
+-ghdl
+vhdl Joined
+--ghdl-<option>	Pass <option> to vhdl front-end
+
+-expect-failure
+vhdl
+Expect a compiler error (used for testsuite)
+
+-no-vital-checks
+vhdl
+Disable VITAL checks
+
+-vital-checks
+vhdl
+Enable VITAL checks
+
+fexplicit
+vhdl
+Explicit function declarations override implicit one in use
+
+frelaxed-rules
+vhdl
+Relax some LRM rules to compile vendor libraries
+
+fpsl
+vhdl
+Allow PSL asserts in comments
+
+-no-direct-drivers
+vhdl
+Disable direct drivers optimization
+
+-syn-binding
+vhdl
+Use synthetizer rules for default bindings
+
+l
+vhdl Joined Separate
+-l<filename>	Put list of files for link in <filename>
+
+; -C was commented out, as it is already defined for C/C++.
+;C
+;vhdl
+;Allow any character in comments
+
+-mb-comments
+vhdl
+Allow any character in comments
diff --git a/src/ortho/gcc/ortho-lang.c b/src/ortho/gcc/ortho-lang.c
new file mode 100644
index 000000000..c19012e6e
--- /dev/null
+++ b/src/ortho/gcc/ortho-lang.c
@@ -0,0 +1,2191 @@
+/* GCC back-end for ortho
+  Copyright (C) 2002-1014 Tristan Gingold and al.
+
+  GHDL is free software; you can redistribute it and/or modify it under
+  the terms of the GNU General Public License as published by the Free
+  Software Foundation; either version 2, or (at your option) any later
+  version.
+
+  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+  for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with GCC; see the file COPYING.  If not, write to the Free
+  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+  02111-1307, USA.  */
+
+#include <stddef.h>
+#include <math.h>
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "tm_p.h"
+#include "defaults.h"
+#include "ggc.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "toplev.h"
+#include "opts.h"
+#include "options.h"
+#include "real.h"
+#include "tree-iterator.h"
+#include "function.h"
+#include "cgraph.h"
+#include "target.h"
+#include "convert.h"
+#include "tree-pass.h"
+#include "tree-dump.h"
+
+/* Undefine for gcc-4.8  */
+#define GCC49
+
+#ifdef GCC49
+
+#include "print-tree.h"
+#include "stringpool.h"
+#include "stor-layout.h"
+#include "varasm.h"
+
+/* Returns the number of FIELD_DECLs in TYPE.
+   Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h.  */
+
+static int
+fields_length (const_tree type)
+{
+  tree t = TYPE_FIELDS (type);
+  int count = 0;
+
+  for (; t; t = DECL_CHAIN (t))
+    if (TREE_CODE (t) == FIELD_DECL)
+      ++count;
+
+  return count;
+}
+
+#else
+
+// adapt gcc4.9 practice to gcc4.8 functions
+bool
+tree_fits_uhwi_p (const_tree t)
+{
+  return host_integerp (t, 1);
+}
+
+unsigned HOST_WIDE_INT
+tree_to_uhwi (const_tree t)
+{
+  return tree_low_cst (t, 1);
+}
+
+#endif
+
+/* TODO:
+ * remove stmt_list_stack, save in if/case/loop block
+ * Re-add -v (if necessary)
+ */
+
+static tree type_for_size (unsigned int precision, int unsignedp);
+
+const int tree_identifier_size = sizeof (struct tree_identifier);
+
+struct GTY(()) binding_level
+{
+  /*  The BIND_EXPR node for this binding.  */
+  tree bind;
+
+  /*  The BLOCK node for this binding.  */
+  tree block;
+
+  /*  If true, stack must be saved (alloca is used).  */
+  int save_stack;
+
+  /*  Parent binding level.  */
+  struct binding_level *prev;
+
+  /*  Decls in this binding.  */
+  tree first_decl;
+  tree last_decl;
+
+  /*  Blocks in this binding.  */
+  tree first_block;
+  tree last_block;
+};
+
+/*  The current binding level.  */
+static GTY(()) struct binding_level *cur_binding_level = NULL;
+
+/*  Chain of unused binding levels.  */
+static GTY(()) struct binding_level *old_binding_levels = NULL;
+
+/*  Chain of statements currently generated.  */
+static GTY(()) tree cur_stmts = NULL_TREE;
+
+static void
+push_binding (void)
+{
+  struct binding_level *res;
+
+  if (old_binding_levels == NULL)
+    res = ggc_alloc_binding_level ();
+  else
+    {
+      res = old_binding_levels;
+      old_binding_levels = res->prev;
+    }
+
+  /* Init.  */
+  res->first_decl = NULL_TREE;
+  res->last_decl = NULL_TREE;
+
+  res->first_block = NULL_TREE;
+  res->last_block = NULL_TREE;
+
+  res->save_stack = 0;
+
+  res->bind = make_node (BIND_EXPR);
+  res->block = make_node (BLOCK);
+  BIND_EXPR_BLOCK (res->bind) = res->block;
+  TREE_SIDE_EFFECTS (res->bind) = true;
+  TREE_TYPE (res->bind) = void_type_node;
+  TREE_USED (res->block) = true;
+
+  if (cur_binding_level != NULL)
+    {
+      /* Append the block created.  */
+      if (cur_binding_level->first_block == NULL)
+	cur_binding_level->first_block = res->block;
+      else
+	BLOCK_CHAIN (cur_binding_level->last_block) = res->block;
+      cur_binding_level->last_block = res->block;
+
+      BLOCK_SUPERCONTEXT (res->block) = cur_binding_level->block;
+    }
+
+  res->prev = cur_binding_level;
+  cur_binding_level = res;
+}
+
+static void
+push_decl (tree decl)
+{
+  DECL_CONTEXT (decl) = current_function_decl;
+
+  if (cur_binding_level->first_decl == NULL)
+    cur_binding_level->first_decl = decl;
+  else
+    TREE_CHAIN (cur_binding_level->last_decl) = decl;
+  cur_binding_level->last_decl = decl;
+}
+
+static tree
+pop_binding (void)
+{
+  tree res;
+  struct binding_level *cur;
+
+  cur = cur_binding_level;
+  res = cur->bind;
+
+  if (cur->save_stack)
+    {
+      tree tmp_var;
+      tree save;
+      tree save_call;
+      tree restore;
+      tree t;
+
+      /* Create an artificial var to save the stack pointer.  */
+      tmp_var = build_decl (input_location, VAR_DECL, NULL, ptr_type_node);
+      DECL_ARTIFICIAL (tmp_var) = true;
+      DECL_IGNORED_P (tmp_var) = true;
+      TREE_USED (tmp_var) = true;
+      push_decl (tmp_var);
+
+      /* Create the save stmt.  */
+      save_call = build_call_expr
+	(builtin_decl_implicit (BUILT_IN_STACK_SAVE), 0);
+      save = build2 (MODIFY_EXPR, ptr_type_node, tmp_var, save_call);
+      TREE_SIDE_EFFECTS (save) = true;
+
+      /* Create the restore stmt.  */
+      restore = build_call_expr
+	(builtin_decl_implicit (BUILT_IN_STACK_RESTORE), 1, tmp_var);
+
+      /* Build a try-finally block.
+	 The statement list is the block of current statements.  */
+      t = build2 (TRY_FINALLY_EXPR, void_type_node, cur_stmts, NULL_TREE);
+      TREE_SIDE_EFFECTS (t) = true;
+
+      /* The finally block is the restore stmt.  */
+      append_to_statement_list (restore, &TREE_OPERAND (t, 1));
+
+      /* The body of the BIND_BLOCK is the save stmt, followed by the
+	 try block.  */
+      BIND_EXPR_BODY (res) = NULL_TREE;
+      append_to_statement_list (save, &BIND_EXPR_BODY (res));
+      append_to_statement_list (t, &BIND_EXPR_BODY (res));
+    }
+  else
+    {
+      /* The body of the BIND_BLOCK is the statement block.  */
+      BIND_EXPR_BODY (res) = cur_stmts;
+    }
+  BIND_EXPR_VARS (res) = cur->first_decl;
+
+  BLOCK_SUBBLOCKS (cur->block) = cur->first_block;
+  BLOCK_VARS (cur->block) = cur->first_decl;
+
+  cur_binding_level = cur->prev;
+  cur->prev = old_binding_levels;
+  old_binding_levels = cur;
+
+  return res;
+}
+
+// naive conversion to new vec API following the wiki at
+// http://gcc.gnu.org/wiki/cxx-conversion/cxx-vec
+// see also push_stmts, pop_stmts
+static vec <tree> stmt_list_stack = vec<tree>();
+
+static void
+push_stmts (tree stmts)
+{
+  stmt_list_stack.safe_push(cur_stmts);
+  cur_stmts = stmts;
+}
+
+static void
+pop_stmts (void)
+{
+  cur_stmts = stmt_list_stack.pop();
+}
+
+static void
+append_stmt (tree stmt)
+{
+  if (!EXPR_HAS_LOCATION (stmt))
+    SET_EXPR_LOCATION (stmt, input_location);
+  TREE_SIDE_EFFECTS (stmt) = true;
+  append_to_statement_list (stmt, &cur_stmts);
+}
+
+static GTY(()) tree top;
+
+static GTY(()) tree stack_alloc_function_ptr;
+
+static bool
+global_bindings_p (void)
+{
+  return cur_binding_level->prev == NULL;
+}
+
+static tree
+pushdecl (tree t)
+{
+  //gcc_unreachable ();
+  // gcc4.8.2 we get here from build_common_builtin_nodes () call in ortho_init
+  return t;
+}
+
+static tree
+builtin_function (const char *name,
+		  tree type,
+		  int function_code,
+		  enum built_in_class decl_class,
+		  const char *library_name,
+		  tree attrs ATTRIBUTE_UNUSED);
+
+REAL_VALUE_TYPE fp_const_p5; /* 0.5 */
+REAL_VALUE_TYPE fp_const_m_p5; /* -0.5 */
+REAL_VALUE_TYPE fp_const_zero; /* 0.0 */
+
+static bool
+ortho_init (void)
+{
+  tree n;
+
+  input_location = BUILTINS_LOCATION;
+
+  /* Create a global binding.  */
+  push_binding ();
+
+  build_common_tree_nodes (0, 0);
+
+  n = build_decl (input_location,
+                  TYPE_DECL, get_identifier ("int"), integer_type_node);
+  push_decl (n);
+  n = build_decl (input_location,
+                  TYPE_DECL, get_identifier ("char"), char_type_node);
+  push_decl (n);
+
+  /* Create alloca builtin.  */
+  {
+    tree args_type = tree_cons (NULL_TREE, size_type_node, void_list_node);
+    tree func_type = build_function_type (ptr_type_node, args_type);
+
+    set_builtin_decl
+      (BUILT_IN_ALLOCA,
+       builtin_function
+       ("__builtin_alloca", func_type,
+	BUILT_IN_ALLOCA, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+
+    stack_alloc_function_ptr = build1
+      (ADDR_EXPR,
+       build_pointer_type (func_type),
+       builtin_decl_implicit (BUILT_IN_ALLOCA));
+  }
+
+  {
+    tree ptr_ftype = build_function_type (ptr_type_node, NULL_TREE);
+
+    set_builtin_decl
+      (BUILT_IN_STACK_SAVE,
+       builtin_function
+       ("__builtin_stack_save", ptr_ftype,
+	BUILT_IN_STACK_SAVE, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+  }
+
+  {
+    tree ftype_ptr;
+
+    ftype_ptr = build_function_type
+      (void_type_node,
+       tree_cons (NULL_TREE, ptr_type_node, NULL_TREE));
+
+    set_builtin_decl
+      (BUILT_IN_STACK_RESTORE,
+       builtin_function
+       ("__builtin_stack_restore", ftype_ptr,
+	BUILT_IN_STACK_RESTORE, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+  }
+  {
+    REAL_VALUE_TYPE v;
+
+    REAL_VALUE_FROM_INT (v, 1, 0, DFmode);
+    real_ldexp (&fp_const_p5, &v, -1);
+
+    REAL_VALUE_FROM_INT (v, -1, -1, DFmode);
+    real_ldexp (&fp_const_m_p5, &v, -1);
+
+    REAL_VALUE_FROM_INT (fp_const_zero, 0, 0, DFmode);
+  }
+
+  build_common_builtin_nodes ();
+  // FIXME: this MAY remove the need for creating the builtins above...
+  // Evaluate tree.c / build_common_builtin_nodes (); for each in turn.
+
+  return true;
+}
+
+static void
+ortho_finish (void)
+{
+}
+
+static unsigned int
+ortho_option_lang_mask (void)
+{
+  return CL_vhdl;
+}
+
+static bool
+ortho_post_options (const char **pfilename)
+{
+  if (*pfilename == NULL || strcmp (*pfilename, "-") == 0)
+    *pfilename = "*stdin*";
+
+  /* Default hook.  */
+  lhd_post_options (pfilename);
+
+  // This stops compile failures writing debug information when both -g and -O2
+  // (or -O1, -O3 or -Os) options are present.
+  // Should really make it conditional on specific options
+  // FIXME : re-evaluate if this is still necessary with newer gccrevisions
+  dwarf_strict = 1;
+
+  /* Run the back-end.  */
+  return false;
+}
+
+extern "C" int lang_handle_option (const char *opt, const char *arg);
+
+static bool
+ortho_handle_option (size_t code, const char *arg,
+		     int value ATTRIBUTE_UNUSED,
+		     int kind ATTRIBUTE_UNUSED,
+                     location_t loc ATTRIBUTE_UNUSED,
+                     const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
+{
+  const char *opt;
+
+  opt = cl_options[code].opt_text;
+
+  switch (code)
+    {
+    case OPT__elab:
+    case OPT_l:
+    case OPT_c:
+    case OPT__anaelab:
+      /* Only a few options have a real arguments.  */
+      return lang_handle_option (opt, arg) != 0;
+    default:
+      /* The other options must have a joint argument.  */
+      if (arg != NULL)
+	{
+	  size_t len1;
+	  size_t len2;
+	  char *nopt;
+
+	  len1 = strlen (opt);
+	  len2 = strlen (arg);
+	  nopt = (char *) alloca (len1 + len2 + 1);
+	  memcpy (nopt, opt, len1);
+	  memcpy (nopt + len1, arg, len2);
+	  nopt[len1 + len2] = 0;
+	  opt = nopt;
+	}
+      return lang_handle_option (opt, NULL) != 0;
+    }
+}
+
+extern "C" int lang_parse_file (const char *filename);
+
+static void
+ortho_parse_file (void)
+{
+  const char *filename;
+
+  if (num_in_fnames == 0)
+    filename = NULL;
+  else
+    filename = in_fnames[0];
+
+  linemap_add (line_table, LC_ENTER, 0, filename ? filename :"*no-file*", 1);
+  input_location = linemap_line_start (line_table, 1, 252);
+
+  if (!lang_parse_file (filename))
+    errorcount++;
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 1);
+}
+
+/*  Called by the back-end or by the front-end when the address of EXP
+    must be taken.
+    This function should found the base object (if any), and mark it as
+    addressable (via TREE_ADDRESSABLE).  It may emit a warning if this
+    object cannot be addressable (front-end restriction).
+    Returns TRUE in case of success, FALSE in case of failure.
+    Note that the status is never checked by the back-end.  */
+static bool
+ortho_mark_addressable (tree exp)
+{
+  tree n;
+
+  n = exp;
+
+  while (1)
+    switch (TREE_CODE (n))
+      {
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+	TREE_ADDRESSABLE (n) = true;
+	return true;
+
+      case COMPONENT_REF:
+      case ARRAY_REF:
+      case ARRAY_RANGE_REF:
+	n = TREE_OPERAND (n, 0);
+	break;
+
+      case FUNCTION_DECL:
+      case CONSTRUCTOR:
+	TREE_ADDRESSABLE (n) = true;
+	return true;
+
+      case INDIRECT_REF:
+	return true;
+
+      default:
+	gcc_unreachable ();
+      }
+}
+
+static tree
+ortho_truthvalue_conversion (tree expr)
+{
+  tree expr_type;
+  tree t;
+  tree f;
+
+  expr_type = TREE_TYPE (expr);
+  if (TREE_CODE (expr_type) != BOOLEAN_TYPE)
+    {
+      t = integer_one_node;
+      f = integer_zero_node;
+    }
+  else
+    {
+      f = TYPE_MIN_VALUE (expr_type);
+      t = TYPE_MAX_VALUE (expr_type);
+    }
+
+
+  switch (TREE_CODE (expr))
+    {
+    case EQ_EXPR:
+    case NE_EXPR:
+    case LE_EXPR:
+    case GE_EXPR:
+    case LT_EXPR:
+    case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case ERROR_MARK:
+      return expr;
+
+    case INTEGER_CST:
+      /* Not 0 is true.  */
+      return integer_zerop (expr) ? f : t;
+
+    case REAL_CST:
+      return real_zerop (expr) ? f : t;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+/* The following function has been copied and modified from c-convert.c.  */
+
+/* Change of width--truncation and extension of integers or reals--
+   is represented with NOP_EXPR.  Proper functioning of many things
+   assumes that no other conversions can be NOP_EXPRs.
+
+   Conversion between integer and pointer is represented with CONVERT_EXPR.
+   Converting integer to real uses FLOAT_EXPR
+   and real to integer uses FIX_TRUNC_EXPR.
+
+   Here is a list of all the functions that assume that widening and
+   narrowing is always done with a NOP_EXPR:
+     In convert.c, convert_to_integer.
+     In c-typeck.c, build_binary_op (boolean ops), and
+	c_common_truthvalue_conversion.
+     In expr.c: expand_expr, for operands of a MULT_EXPR.
+     In fold-const.c: fold.
+     In tree.c: get_narrower and get_unwidened.  */
+
+/* Subroutines of `convert'.  */
+
+
+
+/* Create an expression whose value is that of EXPR,
+   converted to type TYPE.  The TREE_TYPE of the value
+   is always TYPE.  This function implements all reasonable
+   conversions; callers should filter out those that are
+   not permitted by the language being compiled.  */
+
+tree
+convert (tree type, tree expr)
+{
+  tree e = expr;
+  enum tree_code code = TREE_CODE (type);
+  const char *invalid_conv_diag;
+
+  if (type == error_mark_node
+      || expr == error_mark_node
+      || TREE_TYPE (expr) == error_mark_node)
+    return error_mark_node;
+
+  if ((invalid_conv_diag
+       = targetm.invalid_conversion (TREE_TYPE (expr), type)))
+    {
+      error (invalid_conv_diag);
+      return error_mark_node;
+    }
+
+  if (type == TREE_TYPE (expr))
+    return expr;
+
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
+    return fold_build1 (NOP_EXPR, type, expr);
+  if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE || code == VOID_TYPE)
+    {
+      gcc_unreachable ();
+    }
+  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+    return fold (convert_to_integer (type, e));
+  if (code == BOOLEAN_TYPE)
+    {
+      tree t = ortho_truthvalue_conversion (expr);
+      if (TREE_CODE (t) == ERROR_MARK)
+	return t;
+
+      /* If it returns a NOP_EXPR, we must fold it here to avoid
+	 infinite recursion between fold () and convert ().  */
+      if (TREE_CODE (t) == NOP_EXPR)
+	return fold_build1 (NOP_EXPR, type, TREE_OPERAND (t, 0));
+      else
+	return fold_build1 (NOP_EXPR, type, t);
+    }
+  if (code == POINTER_TYPE || code == REFERENCE_TYPE)
+    return fold (convert_to_pointer (type, e));
+  if (code == REAL_TYPE)
+    return fold (convert_to_real (type, e));
+
+  gcc_unreachable ();
+}
+
+/* Return a definition for a builtin function named NAME and whose data type
+   is TYPE.  TYPE should be a function type with argument types.
+   FUNCTION_CODE tells later passes how to compile calls to this function.
+   See tree.h for its possible values.
+
+   If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+   the name to be called if we can't opencode the function.  If
+   ATTRS is nonzero, use that for the function's attribute list.  */
+static tree
+builtin_function (const char *name,
+		  tree type,
+		  int function_code,
+		  enum built_in_class decl_class,
+		  const char *library_name,
+		  tree attrs ATTRIBUTE_UNUSED)
+{
+  tree decl = build_decl (input_location,
+                          FUNCTION_DECL, get_identifier (name), type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  if (library_name)
+    SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
+  make_decl_rtl (decl);
+  DECL_BUILT_IN_CLASS (decl) = decl_class;
+  DECL_FUNCTION_CODE (decl) = (built_in_function) function_code;
+  DECL_SOURCE_LOCATION (decl) = input_location;
+  return decl;
+}
+
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD BITS_PER_WORD
+#endif
+
+/*  This variable keeps a table for types for each precision so that we only
+    allocate each of them once. Signed and unsigned types are kept separate.
+ */
+static GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
+
+/*  Return an integer type with the number of bits of precision given by
+    PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
+    it is a signed type.  */
+static tree
+type_for_size (unsigned int precision, int unsignedp)
+{
+  tree t;
+
+  if (precision <= MAX_BITS_PER_WORD
+      && signed_and_unsigned_types[precision][unsignedp] != NULL_TREE)
+    return signed_and_unsigned_types[precision][unsignedp];
+
+  if (unsignedp)
+    t = make_unsigned_type (precision);
+  else
+    t = make_signed_type (precision);
+
+  if (precision <= MAX_BITS_PER_WORD)
+    signed_and_unsigned_types[precision][unsignedp] = t;
+
+  return t;
+}
+
+/*  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+    an unsigned type; otherwise a signed type is returned.  */
+static tree
+type_for_mode (enum machine_mode mode, int unsignedp)
+{
+  if (SCALAR_INT_MODE_P (mode))
+    return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
+
+  if (mode == TYPE_MODE (void_type_node))
+    return void_type_node;
+
+  if (mode == TYPE_MODE (float_type_node))
+    return float_type_node;
+
+  if (mode == TYPE_MODE (double_type_node))
+    return double_type_node;
+
+  if (mode == TYPE_MODE (long_double_type_node))
+    return long_double_type_node;
+
+  return NULL_TREE;
+}
+
+#undef LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME "vhdl"
+#undef LANG_HOOKS_IDENTIFIER_SIZE
+#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
+#undef LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT ortho_init
+#undef LANG_HOOKS_FINISH
+#define LANG_HOOKS_FINISH ortho_finish
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#define LANG_HOOKS_OPTION_LANG_MASK ortho_option_lang_mask
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION ortho_handle_option
+#undef LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS ortho_post_options
+#undef LANG_HOOKS_HONOR_READONLY
+#define LANG_HOOKS_HONOR_READONLY true
+#undef LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE ortho_mark_addressable
+#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
+#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION ortho_expand_function
+
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE type_for_mode
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE type_for_size
+#undef LANG_HOOKS_SIGNED_TYPE
+#define LANG_HOOKS_SIGNED_TYPE signed_type
+#undef LANG_HOOKS_UNSIGNED_TYPE
+#define LANG_HOOKS_UNSIGNED_TYPE unsigned_type
+#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
+#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE signed_or_unsigned_type
+#undef LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE ortho_parse_file
+
+#define pushlevel lhd_do_nothing_i
+#define poplevel lhd_do_nothing_iii_return_null_tree
+#define set_block lhd_do_nothing_t
+#undef LANG_HOOKS_GETDECLS
+#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
+
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+union GTY((desc ("0"),
+	   chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
+  lang_tree_node
+{
+  union tree_node GTY((tag ("0"),
+		       desc ("tree_node_structure (&%h)"))) generic;
+};
+
+/* GHDL does not use the lang_decl and lang_type.
+
+   FIXME: the variable_size annotation here is needed because these types are
+   variable-sized in some other front-ends.  Due to gengtype deficiency, the
+   GTY options of such types have to agree across all front-ends.  */
+
+struct GTY((variable_size)) lang_type { char dummy; };
+struct GTY((variable_size)) lang_decl { char dummy; };
+
+struct GTY(()) language_function
+{
+  char dummy;
+};
+
+
+extern "C" {
+
+struct GTY(()) chain_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+chain_init (struct chain_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+chain_append (struct chain_constr_type *constr, tree el)
+{
+  if (constr->first == NULL_TREE)
+    {
+      gcc_assert (constr->last == NULL_TREE);
+      constr->first = el;
+    }
+  else
+    TREE_CHAIN (constr->last) = el;
+  constr->last = el;
+}
+
+struct GTY(()) list_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+list_init (struct list_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+ortho_list_append (struct list_constr_type *constr, tree el)
+{
+  tree res;
+
+  res = tree_cons (NULL_TREE, el, NULL_TREE);
+  if (constr->first == NULL_TREE)
+    constr->first = res;
+  else
+    TREE_CHAIN (constr->last) = res;
+  constr->last = res;
+}
+
+enum ON_op_kind {
+  /*  Not an operation; invalid.  */
+  ON_Nil,
+
+  /*  Dyadic operations.  */
+  ON_Add_Ov,
+  ON_Sub_Ov,
+  ON_Mul_Ov,
+  ON_Div_Ov,
+  ON_Rem_Ov,
+  ON_Mod_Ov,
+
+  /*  Binary operations.  */
+  ON_And,
+  ON_Or,
+  ON_Xor,
+
+  /*  Monadic operations.  */
+  ON_Not,
+  ON_Neg_Ov,
+  ON_Abs_Ov,
+
+  /*  Comparaisons  */
+  ON_Eq,
+  ON_Neq,
+  ON_Le,
+  ON_Lt,
+  ON_Ge,
+  ON_Gt,
+
+  ON_LAST
+};
+
+static enum tree_code ON_op_to_TREE_CODE[ON_LAST] = {
+  ERROR_MARK,
+
+  PLUS_EXPR,
+  MINUS_EXPR,
+  MULT_EXPR,
+  ERROR_MARK,
+  TRUNC_MOD_EXPR,
+  FLOOR_MOD_EXPR,
+
+  BIT_AND_EXPR,
+  BIT_IOR_EXPR,
+  BIT_XOR_EXPR,
+
+  BIT_NOT_EXPR,
+  NEGATE_EXPR,
+  ABS_EXPR,
+
+  EQ_EXPR,
+  NE_EXPR,
+  LE_EXPR,
+  LT_EXPR,
+  GE_EXPR,
+  GT_EXPR,
+};
+
+tree
+new_dyadic_op (enum ON_op_kind kind, tree left, tree right)
+{
+  tree left_type;
+  enum tree_code code;
+
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
+
+  left_type = TREE_TYPE (left);
+  gcc_assert (left_type == TREE_TYPE (right));
+
+  switch (kind)
+    {
+    case ON_Div_Ov:
+      if (TREE_CODE (left_type) == REAL_TYPE)
+	code = RDIV_EXPR;
+      else
+	code = TRUNC_DIV_EXPR;
+      break;
+    default:
+      code = ON_op_to_TREE_CODE[kind];
+      break;
+    }
+  return build2 (code, left_type, left, right);
+}
+
+tree
+new_monadic_op (enum ON_op_kind kind, tree operand)
+{
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
+
+  return build1 (ON_op_to_TREE_CODE[kind], TREE_TYPE (operand), operand);
+}
+
+tree
+new_compare_op (enum ON_op_kind kind, tree left, tree right, tree ntype)
+{
+  gcc_assert (TREE_CODE (ntype) == BOOLEAN_TYPE);
+  gcc_assert (TREE_TYPE (left) == TREE_TYPE (right));
+
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
+
+  return build2 (ON_op_to_TREE_CODE[kind], ntype, left, right);
+}
+
+tree
+new_convert_ov (tree val, tree rtype)
+{
+  tree val_type;
+  enum tree_code val_code;
+  enum tree_code rtype_code;
+  enum tree_code code;
+
+  val_type = TREE_TYPE (val);
+  if (val_type == rtype)
+    return val;
+
+  /*  FIXME: check conversions.  */
+  val_code = TREE_CODE (val_type);
+  rtype_code = TREE_CODE (rtype);
+  if (val_code == POINTER_TYPE && rtype_code == POINTER_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == INTEGER_TYPE)
+    {
+      /*  REAL to INTEGER
+          Gcc only handles FIX_TRUNC_EXPR, but we need rounding.  */
+      tree m_p5;
+      tree p5;
+      tree zero;
+      tree saved;
+      tree comp;
+      tree adj;
+      tree res;
+
+      m_p5 = build_real (val_type, fp_const_m_p5);
+      p5 = build_real (val_type, fp_const_p5);
+      zero = build_real (val_type, fp_const_zero);
+      saved = save_expr (val);
+      comp = build2 (GE_EXPR, integer_type_node, saved, zero);
+      /*  FIXME: instead of res = res + (comp ? .5 : -.5)
+	  do: res = res (comp ? + : -) .5  */
+      adj = build3 (COND_EXPR, val_type, comp, p5, m_p5);
+      res = build2 (PLUS_EXPR, val_type, saved, adj);
+      res = build1 (FIX_TRUNC_EXPR, rtype, res);
+      return res;
+    }
+  else if (val_code == INTEGER_TYPE && rtype_code == ENUMERAL_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == ENUMERAL_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == REAL_TYPE)
+    code = FLOAT_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == REAL_TYPE)
+    code = NOP_EXPR;
+  else
+    gcc_unreachable ();
+
+  return build1 (code, rtype, val);
+}
+
+tree
+new_alloca (tree rtype, tree size)
+{
+  tree res;
+
+  /* Must save stack except when at function level.  */
+  if (cur_binding_level->prev != NULL
+      && cur_binding_level->prev->prev != NULL)
+    cur_binding_level->save_stack = 1;
+
+  res = build_call_nary (ptr_type_node, stack_alloc_function_ptr,
+                         1, fold_convert (size_type_node, size));
+  return fold_convert (rtype, res);
+}
+
+tree
+new_signed_literal (tree ltype, long long value)
+{
+  tree res;
+  HOST_WIDE_INT lo;
+  HOST_WIDE_INT hi;
+
+  lo = value;
+  hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = build_int_cst_wide (ltype, lo, hi);
+  return res;
+}
+
+tree
+new_unsigned_literal (tree ltype, unsigned long long value)
+{
+  tree res;
+  unsigned HOST_WIDE_INT lo;
+  unsigned HOST_WIDE_INT hi;
+
+  lo = value;
+  hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = build_int_cst_wide (ltype, lo, hi);
+  return res;
+}
+
+tree
+new_null_access (tree ltype)
+{
+  tree res;
+
+  res = build_int_cst_wide (ltype, 0, 0);
+  return res;
+}
+
+tree
+new_float_literal (tree ltype, double value)
+{
+  signed long long s;
+  double frac;
+  int ex;
+  REAL_VALUE_TYPE r_sign;
+  REAL_VALUE_TYPE r_exp;
+  REAL_VALUE_TYPE r;
+  tree res;
+  HOST_WIDE_INT lo;
+  HOST_WIDE_INT hi;
+
+  frac = frexp (value, &ex);
+
+  s = ldexp (frac, 60);
+  lo = s;
+  hi = (s >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = build_int_cst_wide (long_integer_type_node, lo, hi);
+  REAL_VALUE_FROM_INT (r_sign, lo, hi, DFmode);
+  real_2expN (&r_exp, ex - 60, DFmode);
+  real_arithmetic (&r, MULT_EXPR, &r_sign, &r_exp);
+  res = build_real (ltype, r);
+  return res;
+}
+
+struct GTY(()) o_element_list
+{
+  tree res;
+  struct chain_constr_type chain;
+};
+
+void
+new_uncomplete_record_type (tree *res)
+{
+  *res = make_node (RECORD_TYPE);
+}
+
+void
+start_record_type (struct o_element_list *elements)
+{
+  elements->res = make_node (RECORD_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+start_uncomplete_record_type (tree res, struct o_element_list *elements)
+{
+  elements->res = res;
+  chain_init (&elements->chain);
+}
+
+static void
+new_record_union_field (struct o_element_list *list,
+			tree *el,
+			tree ident,
+			tree etype)
+{
+  tree res;
+
+  res = build_decl (input_location,
+                    FIELD_DECL, ident, etype);
+  DECL_CONTEXT (res) = list->res;
+  chain_append (&list->chain, res);
+  *el = res;
+}
+
+void
+new_record_field (struct o_element_list *list,
+		  tree *el,
+		  tree ident,
+		  tree etype)
+{
+  return new_record_union_field (list, el, ident, etype);
+}
+
+void
+finish_record_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+
+  if (TYPE_NAME (elements->res) != NULL_TREE)
+    {
+      /*  The type was completed.  */
+      rest_of_type_compilation (elements->res, 1);
+    }
+}
+
+void
+start_union_type (struct o_element_list *elements)
+{
+  elements->res =  make_node (UNION_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+new_union_field (struct o_element_list *elements,
+		 tree *el,
+		 tree ident,
+		 tree etype)
+{
+  return new_record_union_field (elements, el, ident, etype);
+}
+
+void
+finish_union_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+}
+
+tree
+new_unsigned_type (int size)
+{
+  return make_unsigned_type (size);
+}
+
+tree
+new_signed_type (int size)
+{
+  return make_signed_type (size);
+}
+
+tree
+new_float_type (void)
+{
+  tree res;
+
+  res = make_node (REAL_TYPE);
+  TYPE_PRECISION (res) = DOUBLE_TYPE_SIZE;
+  layout_type (res);
+  return res;
+}
+
+tree
+new_access_type (tree dtype)
+{
+  tree res;
+
+  if (dtype == NULL_TREE)
+    {
+      res = make_node (POINTER_TYPE);
+      TREE_TYPE (res) = NULL_TREE;
+      /* Seems necessary.  */
+      SET_TYPE_MODE (res, Pmode);
+      layout_type (res);
+      return res;
+    }
+  else
+    return build_pointer_type (dtype);
+}
+
+void
+finish_access_type (tree atype, tree dtype)
+{
+  gcc_assert (TREE_CODE (atype) == POINTER_TYPE
+	      && TREE_TYPE (atype) == NULL_TREE);
+
+  TREE_TYPE (atype) = dtype;
+}
+
+tree
+new_array_type (tree el_type, tree index_type)
+{
+  return build_array_type (el_type, index_type);
+}
+
+
+tree
+new_constrained_array_type (tree atype, tree length)
+{
+  tree range_type;
+  tree index_type;
+  tree len;
+  tree one;
+  tree res;
+
+  index_type = TYPE_DOMAIN (atype);
+  if (integer_zerop (length))
+    {
+      /*  Handle null array, by creating a one-length array...  */
+      len = size_zero_node;
+    }
+  else
+    {
+      one = build_int_cstu (index_type, 1);
+      len = build2 (MINUS_EXPR, index_type, length, one);
+      len = fold (len);
+    }
+
+  range_type = build_range_type (index_type, size_zero_node, len);
+  res = build_array_type (TREE_TYPE (atype), range_type);
+
+  /* Constrained arrays are *always* a subtype of its array type.
+     Just copy alias set.  */
+  TYPE_ALIAS_SET (res) = get_alias_set (atype);
+  return res;
+}
+
+void
+new_boolean_type (tree *res,
+		  tree false_id ATTRIBUTE_UNUSED, tree *false_e,
+		  tree true_id ATTRIBUTE_UNUSED, tree *true_e)
+{
+  *res = make_node (BOOLEAN_TYPE);
+  TYPE_PRECISION (*res) = 1;
+  fixup_unsigned_type (*res);
+  *false_e = TYPE_MIN_VALUE (*res);
+  *true_e = TYPE_MAX_VALUE (*res);
+}
+
+struct o_enum_list
+{
+  tree res;
+  struct chain_constr_type chain;
+  int num;
+  int size;
+};
+
+void
+start_enum_type (struct o_enum_list *list, int size)
+{
+  list->res = make_node (ENUMERAL_TYPE);
+  // as of gcc4.8, TYPE_PRECISION of 0 is rigorously enforced!
+  TYPE_PRECISION(list->res) = size;
+  chain_init (&list->chain);
+  list->num = 0;
+  list->size = size;
+}
+
+void
+new_enum_literal (struct o_enum_list *list, tree ident, tree *res)
+{
+  *res = build_int_cstu (list->res, (HOST_WIDE_INT)(list->num));
+  chain_append (&list->chain, tree_cons (ident, *res, NULL_TREE));
+  list->num++;
+}
+
+void
+finish_enum_type (struct o_enum_list *list, tree *res)
+{
+  *res = list->res;
+  TYPE_VALUES (*res) = list->chain.first;
+  TYPE_UNSIGNED (*res) = 1;
+  TYPE_PRECISION (*res) = list->size;
+  set_min_and_max_values_for_integral_type (*res, list->size, 1);
+  layout_type (*res);
+}
+
+struct GTY(()) o_record_aggr_list
+{
+  /* Type of the record.  */
+  tree atype;
+  /* Type of the next field to be added.  */
+  tree field;
+  /* Vector of elements.  */
+  // VEC(constructor_elt,gc) *elts;
+  vec<constructor_elt,va_gc> *elts;
+};
+
+void
+start_record_aggr (struct o_record_aggr_list *list, tree atype)
+{
+  list->atype = atype;
+  list->field = TYPE_FIELDS (atype);
+  //list->elts = VEC_alloc (constructor_elt, gc, fields_length (atype));
+  vec_alloc(list->elts, fields_length (atype));
+}
+
+void
+new_record_aggr_el (struct o_record_aggr_list *list, tree value)
+{
+  CONSTRUCTOR_APPEND_ELT (list->elts, list->field, value);
+  list->field = TREE_CHAIN (list->field);
+}
+
+void
+finish_record_aggr (struct o_record_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->elts);
+}
+
+struct GTY(()) o_array_aggr_list
+{
+  tree atype;
+  /* Vector of elements.  */
+  vec<constructor_elt,va_gc> *elts;
+};
+
+void
+start_array_aggr (struct o_array_aggr_list *list, tree atype)
+{
+  tree nelts;
+  unsigned HOST_WIDE_INT n;
+
+  list->atype = atype;
+  list->elts = NULL;
+
+  nelts = array_type_nelts (atype);
+  gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts));
+
+  n = tree_to_uhwi (nelts) + 1;
+  vec_alloc(list->elts, n);
+}
+
+void
+new_array_aggr_el (struct o_array_aggr_list *list, tree value)
+{
+  CONSTRUCTOR_APPEND_ELT (list->elts, NULL_TREE, value);
+}
+
+void
+finish_array_aggr (struct o_array_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->elts);
+}
+
+
+tree
+new_union_aggr (tree atype, tree field, tree value)
+{
+  tree res;
+
+  res = build_constructor_single (atype, field, value);
+  TREE_CONSTANT (res) = 1;
+  return res;
+}
+
+tree
+new_indexed_element (tree arr, tree index)
+{
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (arr)),
+		 arr, index, NULL_TREE, NULL_TREE);
+}
+
+tree
+new_slice (tree arr, tree res_type, tree index)
+{
+#if 0
+  tree res;
+  tree el_ptr_type;
+  tree el_type;
+  tree res_ptr_type;
+#endif
+
+  /*  *((RES_TYPE *)(&ARR[INDEX]))
+      convert ARR to a pointer, add index, and reconvert to array ?  */
+  gcc_assert (TREE_CODE (res_type) == ARRAY_TYPE);
+
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_RANGE_REF, res_type, arr, index, NULL_TREE, NULL_TREE);
+#if 0
+  el_type = TREE_TYPE (TREE_TYPE (arr));
+  el_ptr_type = build_pointer_type (el_type);
+
+  res = build4 (ARRAY_REF, el_type, arr, index, NULL_TREE, NULL_TREE);
+  res = build1 (ADDR_EXPR, el_ptr_type, res);
+  res_ptr_type = build_pointer_type (res_type);
+  res = build1 (NOP_EXPR, res_ptr_type, res);
+  res = build1 (INDIRECT_REF, res_type, res);
+  return res;
+#endif
+}
+
+tree
+new_selected_element (tree rec, tree el)
+{
+  tree res;
+
+  gcc_assert (TREE_CODE (TREE_TYPE (rec)) == RECORD_TYPE);
+
+  res = build3 (COMPONENT_REF, TREE_TYPE (el), rec, el, NULL_TREE);
+  return res;
+}
+
+tree
+new_access_element (tree acc)
+{
+  tree acc_type;
+
+  acc_type = TREE_TYPE (acc);
+  gcc_assert (TREE_CODE (acc_type) == POINTER_TYPE);
+
+  return build1 (INDIRECT_REF, TREE_TYPE (acc_type), acc);
+}
+
+tree
+new_offsetof (tree rec_type, tree field, tree rtype)
+{
+  tree off;
+  tree bit_off;
+  HOST_WIDE_INT pos;
+  tree res;
+
+  gcc_assert (DECL_CONTEXT (field) == rec_type);
+
+  off = DECL_FIELD_OFFSET (field);
+
+  /*  The offset must be a constant.  */
+  gcc_assert (tree_fits_uhwi_p (off));
+
+  bit_off = DECL_FIELD_BIT_OFFSET (field);
+
+  /*  The offset must be a constant.  */
+  gcc_assert (tree_fits_uhwi_p (bit_off));
+
+  pos = TREE_INT_CST_LOW (off)
+        + (TREE_INT_CST_LOW (bit_off) / BITS_PER_UNIT);
+  res = build_int_cstu (rtype, pos);
+  return res;
+}
+
+tree
+new_sizeof (tree atype, tree rtype)
+{
+ tree size;
+
+ size = TYPE_SIZE_UNIT (atype);
+
+ return fold (build1 (NOP_EXPR, rtype, size));
+}
+
+tree
+new_alignof (tree atype, tree rtype)
+{
+  return build_int_cstu (rtype, TYPE_ALIGN_UNIT (atype));
+}
+
+static tree
+ortho_build_addr (tree lvalue, tree atype)
+{
+  tree res;
+
+  if (TREE_CODE (lvalue) == INDIRECT_REF)
+    {
+      /* ADDR_REF(INDIRECT_REF(x)) -> x.  */
+      res = TREE_OPERAND (lvalue, 0);
+    }
+  else
+    {
+      tree ptr_type;
+
+      /* &base[off] -> base+off.  */
+      ortho_mark_addressable (lvalue);
+
+      if (TREE_TYPE (lvalue) != TREE_TYPE (atype))
+	ptr_type = build_pointer_type (TREE_TYPE (lvalue));
+      else
+	ptr_type = atype;
+      res = fold_build1 (ADDR_EXPR, ptr_type, lvalue);
+    }
+
+  if (TREE_TYPE (res) != atype)
+    res = fold_build1 (NOP_EXPR, atype, res);
+
+  return res;
+}
+
+tree
+new_unchecked_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_global_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_global_unchecked_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+/*  Return a pointer to function FUNC. */
+static tree
+build_function_ptr (tree func)
+{
+  return build1 (ADDR_EXPR,
+		 build_pointer_type (TREE_TYPE (func)), func);
+}
+
+tree
+new_subprogram_address (tree subprg, tree atype)
+{
+  return fold (build1 (NOP_EXPR, atype, build_function_ptr (subprg)));
+}
+
+tree
+new_value (tree lvalue)
+{
+  return lvalue;
+}
+
+void
+new_debug_line_decl (int line)
+{
+  input_location = linemap_line_start (line_table, line, 252);
+}
+
+void
+new_type_decl (tree ident, tree atype)
+{
+  tree decl;
+
+  TYPE_NAME (atype) = ident;
+  decl = build_decl (input_location, TYPE_DECL, ident, atype);
+  TYPE_STUB_DECL (atype) = decl;
+  push_decl (decl);
+  /*
+      if Get_TYPE_SIZE (Ttype) /= NULL_TREE then
+         --  Do not generate debug info for uncompleted types.
+         Rest_Of_Type_Compilation (Ttype, C_True);
+      end if;
+  */
+}
+
+enum o_storage { o_storage_external,
+		 o_storage_public,
+		 o_storage_private,
+		 o_storage_local };
+
+static void
+set_storage (tree Node, enum o_storage storage)
+{
+  switch (storage)
+    {
+    case o_storage_external:
+      DECL_EXTERNAL (Node) = 1;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 0;
+      break;
+    case o_storage_public:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_private:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_local:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 0;
+      break;
+    }
+}
+
+void
+new_const_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree cst;
+
+  cst = build_decl (input_location, VAR_DECL, ident, atype);
+  set_storage (cst, storage);
+  TREE_READONLY (cst) = 1;
+  push_decl (cst);
+  switch (storage)
+    {
+    case o_storage_local:
+      gcc_unreachable ();
+    case o_storage_external:
+      /*  We are at top level if Current_Function_Decl is null.  */
+      rest_of_decl_compilation
+	(cst, current_function_decl == NULL_TREE, 0);
+      break;
+    case o_storage_public:
+    case o_storage_private:
+      break;
+    }
+  *res = cst;
+}
+
+void
+start_const_value (tree *cst ATTRIBUTE_UNUSED)
+{
+}
+
+void
+finish_const_value (tree *cst, tree val)
+{
+  DECL_INITIAL (*cst) = val;
+  TREE_CONSTANT (val) = 1;
+  TREE_STATIC (*cst) = 1;
+  rest_of_decl_compilation
+        (*cst, current_function_decl == NULL_TREE, 0);
+}
+
+void
+new_var_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree var;
+
+  var = build_decl (input_location, VAR_DECL, ident, atype);
+  if (current_function_decl != NULL_TREE)
+    {
+      /*  Local variable. */
+      TREE_STATIC (var) = 0;
+      DECL_EXTERNAL (var) = 0;
+      TREE_PUBLIC (var) = 0;
+    }
+  else
+    set_storage (var, storage);
+
+  push_decl (var);
+
+  if (current_function_decl == NULL_TREE)
+    rest_of_decl_compilation (var, 1, 0);
+
+  *res = var;
+}
+
+struct GTY(()) o_inter_list
+{
+  tree ident;
+  enum o_storage storage;
+
+  /*  Return type.  */
+  tree rtype;
+
+  /*  List of parameter types.  */
+  struct list_constr_type param_list;
+
+  /*  Chain of parameters declarations.  */
+  struct chain_constr_type param_chain;
+};
+
+void
+start_function_decl (struct o_inter_list *interfaces,
+		     tree ident,
+		     enum o_storage storage,
+		     tree rtype)
+{
+  interfaces->ident = ident;
+  interfaces->storage = storage;
+  interfaces->rtype = rtype;
+  chain_init (&interfaces->param_chain);
+  list_init (&interfaces->param_list);
+}
+
+void
+start_procedure_decl (struct o_inter_list *interfaces,
+		      tree ident,
+		      enum o_storage storage)
+{
+  start_function_decl (interfaces, ident, storage, void_type_node);
+}
+
+void
+new_interface_decl (struct o_inter_list *interfaces,
+		    tree *res,
+		    tree ident,
+		    tree atype)
+{
+  tree r;
+
+  r = build_decl (input_location, PARM_DECL, ident, atype);
+  /* DECL_CONTEXT (Res, Xxx); */
+
+  /*  Do type conversion: convert boolean and enums to int  */
+  switch (TREE_CODE (atype))
+    {
+    case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
+      DECL_ARG_TYPE (r) = integer_type_node;
+    default:
+      DECL_ARG_TYPE (r) = atype;
+    }
+
+  layout_decl (r, 0);
+
+  chain_append (&interfaces->param_chain, r);
+  ortho_list_append (&interfaces->param_list, atype);
+  *res = r;
+}
+
+void
+finish_subprogram_decl (struct o_inter_list *interfaces, tree *res)
+{
+  tree decl;
+  tree result;
+  tree parm;
+  int is_global;
+
+  /* Append a void type in the parameter types chain, so that the function
+     is known not be have variables arguments.  */
+  ortho_list_append (&interfaces->param_list, void_type_node);
+
+  decl = build_decl (input_location, FUNCTION_DECL, interfaces->ident,
+		     build_function_type (interfaces->rtype,
+					  interfaces->param_list.first));
+  DECL_SOURCE_LOCATION (decl) = input_location;
+
+  is_global = current_function_decl == NULL_TREE
+    || interfaces->storage == o_storage_external;
+  if (is_global)
+    set_storage (decl, interfaces->storage);
+  else
+    {
+      /*  A nested subprogram.  */
+      DECL_EXTERNAL (decl) = 0;
+      TREE_PUBLIC (decl) = 0;
+    }
+  /*  The function exist in static storage. */
+  TREE_STATIC (decl) = 1;
+  DECL_INITIAL (decl) = error_mark_node;
+  TREE_ADDRESSABLE (decl) = 1;
+
+  /*  Declare the result.
+      FIXME: should be moved in start_function_body. */
+  result = build_decl (input_location,
+                       RESULT_DECL, NULL_TREE, interfaces->rtype);
+  DECL_RESULT (decl) = result;
+  DECL_CONTEXT (result) = decl;
+
+  DECL_ARGUMENTS (decl) = interfaces->param_chain.first;
+  /* Set DECL_CONTEXT of parameters.  */
+  for (parm = interfaces->param_chain.first;
+       parm != NULL_TREE;
+       parm = TREE_CHAIN (parm))
+    DECL_CONTEXT (parm) = decl;
+
+  push_decl (decl);
+
+  /* External functions are never nested.
+     Remove their context, which is set by push_decl.  */
+  if (interfaces->storage == o_storage_external)
+    DECL_CONTEXT (decl) = NULL_TREE;
+
+  if (is_global)
+    rest_of_decl_compilation (decl, 1, 0);
+
+  *res = decl;
+}
+
+void
+start_subprogram_body (tree func)
+{
+  gcc_assert (current_function_decl == DECL_CONTEXT (func));
+  current_function_decl = func;
+
+  /* The function is not anymore external.  */
+  DECL_EXTERNAL (func) = 0;
+
+  push_stmts (alloc_stmt_list ());
+  push_binding ();
+}
+
+void
+finish_subprogram_body (void)
+{
+  tree bind;
+  tree func;
+  tree parent;
+
+  bind = pop_binding ();
+  pop_stmts ();
+
+  func = current_function_decl;
+  DECL_INITIAL (func) = BIND_EXPR_BLOCK (bind);
+  DECL_SAVED_TREE (func) = bind;
+
+  /* Initialize the RTL code for the function.  */
+  allocate_struct_function (func, false);
+
+  /* Store the end of the function.  */
+  cfun->function_end_locus = input_location;
+
+  parent = DECL_CONTEXT (func);
+
+  if (parent != NULL)
+    cgraph_get_create_node (func);
+  else
+    cgraph_finalize_function (func, false);
+
+  current_function_decl = parent;
+  set_cfun (NULL);
+}
+
+
+void
+new_debug_line_stmt (int line)
+{
+  input_location = linemap_line_start (line_table, line, 252);
+}
+
+void
+start_declare_stmt (void)
+{
+  push_stmts (alloc_stmt_list ());
+  push_binding ();
+}
+
+void
+finish_declare_stmt (void)
+{
+  tree bind;
+
+  bind = pop_binding ();
+  pop_stmts ();
+  append_stmt (bind);
+}
+
+
+struct GTY(()) o_assoc_list
+{
+  tree subprg;
+  vec<tree, va_gc> *vecptr;
+};
+
+void
+start_association (struct o_assoc_list *assocs, tree subprg)
+{
+  assocs->subprg = subprg;
+  assocs->vecptr = NULL;
+}
+
+void
+new_association (struct o_assoc_list *assocs, tree val)
+{
+  vec_safe_push(assocs->vecptr, val);
+}
+
+tree
+new_function_call (struct o_assoc_list *assocs)
+{
+  return build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+                         build_function_ptr (assocs->subprg),
+                         assocs->vecptr);
+}
+
+void
+new_procedure_call (struct o_assoc_list *assocs)
+{
+  tree res;
+
+  res = build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+                        build_function_ptr (assocs->subprg),
+                        assocs->vecptr);
+  TREE_SIDE_EFFECTS (res) = 1;
+  append_stmt (res);
+}
+
+void
+new_assign_stmt (tree target, tree value)
+{
+  tree n;
+
+  n = build2 (MODIFY_EXPR, TREE_TYPE (target), target, value);
+  TREE_SIDE_EFFECTS (n) = 1;
+  append_stmt (n);
+}
+
+void
+new_func_return_stmt (tree value)
+{
+  tree assign;
+  tree stmt;
+  tree res;
+
+  res = DECL_RESULT (current_function_decl);
+  assign = build2 (MODIFY_EXPR, TREE_TYPE (value), res, value);
+  TREE_SIDE_EFFECTS (assign) = 1;
+  stmt = build1 (RETURN_EXPR, void_type_node, assign);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+void
+new_proc_return_stmt (void)
+{
+  tree stmt;
+
+  stmt = build1 (RETURN_EXPR, void_type_node, NULL_TREE);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+
+struct GTY(()) o_if_block
+{
+  tree stmt;
+};
+
+void
+start_if_stmt (struct o_if_block *block, tree cond)
+{
+  tree stmt;
+  tree stmts;
+
+  stmts = alloc_stmt_list ();
+  stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
+  block->stmt = stmt;
+  append_stmt (stmt);
+  push_stmts (stmts);
+}
+
+void
+new_else_stmt (struct o_if_block *block)
+{
+  tree stmts;
+
+  pop_stmts ();
+  stmts = alloc_stmt_list ();
+  COND_EXPR_ELSE (block->stmt) = stmts;
+  push_stmts (stmts);
+}
+
+void
+finish_if_stmt (struct o_if_block *block ATTRIBUTE_UNUSED)
+{
+  pop_stmts ();
+}
+
+
+struct GTY(()) o_snode
+{
+  tree beg_label;
+  tree end_label;
+};
+
+/* Create an artificial label.  */
+static tree
+build_label (void)
+{
+  tree res;
+
+  res = build_decl (input_location, LABEL_DECL, NULL_TREE, void_type_node);
+  DECL_CONTEXT (res) = current_function_decl;
+  DECL_ARTIFICIAL (res) = 1;
+  return res;
+}
+
+void
+start_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  label->beg_label = build_label ();
+
+  stmt = build1 (LABEL_EXPR, void_type_node, label->beg_label);
+  append_stmt (stmt);
+
+  label->end_label = build_label ();
+}
+
+void
+finish_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, label->beg_label);
+  TREE_USED (label->beg_label) = 1;
+  append_stmt (stmt);
+  /*  Emit the end label only if there is a goto to it.
+      (Return may be used to exit from the loop).  */
+  if (TREE_USED (label->end_label))
+    {
+      stmt = build1 (LABEL_EXPR, void_type_node, label->end_label);
+      append_stmt (stmt);
+    }
+}
+
+void
+new_exit_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->end_label);
+  append_stmt (stmt);
+  TREE_USED (l->end_label) = 1;
+}
+
+void
+new_next_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->beg_label);
+  TREE_USED (l->beg_label) = 1;
+  append_stmt (stmt);
+}
+
+struct GTY(()) o_case_block
+{
+  tree case_type;
+  tree end_label;
+  int add_break;
+};
+
+void
+start_case_stmt (struct o_case_block *block, tree value)
+{
+  tree stmt;
+  tree stmts;
+
+  block->case_type = TREE_TYPE (value);
+  block->end_label = build_label ();
+  block->add_break = 0;
+  stmts = alloc_stmt_list ();
+  stmt = build3 (SWITCH_EXPR, block->case_type, value, stmts, NULL_TREE);
+  append_stmt (stmt);
+  push_stmts (stmts);
+}
+
+void
+start_choice (struct o_case_block *block)
+{
+  tree stmt;
+  if (block->add_break)
+    {
+      stmt = build1 (GOTO_EXPR, block->case_type, block->end_label);
+      append_stmt (stmt);
+
+      block->add_break = 0;
+    }
+}
+
+void
+new_expr_choice (struct o_case_block *block ATTRIBUTE_UNUSED, tree expr)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (expr, NULL_TREE, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+new_range_choice (struct o_case_block *block ATTRIBUTE_UNUSED,
+		  tree low, tree high)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (low, high, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+new_default_choice (struct o_case_block *block ATTRIBUTE_UNUSED)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (NULL_TREE, NULL_TREE, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+finish_choice (struct o_case_block *block)
+{
+  block->add_break = 1;
+}
+
+void
+finish_case_stmt (struct o_case_block *block)
+{
+  tree stmt;
+
+  pop_stmts ();
+  stmt = build1 (LABEL_EXPR, void_type_node, block->end_label);
+  append_stmt (stmt);
+}
+
+bool
+compare_identifier_string (tree id, const char *str, size_t len)
+{
+  if (IDENTIFIER_LENGTH (id) != len)
+    return false;
+  if (!memcmp (IDENTIFIER_POINTER (id), str, len))
+    return true;
+  else
+    return false;
+}
+
+void
+get_identifier_string (tree id, const char **str, int *len)
+{
+  *len = IDENTIFIER_LENGTH (id);
+  *str = IDENTIFIER_POINTER (id);
+}
+
+// C linkage wrappers for two (now C++) functions so that
+// Ada code can call them without name mangling
+tree get_identifier_with_length_c (const char *c, size_t s)
+{
+  return get_identifier_with_length(c, s);
+}
+
+int toplev_main_c (int argc, char **argv)
+{
+  return toplev_main(argc, argv);
+}
+
+void
+debug_tree_c (tree expr)
+{
+  warning (OPT_Wall, "Debug tree");
+  debug_tree (expr);
+}
+
+} // end extern "C"
+
+#include "debug.h"
+#include "gt-vhdl-ortho-lang.h"
+#include "gtype-vhdl.h"
diff --git a/src/ortho/gcc/ortho_gcc-main.adb b/src/ortho/gcc/ortho_gcc-main.adb
new file mode 100644
index 000000000..70c8a7f79
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc-main.adb
@@ -0,0 +1,42 @@
+--  GCC back-end for ortho
+--  Copyright (C) 2002-1014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with System;
+with Ortho_Gcc_Front;
+with Ada.Command_Line; use Ada.Command_Line;
+
+procedure Ortho_Gcc.Main
+is
+   gnat_argc : Integer;
+   gnat_argv : System.Address;
+
+   pragma Import (C, gnat_argc);
+   pragma Import (C, gnat_argv);
+
+   function Toplev_Main (Argc : Integer; Argv : System.Address)
+                        return Integer;
+   pragma Import (C, Toplev_Main, "toplev_main_c");
+
+   Status : Exit_Status;
+begin
+   Ortho_Gcc_Front.Init;
+
+   --  Note: GCC set signal handlers...
+   Status := Exit_Status (Toplev_Main (gnat_argc, gnat_argv));
+   Set_Exit_Status (Status);
+end Ortho_Gcc.Main;
diff --git a/src/ortho/gcc/ortho_gcc-main.ads b/src/ortho/gcc/ortho_gcc-main.ads
new file mode 100644
index 000000000..4bd73a1b6
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc-main.ads
@@ -0,0 +1 @@
+procedure Ortho_Gcc.Main;
diff --git a/src/ortho/gcc/ortho_gcc.adb b/src/ortho/gcc/ortho_gcc.adb
new file mode 100644
index 000000000..ae7b4f53b
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.adb
@@ -0,0 +1,121 @@
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Deallocation;
+with Ortho_Gcc_Front; use Ortho_Gcc_Front;
+
+package body Ortho_Gcc is
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode (Lit);
+   end New_Lit;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      return O_Lnode (Obj);
+   end New_Obj;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return O_Enode (Obj);
+   end New_Obj_Value;
+
+   procedure New_Debug_Filename_Decl (Filename : String) is
+   begin
+      null;
+   end New_Debug_Filename_Decl;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   --  Representation of a C String: this is an access to a bounded string.
+   --  Therefore, with GNAT, such an access is a thin pointer.
+   subtype Fat_C_String is String (Positive);
+   type C_String is access all Fat_C_String;
+   pragma Convention (C, C_String);
+
+   C_String_Null : constant C_String := null;
+
+   --  Return the length of a C String (ie, the number of characters before
+   --  the Nul).
+   function C_String_Len (Str : C_String) return Natural;
+   pragma Import (C, C_String_Len, "strlen");
+
+   function Lang_Handle_Option (Opt : C_String; Arg : C_String)
+                               return Integer;
+   pragma Export (C, Lang_Handle_Option);
+
+   function Lang_Parse_File (Filename : C_String) return Integer;
+   pragma Export (C, Lang_Parse_File);
+
+   function Lang_Handle_Option (Opt : C_String; Arg : C_String)
+     return Integer
+   is
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Name => String_Acc, Object => String);
+
+      Res : Natural;
+      Ada_Opt : String_Acc;
+      Ada_Arg : String_Acc;
+      Len : Natural;
+   begin
+      Len := C_String_Len (Opt);
+      Ada_Opt := new String'(Opt (1 .. Len));
+      if Arg /= C_String_Null then
+         Len := C_String_Len (Arg);
+         Ada_Arg := new String'(Arg (1 .. Len));
+      else
+         Ada_Arg := null;
+      end if;
+      Res := Ortho_Gcc_Front.Decode_Option (Ada_Opt, Ada_Arg);
+      Unchecked_Deallocation (Ada_Opt);
+      Unchecked_Deallocation (Ada_Arg);
+      return Res;
+   end Lang_Handle_Option;
+
+   function Lang_Parse_File (Filename : C_String) return Integer
+   is
+      Len : Natural;
+      File : String_Acc;
+   begin
+      if Filename = C_String_Null then
+         File := null;
+      else
+         Len := C_String_Len (Filename);
+         File := new String'(Filename.all (1 .. Len));
+      end if;
+
+      if Ortho_Gcc_Front.Parse (File) then
+         return 1;
+      else
+         return 0;
+      end if;
+   end Lang_Parse_File;
+
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc.ads b/src/ortho/gcc/ortho_gcc.ads
new file mode 100644
index 000000000..0afdc0887
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.ads
@@ -0,0 +1,701 @@
+--  DO NOT MODIFY - this file was generated from:
+--  ortho_nodes.common.ads and ortho_gcc.private.ads
+--
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package Ortho_Gcc is
+
+--  Start of common part
+
+   type O_Enode is private;
+   type O_Cnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+   type O_Dnode is private;
+   type O_Fnode is private;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+   --  True if the code generated supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+--  End of common part
+private
+   --  GCC supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   pragma Convention (C, O_Storage);
+   --   pragma Convention (C, ON_Op_Kind);
+
+   subtype Tree is System.Address;
+   NULL_TREE : constant Tree := System.Null_Address;
+
+   subtype Vec_Ptr is System.Address;
+
+   type O_Cnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Snode is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Snode);
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Obj);
+   pragma Inline (New_Obj_Value);
+
+   --  Efficiently append element EL to a chain.
+   --  FIRST is the first element of the chain (must NULL_TREE if the chain
+   --   is empty),
+   --  LAST is the last element of the chain (idem).
+   type Chain_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, Chain_Constr_Type);
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   pragma Import (C, Chain_Init);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+   pragma Import (C, Chain_Append);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, List_Constr_Type);
+   procedure List_Init (Constr : out List_Constr_Type);
+   pragma Import (C, List_Init);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+   pragma Import (C, List_Append, "ortho_list_append");
+
+   type O_Loop_Block is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Loop_Block);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      --  Return type.
+      Rtype : O_Tnode;
+      --  List of parameter types.
+      Param_List : List_Constr_Type;
+      --  Chain of parameters declarations.
+      Param_Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Inter_List);
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Element_List);
+
+   type O_Case_Block is record
+      Case_Type : Tree;
+      End_Label : Tree;
+      Add_Break : Integer;
+   end record;
+   pragma Convention (C, O_Case_Block);
+
+   type O_If_Block is record
+      Stmt : Tree;
+   end record;
+   pragma Convention (C, O_If_Block);
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Atype : Tree;
+      Afield : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Record_Aggr_List);
+
+   type O_Array_Aggr_List is record
+      Atype : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Array_Aggr_List);
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+   pragma Convention (C, O_Assoc_List);
+
+   type O_Enum_List is record
+      --  The enumeral_type node.
+      Res : Tree;
+      --  Chain of literals.
+      Chain : Chain_Constr_Type;
+      --  Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+      Num : Natural;
+      --  Size of the enumeration type.
+      Size : Natural;
+   end record;
+   pragma Convention (C, O_Enum_List);
+
+   pragma Import (C, New_Dyadic_Op);
+   pragma Import (C, New_Monadic_Op);
+   pragma Import (C, New_Compare_Op);
+
+   pragma Import (C, New_Convert_Ov);
+   pragma Import (C, New_Alloca);
+
+   pragma Import (C, New_Signed_Literal);
+   pragma Import (C, New_Unsigned_Literal);
+   pragma Import (C, New_Float_Literal);
+   pragma Import (C, New_Null_Access);
+
+   pragma Import (C, Start_Record_Type);
+   pragma Import (C, New_Record_Field);
+   pragma Import (C, Finish_Record_Type);
+   pragma Import (C, New_Uncomplete_Record_Type);
+   pragma Import (C, Start_Uncomplete_Record_Type);
+
+   pragma Import (C, Start_Union_Type);
+   pragma Import (C, New_Union_Field);
+   pragma Import (C, Finish_Union_Type);
+
+   pragma Import (C, New_Unsigned_Type);
+   pragma Import (C, New_Signed_Type);
+   pragma Import (C, New_Float_Type);
+
+   pragma Import (C, New_Access_Type);
+   pragma Import (C, Finish_Access_Type);
+
+   pragma Import (C, New_Array_Type);
+   pragma Import (C, New_Constrained_Array_Type);
+
+   pragma Import (C, New_Boolean_Type);
+   pragma Import (C, Start_Enum_Type);
+   pragma Import (C, New_Enum_Literal);
+   pragma Import (C, Finish_Enum_Type);
+
+   pragma Import (C, Start_Record_Aggr);
+   pragma Import (C, New_Record_Aggr_El);
+   pragma Import (C, Finish_Record_Aggr);
+   pragma Import (C, Start_Array_Aggr);
+   pragma Import (C, New_Array_Aggr_El);
+   pragma Import (C, Finish_Array_Aggr);
+   pragma Import (C, New_Union_Aggr);
+
+   pragma Import (C, New_Indexed_Element);
+   pragma Import (C, New_Slice);
+   pragma Import (C, New_Selected_Element);
+   pragma Import (C, New_Access_Element);
+
+   pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Alignof);
+   pragma Import (C, New_Offsetof);
+
+   pragma Import (C, New_Address);
+   pragma Import (C, New_Global_Address);
+   pragma Import (C, New_Unchecked_Address);
+   pragma Import (C, New_Global_Unchecked_Address);
+   pragma Import (C, New_Subprogram_Address);
+
+   pragma Import (C, New_Value);
+
+   pragma Import (C, New_Type_Decl);
+   pragma Import (C, New_Debug_Line_Decl);
+   pragma Import (C, New_Const_Decl);
+   pragma Import (C, New_Var_Decl);
+
+   pragma Import (C, Start_Const_Value);
+   pragma Import (C, Finish_Const_Value);
+
+   pragma Import (C, Start_Function_Decl);
+   pragma Import (C, Start_Procedure_Decl);
+   pragma Import (C, New_Interface_Decl);
+   pragma Import (C, Finish_Subprogram_Decl);
+
+   pragma Import (C, Start_Subprogram_Body);
+   pragma Import (C, Finish_Subprogram_Body);
+
+   pragma Import (C, New_Debug_Line_Stmt);
+   pragma Import (C, Start_Declare_Stmt);
+   pragma Import (C, Finish_Declare_Stmt);
+   pragma Import (C, Start_Association);
+   pragma Import (C, New_Association);
+   pragma Import (C, New_Function_Call);
+   pragma Import (C, New_Procedure_Call);
+
+   pragma Import (C, New_Assign_Stmt);
+
+   pragma Import (C, Start_If_Stmt);
+   pragma Import (C, New_Else_Stmt);
+   pragma Import (C, Finish_If_Stmt);
+
+   pragma Import (C, New_Return_Stmt);
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_func_return_stmt", (O_Enode));
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_proc_return_stmt", null);
+
+   pragma Import (C, Start_Loop_Stmt);
+   pragma Import (C, Finish_Loop_Stmt);
+   pragma Import (C, New_Exit_Stmt);
+   pragma Import (C, New_Next_Stmt);
+
+   pragma Import (C, Start_Case_Stmt);
+   pragma Import (C, Start_Choice);
+   pragma Import (C, New_Expr_Choice);
+   pragma Import (C, New_Range_Choice);
+   pragma Import (C, New_Default_Choice);
+   pragma Import (C, Finish_Choice);
+   pragma Import (C, Finish_Case_Stmt);
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc.private.ads b/src/ortho/gcc/ortho_gcc.private.ads
new file mode 100644
index 000000000..cc2f556f0
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.private.ads
@@ -0,0 +1,269 @@
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package Ortho_Gcc is
+
+private
+   --  GCC supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   pragma Convention (C, O_Storage);
+   --   pragma Convention (C, ON_Op_Kind);
+
+   subtype Tree is System.Address;
+   NULL_TREE : constant Tree := System.Null_Address;
+
+   subtype Vec_Ptr is System.Address;
+
+   type O_Cnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Snode is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Snode);
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Obj);
+   pragma Inline (New_Obj_Value);
+
+   --  Efficiently append element EL to a chain.
+   --  FIRST is the first element of the chain (must NULL_TREE if the chain
+   --   is empty),
+   --  LAST is the last element of the chain (idem).
+   type Chain_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, Chain_Constr_Type);
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   pragma Import (C, Chain_Init);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+   pragma Import (C, Chain_Append);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, List_Constr_Type);
+   procedure List_Init (Constr : out List_Constr_Type);
+   pragma Import (C, List_Init);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+   pragma Import (C, List_Append, "ortho_list_append");
+
+   type O_Loop_Block is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Loop_Block);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      --  Return type.
+      Rtype : O_Tnode;
+      --  List of parameter types.
+      Param_List : List_Constr_Type;
+      --  Chain of parameters declarations.
+      Param_Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Inter_List);
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Element_List);
+
+   type O_Case_Block is record
+      Case_Type : Tree;
+      End_Label : Tree;
+      Add_Break : Integer;
+   end record;
+   pragma Convention (C, O_Case_Block);
+
+   type O_If_Block is record
+      Stmt : Tree;
+   end record;
+   pragma Convention (C, O_If_Block);
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Atype : Tree;
+      Afield : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Record_Aggr_List);
+
+   type O_Array_Aggr_List is record
+      Atype : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Array_Aggr_List);
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+   pragma Convention (C, O_Assoc_List);
+
+   type O_Enum_List is record
+      --  The enumeral_type node.
+      Res : Tree;
+      --  Chain of literals.
+      Chain : Chain_Constr_Type;
+      --  Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+      Num : Natural;
+      --  Size of the enumeration type.
+      Size : Natural;
+   end record;
+   pragma Convention (C, O_Enum_List);
+
+   pragma Import (C, New_Dyadic_Op);
+   pragma Import (C, New_Monadic_Op);
+   pragma Import (C, New_Compare_Op);
+
+   pragma Import (C, New_Convert_Ov);
+   pragma Import (C, New_Alloca);
+
+   pragma Import (C, New_Signed_Literal);
+   pragma Import (C, New_Unsigned_Literal);
+   pragma Import (C, New_Float_Literal);
+   pragma Import (C, New_Null_Access);
+
+   pragma Import (C, Start_Record_Type);
+   pragma Import (C, New_Record_Field);
+   pragma Import (C, Finish_Record_Type);
+   pragma Import (C, New_Uncomplete_Record_Type);
+   pragma Import (C, Start_Uncomplete_Record_Type);
+
+   pragma Import (C, Start_Union_Type);
+   pragma Import (C, New_Union_Field);
+   pragma Import (C, Finish_Union_Type);
+
+   pragma Import (C, New_Unsigned_Type);
+   pragma Import (C, New_Signed_Type);
+   pragma Import (C, New_Float_Type);
+
+   pragma Import (C, New_Access_Type);
+   pragma Import (C, Finish_Access_Type);
+
+   pragma Import (C, New_Array_Type);
+   pragma Import (C, New_Constrained_Array_Type);
+
+   pragma Import (C, New_Boolean_Type);
+   pragma Import (C, Start_Enum_Type);
+   pragma Import (C, New_Enum_Literal);
+   pragma Import (C, Finish_Enum_Type);
+
+   pragma Import (C, Start_Record_Aggr);
+   pragma Import (C, New_Record_Aggr_El);
+   pragma Import (C, Finish_Record_Aggr);
+   pragma Import (C, Start_Array_Aggr);
+   pragma Import (C, New_Array_Aggr_El);
+   pragma Import (C, Finish_Array_Aggr);
+   pragma Import (C, New_Union_Aggr);
+
+   pragma Import (C, New_Indexed_Element);
+   pragma Import (C, New_Slice);
+   pragma Import (C, New_Selected_Element);
+   pragma Import (C, New_Access_Element);
+
+   pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Alignof);
+   pragma Import (C, New_Offsetof);
+
+   pragma Import (C, New_Address);
+   pragma Import (C, New_Global_Address);
+   pragma Import (C, New_Unchecked_Address);
+   pragma Import (C, New_Global_Unchecked_Address);
+   pragma Import (C, New_Subprogram_Address);
+
+   pragma Import (C, New_Value);
+
+   pragma Import (C, New_Type_Decl);
+   pragma Import (C, New_Debug_Line_Decl);
+   pragma Import (C, New_Const_Decl);
+   pragma Import (C, New_Var_Decl);
+
+   pragma Import (C, Start_Const_Value);
+   pragma Import (C, Finish_Const_Value);
+
+   pragma Import (C, Start_Function_Decl);
+   pragma Import (C, Start_Procedure_Decl);
+   pragma Import (C, New_Interface_Decl);
+   pragma Import (C, Finish_Subprogram_Decl);
+
+   pragma Import (C, Start_Subprogram_Body);
+   pragma Import (C, Finish_Subprogram_Body);
+
+   pragma Import (C, New_Debug_Line_Stmt);
+   pragma Import (C, Start_Declare_Stmt);
+   pragma Import (C, Finish_Declare_Stmt);
+   pragma Import (C, Start_Association);
+   pragma Import (C, New_Association);
+   pragma Import (C, New_Function_Call);
+   pragma Import (C, New_Procedure_Call);
+
+   pragma Import (C, New_Assign_Stmt);
+
+   pragma Import (C, Start_If_Stmt);
+   pragma Import (C, New_Else_Stmt);
+   pragma Import (C, Finish_If_Stmt);
+
+   pragma Import (C, New_Return_Stmt);
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_func_return_stmt", (O_Enode));
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_proc_return_stmt", null);
+
+   pragma Import (C, Start_Loop_Stmt);
+   pragma Import (C, Finish_Loop_Stmt);
+   pragma Import (C, New_Exit_Stmt);
+   pragma Import (C, New_Next_Stmt);
+
+   pragma Import (C, Start_Case_Stmt);
+   pragma Import (C, Start_Choice);
+   pragma Import (C, New_Expr_Choice);
+   pragma Import (C, New_Range_Choice);
+   pragma Import (C, New_Default_Choice);
+   pragma Import (C, Finish_Choice);
+   pragma Import (C, Finish_Case_Stmt);
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc_front.ads b/src/ortho/gcc/ortho_gcc_front.ads
new file mode 100644
index 000000000..553057b20
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc_front.ads
@@ -0,0 +1,2 @@
+with Ortho_Front;
+package Ortho_Gcc_Front renames Ortho_Front;
diff --git a/src/ortho/gcc/ortho_ident.adb b/src/ortho/gcc/ortho_ident.adb
new file mode 100644
index 000000000..770fece2b
--- /dev/null
+++ b/src/ortho/gcc/ortho_ident.adb
@@ -0,0 +1,56 @@
+--  GCC back-end for ortho (identifiers)
+--  Copyright (C) 2002-1014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Ortho_Ident is
+   function Get_Identifier_With_Length (Str : Address; Size : Integer)
+                                       return O_Ident;
+   pragma Import (C, Get_Identifier_With_Length,
+                  "get_identifier_with_length_c");
+
+   function Compare_Identifier_String
+     (Id : O_Ident; Str : Address; Size : Integer)
+     return Boolean;
+   pragma Import (C, Compare_Identifier_String);
+   pragma Warnings (Off, Compare_Identifier_String);
+
+   function Get_Identifier (Str : String) return O_Ident is
+   begin
+      return Get_Identifier_With_Length (Str'Address, Str'Length);
+   end Get_Identifier;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean is
+   begin
+      return Compare_Identifier_String (Id, Str'Address, Str'Length);
+   end Is_Equal;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      procedure Get_Identifier_String
+        (Id : O_Ident; Str_Ptr : Address; Len_Ptr : Address);
+      pragma Import (C, Get_Identifier_String);
+
+      Len : Natural;
+      type Str_Acc is access String (Positive);
+      Str : Str_Acc;
+   begin
+      Get_Identifier_String (Id, Str'Address, Len'Address);
+      return Str (1 .. Len);
+   end Get_String;
+
+end Ortho_Ident;
+
diff --git a/src/ortho/gcc/ortho_ident.ads b/src/ortho/gcc/ortho_ident.ads
new file mode 100644
index 000000000..76c09ceb9
--- /dev/null
+++ b/src/ortho/gcc/ortho_ident.ads
@@ -0,0 +1,30 @@
+--  GCC back-end for ortho (identifiers)
+--  Copyright (C) 2002-1014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with System; use System;
+
+package Ortho_Ident is
+   subtype O_Ident is Address;
+   function Get_Identifier (Str : String) return O_Ident;
+   function Get_String (Id : O_Ident) return String;
+   function Is_Equal (L, R : O_Ident) return Boolean renames System."=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   O_Ident_Nul : constant O_Ident;
+private
+   O_Ident_Nul : constant O_Ident := Null_Address;
+end Ortho_Ident;
diff --git a/src/ortho/gcc/ortho_nodes.ads b/src/ortho/gcc/ortho_nodes.ads
new file mode 100644
index 000000000..7c6c4a076
--- /dev/null
+++ b/src/ortho/gcc/ortho_nodes.ads
@@ -0,0 +1,3 @@
+with Ortho_Gcc;
+
+package Ortho_Nodes renames Ortho_Gcc;
diff --git a/src/ortho/llvm/Makefile b/src/ortho/llvm/Makefile
new file mode 100644
index 000000000..135dbdf4b
--- /dev/null
+++ b/src/ortho/llvm/Makefile
@@ -0,0 +1,30 @@
+ortho_srcdir=..
+GNAT_FLAGS=-gnaty3befhkmr -gnata -gnatf -gnatwael -gnat05
+CXX=clang++ --std=c++11
+LLVM_CONFIG=llvm-config
+SED=sed
+BE=llvm
+
+all: $(ortho_exec)
+
+$(ortho_exec): $(ortho_srcdir)/llvm/ortho_llvm.ads force llvm-cbindings.o
+	gnatmake -m -o $@ -g -aI$(ortho_srcdir)/llvm -aI$(ortho_srcdir) \
+	$(GNAT_FLAGS) ortho_code_main -bargs -E \
+	-largs llvm-cbindings.o `$(LLVM_CONFIG) --ldflags --libs --system-libs` -lc++ #-static
+
+llvm-cbindings.o: $(ortho_srcdir)/llvm/llvm-cbindings.cpp
+	$(CXX) -c  -I`$(LLVM_CONFIG) --includedir --cflags` -g -o $@ $<
+
+clean:
+	$(RM) -f *.o *.ali ortho_code_main
+	$(RM) b~*.ad? *~
+
+distclean: clean
+
+
+force:
+
+.PHONY: force all clean
+
+ORTHO_BASENAME=ortho_llvm
+include $(ortho_srcdir)/Makefile.inc
diff --git a/src/ortho/llvm/llvm-analysis.ads b/src/ortho/llvm/llvm-analysis.ads
new file mode 100644
index 000000000..bfecec579
--- /dev/null
+++ b/src/ortho/llvm/llvm-analysis.ads
@@ -0,0 +1,53 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with LLVM.Core; use LLVM.Core;
+
+package LLVM.Analysis is
+   type VerifierFailureAction is
+     (
+      AbortProcessAction, -- verifier will print to stderr and abort()
+      PrintMessageAction, -- verifier will print to stderr and return 1
+      ReturnStatusAction  -- verifier will just return 1
+     );
+   pragma Convention (C, VerifierFailureAction);
+
+   -- Verifies that a module is valid, taking the specified action if not.
+   -- Optionally returns a human-readable description of any invalid
+   -- constructs.
+   -- OutMessage must be disposed with DisposeMessage. */
+   function VerifyModule(M : ModuleRef;
+                         Action : VerifierFailureAction;
+                         OutMessage : access Cstring)
+                        return Integer;
+
+   -- Verifies that a single function is valid, taking the specified
+   --  action. Useful for debugging.
+   function VerifyFunction(Fn : ValueRef; Action : VerifierFailureAction)
+     return Integer;
+
+   -- Open up a ghostview window that displays the CFG of the current function.
+   -- Useful for debugging.
+   procedure ViewFunctionCFG(Fn : ValueRef);
+   procedure ViewFunctionCFGOnly(Fn : ValueRef);
+private
+   pragma Import (C, VerifyModule, "LLVMVerifyModule");
+   pragma Import (C, VerifyFunction, "LLVMVerifyFunction");
+   pragma Import (C, ViewFunctionCFG, "LLVMViewFunctionCFG");
+   pragma Import (C, ViewFunctionCFGOnly, "LLVMViewFunctionCFGOnly");
+end LLVM.Analysis;
+
diff --git a/src/ortho/llvm/llvm-bitwriter.ads b/src/ortho/llvm/llvm-bitwriter.ads
new file mode 100644
index 000000000..3f9c518e4
--- /dev/null
+++ b/src/ortho/llvm/llvm-bitwriter.ads
@@ -0,0 +1,34 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with LLVM.Core; use LLVM.Core;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Interfaces.C; use Interfaces.C;
+
+package LLVM.BitWriter is
+   -- Writes a module to an open file descriptor. Returns 0 on success.
+   -- Closes the Handle. Use dup first if this is not what you want.
+   function WriteBitcodeToFileHandle(M : ModuleRef; Handle : File_Descriptor)
+                                    return int;
+
+   -- Writes a module to the specified path. Returns 0 on success.
+   function WriteBitcodeToFile(M : ModuleRef; Path : Cstring)
+                              return int;
+private
+   pragma Import (C, WriteBitcodeToFileHandle, "LLVMWriteBitcodeToFileHandle");
+   pragma Import (C, WriteBitcodeToFile, "LLVMWriteBitcodeToFile");
+end LLVM.BitWriter;
diff --git a/src/ortho/llvm/llvm-cbindings.cpp b/src/ortho/llvm/llvm-cbindings.cpp
new file mode 100644
index 000000000..e4d666ade
--- /dev/null
+++ b/src/ortho/llvm/llvm-cbindings.cpp
@@ -0,0 +1,61 @@
+/*  LLVM binding
+  Copyright (C) 2014 Tristan Gingold
+
+  GHDL is free software; you can redistribute it and/or modify it under
+  the terms of the GNU General Public License as published by the Free
+  Software Foundation; either version 2, or (at your option) any later
+  version.
+
+  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+  for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with GHDL; see the file COPYING.  If not, write to the Free
+  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+  02111-1307, USA.  */
+#include "llvm-c/Target.h"
+#include "llvm-c/Core.h"
+#include "llvm-c/ExecutionEngine.h"
+#include "llvm/IR/Type.h"
+#include "llvm/IR/LLVMContext.h"
+#include "llvm/IR/Metadata.h"
+#include "llvm/ExecutionEngine/ExecutionEngine.h"
+
+using namespace llvm;
+
+extern "C" {
+
+void
+LLVMInitializeNativeTarget_noinline (void)
+{
+  LLVMInitializeNativeTarget ();
+}
+
+void
+LLVMInitializeNativeAsmPrinter_noinline (void)
+{
+  LLVMInitializeNativeAsmPrinter();
+}
+
+LLVMTypeRef LLVMMetadataTypeInContext(LLVMContextRef C) {
+  return (LLVMTypeRef) Type::getMetadataTy(*unwrap(C));
+}
+
+LLVMTypeRef LLVMMetadataType_extra(void) {
+  return LLVMMetadataTypeInContext(LLVMGetGlobalContext());
+}
+
+void
+LLVMMDNodeReplaceOperandWith_extra (LLVMValueRef N, unsigned i, LLVMValueRef V) {
+  MDNode *MD = cast<MDNode>(unwrap(N));
+  MD->replaceOperandWith (i, unwrap(V));
+}
+
+void *LLVMGetPointerToFunction(LLVMExecutionEngineRef EE, LLVMValueRef Func)
+{
+  return unwrap(EE)->getPointerToFunction(unwrap<Function>(Func));
+}
+
+}
diff --git a/src/ortho/llvm/llvm-core.ads b/src/ortho/llvm/llvm-core.ads
new file mode 100644
index 000000000..74a47484f
--- /dev/null
+++ b/src/ortho/llvm/llvm-core.ads
@@ -0,0 +1,1279 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Interfaces.C; use Interfaces.C;
+use Interfaces;
+
+package LLVM.Core is
+
+   subtype Cstring is System.Address;
+   function "=" (L, R : Cstring) return Boolean renames System."=";
+   --  Null_Cstring : constant Cstring := Null_Address;
+   Nul : constant String := (1 => Character'Val (0));
+   Empty_Cstring : constant Cstring := Nul'Address;
+
+   --  The top-level container for all LLVM global data. See the LLVMContext
+   --  class.
+   type ContextRef is new System.Address;
+
+   --  The top-level container for all other LLVM Intermediate
+   --  Representation (IR) objects. See the llvm::Module class.
+   type ModuleRef is new System.Address;
+
+   subtype Bool is int;
+
+   --  Each value in the LLVM IR has a type, an LLVMTypeRef. See the llvm::Type
+   --  class.
+   type TypeRef is new System.Address;
+   Null_TypeRef : constant TypeRef := TypeRef (System.Null_Address);
+   type TypeRefArray is array (unsigned range <>) of TypeRef;
+   pragma Convention (C, TypeRefArray);
+
+   type ValueRef is new System.Address;
+   Null_ValueRef : constant ValueRef := ValueRef (System.Null_Address);
+   type ValueRefArray is array (unsigned range <>) of ValueRef; -- Ada
+   pragma Convention (C, ValueRefArray);
+
+   type BasicBlockRef is new System.Address;
+   Null_BasicBlockRef : constant BasicBlockRef :=
+     BasicBlockRef (System.Null_Address);
+   type BasicBlockRefArray is
+     array (unsigned range <>) of BasicBlockRef; -- Ada
+   pragma Convention (C, BasicBlockRefArray);
+
+   type BuilderRef is new System.Address;
+
+   --  Used to provide a module to JIT or interpreter.
+   --  See the llvm::MemoryBuffer class.
+   type MemoryBufferRef is new System.Address;
+
+   --  See the llvm::PassManagerBase class.
+   type PassManagerRef is new System.Address;
+
+   type Attribute is new unsigned;
+   ZExtAttribute            : constant Attribute := 2**0;
+   SExtAttribute            : constant Attribute := 2**1;
+   NoReturnAttribute        : constant Attribute := 2**2;
+   InRegAttribute           : constant Attribute := 2**3;
+   StructRetAttribute       : constant Attribute := 2**4;
+   NoUnwindAttribute        : constant Attribute := 2**5;
+   NoAliasAttribute         : constant Attribute := 2**6;
+   ByValAttribute           : constant Attribute := 2**7;
+   NestAttribute            : constant Attribute := 2**8;
+   ReadNoneAttribute        : constant Attribute := 2**9;
+   ReadOnlyAttribute        : constant Attribute := 2**10;
+   NoInlineAttribute        : constant Attribute := 1**11;
+   AlwaysInlineAttribute    : constant Attribute := 1**12;
+   OptimizeForSizeAttribute : constant Attribute := 1**13;
+   StackProtectAttribute    : constant Attribute := 1**14;
+   StackProtectReqAttribute : constant Attribute := 1**15;
+   Alignment                : constant Attribute := 31**16;
+   NoCaptureAttribute       : constant Attribute := 1**21;
+   NoRedZoneAttribute       : constant Attribute := 1**22;
+   NoImplicitFloatAttribute : constant Attribute := 1**23;
+   NakedAttribute           : constant Attribute := 1**24;
+   InlineHintAttribute      : constant Attribute := 1**25;
+   StackAlignment           : constant Attribute := 7**26;
+   ReturnsTwice             : constant Attribute := 1**29;
+   UWTable                  : constant Attribute := 1**30;
+   NonLazyBind              : constant Attribute := 1**31;
+
+   type TypeKind is
+     (
+      VoidTypeKind,        --  type with no size
+      HalfTypeKind,        --  16 bit floating point type
+      FloatTypeKind,       --  32 bit floating point type
+      DoubleTypeKind,      --  64 bit floating point type
+      X86_FP80TypeKind,    --  80 bit floating point type (X87)
+      FP128TypeKind,       --  128 bit floating point type (112-bit mantissa)
+      PPC_FP128TypeKind,   --  128 bit floating point type (two 64-bits)
+      LabelTypeKind,       --  Labels
+      IntegerTypeKind,     --  Arbitrary bit width integers
+      FunctionTypeKind,    --  Functions
+      StructTypeKind,      --  Structures
+      ArrayTypeKind,       --  Arrays
+      PointerTypeKind,     --  Pointers
+      VectorTypeKind,      --  SIMD 'packed' format, or other vector type
+      MetadataTypeKind,    --  Metadata
+      X86_MMXTypeKind      --  X86 MMX
+     );
+   pragma Convention (C, TypeKind);
+
+   type Linkage is
+     (
+      ExternalLinkage,    --  Externally visible function
+      AvailableExternallyLinkage,
+      LinkOnceAnyLinkage, --  Keep one copy of function when linking (inline)
+      LinkOnceODRLinkage, --  Same, but only replaced by someth equivalent.
+      LinkOnceODRAutoHideLinkage, --  Obsolete
+      WeakAnyLinkage,     --  Keep one copy of function when linking (weak)
+      WeakODRLinkage,     --  Same, but only replaced by someth equivalent.
+      AppendingLinkage,   --  Special purpose, only applies to global arrays
+      InternalLinkage,    --  Rename collisions when linking (static func)
+      PrivateLinkage,     --  Like Internal, but omit from symbol table
+      DLLImportLinkage,   --  Obsolete
+      DLLExportLinkage,   --  Obsolete
+      ExternalWeakLinkage,--  ExternalWeak linkage description
+      GhostLinkage,       --  Obsolete
+      CommonLinkage,      --  Tentative definitions
+      LinkerPrivateLinkage, --  Like Private, but linker removes.
+      LinkerPrivateWeakLinkage --  Like LinkerPrivate, but is weak.
+     );
+   pragma Convention (C, Linkage);
+
+   type Visibility is
+     (
+      DefaultVisibility,  --  The GV is visible
+      HiddenVisibility,   --  The GV is hidden
+      ProtectedVisibility --  The GV is protected
+     );
+   pragma Convention (C, Visibility);
+
+   type CallConv is new unsigned;
+   CCallConv           : constant CallConv := 0;
+   FastCallConv        : constant CallConv := 8;
+   ColdCallConv        : constant CallConv := 9;
+   X86StdcallCallConv  : constant CallConv := 64;
+   X86FastcallCallConv : constant CallConv := 6;
+
+   type IntPredicate is new unsigned;
+   IntEQ  : constant IntPredicate := 32; -- equal
+   IntNE  : constant IntPredicate := 33; -- not equal
+   IntUGT : constant IntPredicate := 34; -- unsigned greater than
+   IntUGE : constant IntPredicate := 35; -- unsigned greater or equal
+   IntULT : constant IntPredicate := 36; -- unsigned less than
+   IntULE : constant IntPredicate := 37; -- unsigned less or equal
+   IntSGT : constant IntPredicate := 38; -- signed greater than
+   IntSGE : constant IntPredicate := 39; -- signed greater or equal
+   IntSLT : constant IntPredicate := 40; -- signed less than
+   IntSLE : constant IntPredicate := 41; -- signed less or equal
+
+   type RealPredicate is
+     (
+      RealPredicateFalse, --  Always false (always folded)
+      RealOEQ,            --  True if ordered and equal
+      RealOGT,            --  True if ordered and greater than
+      RealOGE,            --  True if ordered and greater than or equal
+      RealOLT,            --  True if ordered and less than
+      RealOLE,            --  True if ordered and less than or equal
+      RealONE,            --  True if ordered and operands are unequal
+      RealORD,            --  True if ordered (no nans)
+      RealUNO,            --  True if unordered: isnan(X) | isnan(Y)
+      RealUEQ,            --  True if unordered or equal
+      RealUGT,            --  True if unordered or greater than
+      RealUGE,            --  True if unordered, greater than, or equal
+      RealULT,            --  True if unordered or less than
+      RealULE,            --  True if unordered, less than, or equal
+      RealUNE,            --  True if unordered or not equal
+      RealPredicateTrue   --  Always true (always folded)
+     );
+
+   -- Error handling ----------------------------------------------------
+
+   procedure DisposeMessage (Message : Cstring);
+
+
+   --  Context
+
+   --  Create a new context.
+   --  Every call to this function should be paired with a call to
+   -- LLVMContextDispose() or the context will leak memory.
+   function ContextCreate return ContextRef;
+
+   --  Obtain the global context instance.
+   function GetGlobalContext return ContextRef;
+
+   --  Destroy a context instance.
+   --  This should be called for every call to LLVMContextCreate() or memory
+   --  will be leaked.
+   procedure ContextDispose (C : ContextRef);
+
+   function GetMDKindIDInContext
+     (C : ContextRef; Name : Cstring; Slen : unsigned)
+     return unsigned;
+
+   function GetMDKindID(Name : String; Slen : unsigned) return unsigned;
+
+   -- Modules -----------------------------------------------------------
+
+   -- Create and destroy modules.
+   -- See llvm::Module::Module.
+   function ModuleCreateWithName (ModuleID : Cstring) return ModuleRef;
+
+   -- See llvm::Module::~Module.
+   procedure DisposeModule (M : ModuleRef);
+
+   -- Data layout. See Module::getDataLayout.
+   function GetDataLayout(M : ModuleRef) return Cstring;
+   procedure SetDataLayout(M : ModuleRef; Triple : Cstring);
+
+   -- Target triple. See Module::getTargetTriple.
+   function GetTarget (M : ModuleRef) return Cstring;
+   procedure SetTarget (M : ModuleRef; Triple : Cstring);
+
+   -- See Module::dump.
+   procedure DumpModule(M : ModuleRef);
+
+   --  Print a representation of a module to a file. The ErrorMessage needs to
+   --  be disposed with LLVMDisposeMessage. Returns 0 on success, 1 otherwise.
+   --
+   --  @see Module::print()
+   function PrintModuleToFile(M : ModuleRef;
+                              Filename : Cstring;
+                              ErrorMessage : access Cstring) return Bool;
+
+
+   -- Types -------------------------------------------------------------
+
+   -- LLVM types conform to the following hierarchy:
+   --
+   --   types:
+   --     integer type
+   --     real type
+   --     function type
+   --     sequence types:
+   --       array type
+   --       pointer type
+   --       vector type
+   --     void type
+   --     label type
+   --     opaque type
+
+   -- See llvm::LLVMTypeKind::getTypeID.
+   function GetTypeKind (Ty : TypeRef) return TypeKind;
+
+   -- Operations on integer types
+   function Int1Type return TypeRef;
+   function Int8Type return TypeRef;
+   function Int16Type return TypeRef;
+   function Int32Type return TypeRef;
+   function Int64Type return TypeRef;
+   function IntType(NumBits : unsigned) return TypeRef;
+   function GetIntTypeWidth(IntegerTy : TypeRef) return unsigned;
+
+   function MetadataType return TypeRef;
+
+   -- Operations on real types
+   function FloatType return TypeRef;
+   function DoubleType return TypeRef;
+   function X86FP80Type return TypeRef;
+   function FP128Type return TypeRef;
+   function PPCFP128Type return TypeRef;
+
+   -- Operations on function types
+   function FunctionType(ReturnType : TypeRef;
+                         ParamTypes : TypeRefArray;
+                         ParamCount : unsigned;
+                         IsVarArg : int) return TypeRef;
+
+   function IsFunctionVarArg(FunctionTy : TypeRef) return int;
+   function GetReturnType(FunctionTy : TypeRef) return TypeRef;
+   function CountParamTypes(FunctionTy : TypeRef) return unsigned;
+   procedure GetParamTypes(FunctionTy : TypeRef; Dest : out TypeRefArray);
+
+   -- Operations on struct types
+   function StructType(ElementTypes : TypeRefArray;
+                       ElementCount : unsigned;
+                       Packed : Bool) return TypeRef;
+   function StructCreateNamed(C : ContextRef; Name : Cstring) return TypeRef;
+   procedure StructSetBody(StructTy : TypeRef;
+                           ElementTypes : TypeRefArray;
+                           ElementCount : unsigned;
+                           Packed : Bool);
+   function CountStructElementTypes(StructTy : TypeRef) return unsigned;
+   procedure GetStructElementTypes(StructTy : TypeRef;
+                                   Dest : out TypeRefArray);
+   function IsPackedStruct(StructTy : TypeRef) return Bool;
+
+
+   -- Operations on array, pointer, and vector types (sequence types)
+   function ArrayType(ElementType : TypeRef; ElementCount : unsigned)
+                     return TypeRef;
+   function PointerType(ElementType : TypeRef; AddressSpace : unsigned := 0)
+                       return TypeRef;
+   function VectorType(ElementType : TypeRef; ElementCount : unsigned)
+                      return TypeRef;
+
+   function GetElementType(Ty : TypeRef) return TypeRef;
+   function GetArrayLength(ArrayTy : TypeRef) return unsigned;
+   function GetPointerAddressSpace(PointerTy : TypeRef) return unsigned;
+   function GetVectorSize(VectorTy : TypeRef) return unsigned;
+
+   -- Operations on other types.
+   function VoidType return TypeRef;
+   function LabelType return TypeRef;
+
+   -- Values ------------------------------------------------------------
+   -- The bulk of LLVM's object model consists of values, which comprise a very
+   -- rich type hierarchy.
+   --
+   --   values:
+   --     constants:
+   --       scalar constants
+   --       composite contants
+   --       globals:
+   --         global variable
+   --         function
+   --         alias
+   --       basic blocks
+
+   -- Operations on all values
+   function TypeOf(Val : ValueRef) return TypeRef;
+   function GetValueName(Val : ValueRef) return Cstring;
+   procedure SetValueName(Val : ValueRef; Name : Cstring);
+   procedure DumpValue(Val : ValueRef);
+
+   -- Operations on constants of any type
+   function ConstNull(Ty : TypeRef) return ValueRef; --  All zero
+   function ConstAllOnes(Ty : TypeRef) return ValueRef; -- Int or Vec
+   function GetUndef(Ty : TypeRef) return ValueRef;
+   function IsConstant(Val : ValueRef) return int;
+   function IsNull(Val : ValueRef) return int;
+   function IsUndef(Val : ValueRef) return int;
+
+   --  Convert value instances between types.
+   --
+   --  Internally, an LLVMValueRef is "pinned" to a specific type. This
+   --  series of functions allows you to cast an instance to a specific
+   --  type.
+   --
+   --  If the cast is not valid for the specified type, NULL is returned.
+   --
+   -- @see llvm::dyn_cast_or_null<>
+   function IsAInstruction (Val : ValueRef) return ValueRef;
+
+   -- Operations on scalar constants
+   function ConstInt(IntTy : TypeRef; N : Unsigned_64; SignExtend : int)
+                    return ValueRef;
+   function ConstReal(RealTy : TypeRef; N : double) return ValueRef;
+   function ConstRealOfString(RealTy : TypeRef; Text : Cstring)
+                             return ValueRef;
+
+
+   -- Obtain the zero extended value for an integer constant value.
+   -- @see llvm::ConstantInt::getZExtValue()
+   function ConstIntGetZExtValue (ConstantVal : ValueRef) return Unsigned_64;
+
+   -- Operations on composite constants
+   function ConstString(Str : Cstring;
+                        Length : unsigned; DontNullTerminate : int)
+                       return ValueRef;
+   function ConstArray(ElementTy : TypeRef;
+                       ConstantVals : ValueRefArray; Length : unsigned)
+                      return ValueRef;
+   function ConstStruct(ConstantVals : ValueRefArray;
+                        Count : unsigned; packed : int) return ValueRef;
+
+   --  Create a non-anonymous ConstantStruct from values.
+   --  @see llvm::ConstantStruct::get()
+   function ConstNamedStruct(StructTy : TypeRef;
+                             ConstantVals : ValueRefArray;
+                             Count : unsigned) return ValueRef;
+
+   function ConstVector(ScalarConstantVals : ValueRefArray; Size : unsigned)
+                       return ValueRef;
+
+   -- Constant expressions
+   function SizeOf(Ty : TypeRef) return ValueRef;
+   function AlignOf(Ty : TypeRef) return ValueRef;
+
+   function ConstNeg(ConstantVal : ValueRef) return ValueRef;
+   function ConstNot(ConstantVal : ValueRef) return ValueRef;
+   function ConstAdd(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstSub(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstMul(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstUDiv(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstSDiv(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstFDiv(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstURem(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstSRem(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstFRem(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstAnd(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstOr(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                   return ValueRef;
+   function ConstXor(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstICmp(Predicate : IntPredicate;
+                      LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstFCmp(Predicate : RealPredicate;
+                      LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstShl(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstLShr(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstAShr(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstGEP(ConstantVal : ValueRef;
+                     ConstantIndices : ValueRefArray; NumIndices : unsigned)
+                    return ValueRef;
+   function ConstTrunc(ConstantVal : ValueRef; ToType : TypeRef)
+                      return ValueRef;
+   function ConstSExt(ConstantVal : ValueRef; ToType : TypeRef)
+                     return ValueRef;
+   function ConstZExt(ConstantVal : ValueRef; ToType : TypeRef)
+                     return ValueRef;
+   function ConstFPTrunc(ConstantVal : ValueRef; ToType : TypeRef)
+                        return ValueRef;
+   function ConstFPExt(ConstantVal : ValueRef; ToType : TypeRef)
+                      return ValueRef;
+   function ConstUIToFP(ConstantVal : ValueRef; ToType : TypeRef)
+                       return ValueRef;
+   function ConstSIToFP(ConstantVal : ValueRef; ToType : TypeRef)
+                       return ValueRef;
+   function ConstFPToUI(ConstantVal : ValueRef; ToType : TypeRef)
+                       return ValueRef;
+   function ConstFPToSI(ConstantVal : ValueRef; ToType : TypeRef)
+                       return ValueRef;
+   function ConstPtrToInt(ConstantVal : ValueRef; ToType : TypeRef)
+                         return ValueRef;
+   function ConstIntToPtr(ConstantVal : ValueRef; ToType : TypeRef)
+                         return ValueRef;
+   function ConstBitCast(ConstantVal : ValueRef; ToType : TypeRef)
+                        return ValueRef;
+
+   function ConstTruncOrBitCast(ConstantVal : ValueRef; ToType : TypeRef)
+                               return ValueRef;
+
+   function ConstSelect(ConstantCondition : ValueRef;
+                        ConstantIfTrue : ValueRef;
+                        ConstantIfFalse : ValueRef) return ValueRef;
+   function ConstExtractElement(VectorConstant : ValueRef;
+                                IndexConstant : ValueRef) return ValueRef;
+   function ConstInsertElement(VectorConstant : ValueRef;
+                               ElementValueConstant : ValueRef;
+                               IndexConstant : ValueRef) return ValueRef;
+   function ConstShuffleVector(VectorAConstant : ValueRef;
+                               VectorBConstant : ValueRef;
+                               MaskConstant : ValueRef) return ValueRef;
+
+   -- Operations on global variables, functions, and aliases (globals)
+   function GetGlobalParent(Global : ValueRef) return ModuleRef;
+   function IsDeclaration(Global : ValueRef) return int;
+   function GetLinkage(Global : ValueRef) return Linkage;
+   procedure SetLinkage(Global : ValueRef; Link : Linkage);
+   function GetSection(Global : ValueRef) return Cstring;
+   procedure SetSection(Global : ValueRef; Section : Cstring);
+   function GetVisibility(Global : ValueRef) return Visibility;
+   procedure SetVisibility(Global : ValueRef; Viz : Visibility);
+   function GetAlignment(Global : ValueRef) return unsigned;
+   procedure SetAlignment(Global : ValueRef; Bytes : unsigned);
+
+   -- Operations on global variables
+   function AddGlobal(M : ModuleRef; Ty : TypeRef; Name : Cstring)
+                     return ValueRef;
+   function GetNamedGlobal(M : ModuleRef; Name : Cstring) return ValueRef;
+   function GetFirstGlobal(M : ModuleRef) return ValueRef;
+   function GetLastGlobal(M : ModuleRef) return ValueRef;
+   function GetNextGlobal(GlobalVar : ValueRef) return ValueRef;
+   function GetPreviousGlobal(GlobalVar : ValueRef) return ValueRef;
+   procedure DeleteGlobal(GlobalVar : ValueRef);
+   function GetInitializer(GlobalVar : ValueRef) return ValueRef;
+   procedure SetInitializer(GlobalVar : ValueRef; ConstantVal : ValueRef);
+   function IsThreadLocal(GlobalVar : ValueRef) return int;
+   procedure SetThreadLocal(GlobalVar : ValueRef; IsThreadLocal : int);
+   function IsGlobalConstant(GlobalVar : ValueRef) return int;
+   procedure SetGlobalConstant(GlobalVar : ValueRef; IsConstant : int);
+
+   --  Obtain the number of operands for named metadata in a module.
+   --  @see llvm::Module::getNamedMetadata()
+   function GetNamedMetadataNumOperands(M : ModuleRef; Name : Cstring)
+                                       return unsigned;
+
+   --  Obtain the named metadata operands for a module.
+   --  The passed LLVMValueRef pointer should refer to an array of
+   --  LLVMValueRef at least LLVMGetNamedMetadataNumOperands long. This
+   --  array will be populated with the LLVMValueRef instances. Each
+   --  instance corresponds to a llvm::MDNode.
+   --  @see llvm::Module::getNamedMetadata()
+   --  @see llvm::MDNode::getOperand()
+   procedure GetNamedMetadataOperands
+     (M : ModuleRef; Name : Cstring; Dest : ValueRefArray);
+
+   --  Add an operand to named metadata.
+   --  @see llvm::Module::getNamedMetadata()
+   --  @see llvm::MDNode::addOperand()
+   procedure AddNamedMetadataOperand
+     (M : ModuleRef; Name : Cstring; Val : ValueRef);
+
+   -- Operations on functions
+   function AddFunction(M : ModuleRef; Name : Cstring; FunctionTy : TypeRef)
+                       return ValueRef;
+   function GetNamedFunction(M : ModuleRef; Name : Cstring) return ValueRef;
+   function GetFirstFunction(M : ModuleRef) return ValueRef;
+   function GetLastFunction(M : ModuleRef) return ValueRef;
+   function GetNextFunction(Fn : ValueRef) return ValueRef;
+   function GetPreviousFunction(Fn : ValueRef) return ValueRef;
+   procedure DeleteFunction(Fn : ValueRef);
+   function GetIntrinsicID(Fn : ValueRef) return unsigned;
+   function GetFunctionCallConv(Fn : ValueRef) return CallConv;
+   procedure SetFunctionCallConv(Fn : ValueRef; CC : CallConv);
+   function GetGC(Fn : ValueRef) return Cstring;
+   procedure SetGC(Fn : ValueRef; Name : Cstring);
+
+   --  Add an attribute to a function.
+   --  @see llvm::Function::addAttribute()
+   procedure AddFunctionAttr (Fn : ValueRef; PA : Attribute);
+
+   --  Add a target-dependent attribute to a fuction
+   --  @see llvm::AttrBuilder::addAttribute()
+   procedure AddTargetDependentFunctionAttr
+     (Fn : ValueRef; A : Cstring; V : Cstring);
+
+   --  Obtain an attribute from a function.
+   --  @see llvm::Function::getAttributes()
+   function GetFunctionAttr (Fn : ValueRef) return Attribute;
+
+   --  Remove an attribute from a function.
+   procedure RemoveFunctionAttr (Fn : ValueRef; PA : Attribute);
+
+   -- Operations on parameters
+   function CountParams(Fn : ValueRef) return unsigned;
+   procedure GetParams(Fn : ValueRef; Params : ValueRefArray);
+   function GetParam(Fn : ValueRef; Index : unsigned) return ValueRef;
+   function GetParamParent(Inst : ValueRef) return ValueRef;
+   function GetFirstParam(Fn : ValueRef) return ValueRef;
+   function GetLastParam(Fn : ValueRef) return ValueRef;
+   function GetNextParam(Arg : ValueRef) return ValueRef;
+   function GetPreviousParam(Arg : ValueRef) return ValueRef;
+   procedure AddAttribute(Arg : ValueRef; PA : Attribute);
+   procedure RemoveAttribute(Arg : ValueRef; PA : Attribute);
+   procedure SetParamAlignment(Arg : ValueRef; align : unsigned);
+
+   --  Metadata
+
+   --  Obtain a MDString value from a context.
+   --  The returned instance corresponds to the llvm::MDString class.
+   --  The instance is specified by string data of a specified length. The
+   --  string content is copied, so the backing memory can be freed after
+   --  this function returns.
+   function MDStringInContext(C : ContextRef; Str : Cstring; Len : unsigned)
+                             return ValueRef;
+
+   --  Obtain a MDString value from the global context.
+   function MDString(Str : Cstring; Len : unsigned) return ValueRef;
+
+   --  Obtain a MDNode value from a context.
+   --  The returned value corresponds to the llvm::MDNode class.
+   function MDNodeInContext
+     (C : ContextRef; Vals : ValueRefArray; Count : unsigned)
+     return ValueRef;
+
+   --  Obtain a MDNode value from the global context.
+   function MDNode(Vals : ValueRefArray; Count : unsigned) return ValueRef;
+
+   --  Obtain the underlying string from a MDString value.
+   --  @param V Instance to obtain string from.
+   --  @param Len Memory address which will hold length of returned string.
+   --  @return String data in MDString.
+   function GetMDString(V : ValueRef; Len : access unsigned) return Cstring;
+
+   --  Obtain the number of operands from an MDNode value.
+   --  @param V MDNode to get number of operands from.
+   --  @return Number of operands of the MDNode.
+   function GetMDNodeNumOperands(V : ValueRef) return unsigned;
+
+   --  Obtain the given MDNode's operands.
+   --  The passed LLVMValueRef pointer should point to enough memory to hold
+   --  all of the operands of the given MDNode (see LLVMGetMDNodeNumOperands)
+   --  as LLVMValueRefs. This memory will be populated with the LLVMValueRefs
+   --  of the MDNode's operands.
+   --  @param V MDNode to get the operands from.
+   --  @param Dest Destination array for operands.
+   procedure GetMDNodeOperands(V : ValueRef; Dest : ValueRefArray);
+
+   procedure MDNodeReplaceOperandWith
+     (N : ValueRef; I : unsigned; V : ValueRef);
+
+   -- Operations on basic blocks
+   function BasicBlockAsValue(BB : BasicBlockRef) return ValueRef;
+   function ValueIsBasicBlock(Val : ValueRef) return int;
+   function ValueAsBasicBlock(Val : ValueRef) return BasicBlockRef;
+   function GetBasicBlockParent(BB : BasicBlockRef) return ValueRef;
+   function CountBasicBlocks(Fn : ValueRef) return unsigned;
+   procedure GetBasicBlocks(Fn : ValueRef; BasicBlocks : BasicBlockRefArray);
+   function GetFirstBasicBlock(Fn : ValueRef) return BasicBlockRef;
+   function GetLastBasicBlock(Fn : ValueRef) return BasicBlockRef;
+   function GetNextBasicBlock(BB : BasicBlockRef) return BasicBlockRef;
+   function GetPreviousBasicBlock(BB : BasicBlockRef) return BasicBlockRef;
+   function GetEntryBasicBlock(Fn : ValueRef) return BasicBlockRef;
+   function AppendBasicBlock(Fn : ValueRef; Name : Cstring)
+                            return BasicBlockRef;
+   function InsertBasicBlock(InsertBeforeBB : BasicBlockRef;
+                             Name : Cstring) return BasicBlockRef;
+   procedure DeleteBasicBlock(BB : BasicBlockRef);
+
+   -- Operations on instructions
+
+   --  Determine whether an instruction has any metadata attached.
+   function HasMetadata(Val: ValueRef) return Bool;
+
+   --  Return metadata associated with an instruction value.
+   function GetMetadata(Val : ValueRef; KindID : unsigned) return ValueRef;
+
+   --  Set metadata associated with an instruction value.
+   procedure SetMetadata(Val : ValueRef; KindID : unsigned; Node : ValueRef);
+
+   function GetInstructionParent(Inst : ValueRef) return BasicBlockRef;
+   function GetFirstInstruction(BB : BasicBlockRef) return ValueRef;
+   function GetLastInstruction(BB : BasicBlockRef) return ValueRef;
+   function GetNextInstruction(Inst : ValueRef) return ValueRef;
+   function GetPreviousInstruction(Inst : ValueRef) return ValueRef;
+
+   -- Operations on call sites
+   procedure SetInstructionCallConv(Instr : ValueRef; CC : unsigned);
+   function GetInstructionCallConv(Instr : ValueRef) return unsigned;
+   procedure AddInstrAttribute(Instr : ValueRef;
+                               index : unsigned; Attr : Attribute);
+   procedure RemoveInstrAttribute(Instr : ValueRef;
+                                 index : unsigned; Attr : Attribute);
+   procedure SetInstrParamAlignment(Instr : ValueRef;
+                                    index : unsigned; align : unsigned);
+
+   -- Operations on call instructions (only)
+   function IsTailCall(CallInst : ValueRef) return int;
+   procedure SetTailCall(CallInst : ValueRef; IsTailCall : int);
+
+   -- Operations on phi nodes
+   procedure AddIncoming(PhiNode : ValueRef; IncomingValues : ValueRefArray;
+                        IncomingBlocks : BasicBlockRefArray; Count : unsigned);
+   function CountIncoming(PhiNode : ValueRef) return unsigned;
+   function GetIncomingValue(PhiNode : ValueRef; Index : unsigned)
+                            return ValueRef;
+   function GetIncomingBlock(PhiNode : ValueRef; Index : unsigned)
+                            return BasicBlockRef;
+
+   -- Instruction builders ----------------------------------------------
+   --  An instruction builder represents a point within a basic block,
+   --  and is the exclusive means of building instructions using the C
+   --  interface.
+
+   function CreateBuilder return BuilderRef;
+   procedure PositionBuilder(Builder : BuilderRef;
+                             Block : BasicBlockRef; Instr : ValueRef);
+   procedure PositionBuilderBefore(Builder : BuilderRef; Instr : ValueRef);
+   procedure PositionBuilderAtEnd(Builder : BuilderRef; Block : BasicBlockRef);
+   function GetInsertBlock(Builder : BuilderRef) return BasicBlockRef;
+   procedure DisposeBuilder(Builder : BuilderRef);
+
+   -- Terminators
+   function BuildRetVoid(Builder : BuilderRef) return ValueRef;
+   function BuildRet(Builder : BuilderRef; V : ValueRef) return ValueRef;
+   function BuildBr(Builder : BuilderRef; Dest : BasicBlockRef)
+                   return ValueRef;
+   function BuildCondBr(Builder : BuilderRef;
+                        If_Br : ValueRef;
+                        Then_Br : BasicBlockRef; Else_Br : BasicBlockRef)
+                       return ValueRef;
+   function BuildSwitch(Builder : BuilderRef;
+                        V : ValueRef;
+                        Else_Br : BasicBlockRef; NumCases : unsigned)
+                       return ValueRef;
+   function BuildInvoke(Builder : BuilderRef;
+                        Fn : ValueRef;
+                        Args : ValueRefArray;
+                        NumArgs : unsigned;
+                        Then_Br : BasicBlockRef;
+                        Catch : BasicBlockRef;
+                        Name : Cstring) return ValueRef;
+   function BuildUnwind(Builder : BuilderRef) return ValueRef;
+   function BuildUnreachable(Builder : BuilderRef) return ValueRef;
+
+   -- Add a case to the switch instruction
+   procedure AddCase(Switch : ValueRef;
+                     OnVal : ValueRef; Dest : BasicBlockRef);
+
+   -- Arithmetic
+   function BuildAdd(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildNSWAdd(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+   function BuildNUWAdd(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+   function BuildFAdd(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+
+   function BuildSub(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildNSWSub(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+   function BuildNUWSub(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+   function BuildFSub(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+
+   function BuildMul(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildFMul(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+
+   function BuildUDiv(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildSDiv(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildFDiv(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildURem(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildSRem(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildFRem(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildShl(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildLShr(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildAShr(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildAnd(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildOr(Builder : BuilderRef;
+                    LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                   return ValueRef;
+   function BuildXor(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildNeg(Builder : BuilderRef; V : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildFNeg(Builder : BuilderRef; V : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildNot(Builder : BuilderRef; V : ValueRef; Name : Cstring)
+                    return ValueRef;
+
+   -- Memory
+   function BuildMalloc(Builder : BuilderRef; Ty : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildArrayMalloc(Builder : BuilderRef;
+                             Ty : TypeRef; Val : ValueRef; Name : Cstring)
+                            return ValueRef;
+   function BuildAlloca(Builder : BuilderRef; Ty : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildArrayAlloca(Builder : BuilderRef;
+                             Ty : TypeRef; Val : ValueRef; Name : Cstring)
+                            return ValueRef;
+   function BuildFree(Builder : BuilderRef; PointerVal : ValueRef)
+                     return ValueRef;
+   function BuildLoad(Builder : BuilderRef; PointerVal : ValueRef;
+                           Name : Cstring) return ValueRef;
+   function BuildStore(Builder : BuilderRef; Val : ValueRef; Ptr : ValueRef)
+                      return ValueRef;
+   function BuildGEP(Builder : BuilderRef;
+                     Pointer : ValueRef;
+                     Indices : ValueRefArray;
+                     NumIndices : unsigned; Name : Cstring) return ValueRef;
+
+   -- Casts
+   function BuildTrunc(Builder : BuilderRef;
+                       Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                      return ValueRef;
+   function BuildZExt(Builder : BuilderRef;
+                      Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                     return ValueRef;
+   function BuildSExt(Builder : BuilderRef;
+                      Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                     return ValueRef;
+   function BuildFPToUI(Builder : BuilderRef;
+                        Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildFPToSI(Builder : BuilderRef;
+                        Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildUIToFP(Builder : BuilderRef;
+                        Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildSIToFP(Builder : BuilderRef;
+                        Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildFPTrunc(Builder : BuilderRef;
+                         Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                        return ValueRef;
+   function BuildFPExt(Builder : BuilderRef;
+                       Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                      return ValueRef;
+   function BuildPtrToInt(Builder : BuilderRef;
+                          Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                         return ValueRef;
+   function BuildIntToPtr(Builder : BuilderRef;
+                          Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                         return ValueRef;
+   function BuildBitCast(Builder : BuilderRef;
+                         Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                        return ValueRef;
+
+   -- Comparisons
+   function BuildICmp(Builder : BuilderRef;
+                      Op : IntPredicate;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildFCmp(Builder : BuilderRef;
+                      Op : RealPredicate;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+
+   -- Miscellaneous instructions
+   function BuildPhi(Builder : BuilderRef; Ty : TypeRef; Name : Cstring)
+                    return ValueRef;
+   function BuildCall(Builder : BuilderRef;
+                      Fn : ValueRef;
+                      Args : ValueRefArray; NumArgs : unsigned; Name : Cstring)
+                     return ValueRef;
+   function BuildSelect(Builder : BuilderRef;
+                        If_Sel : ValueRef;
+                        Then_Sel : ValueRef;
+                        Else_Sel : ValueRef;
+                        Name : Cstring) return ValueRef;
+   function BuildVAArg(Builder : BuilderRef;
+                       List : ValueRef; Ty : TypeRef; Name : Cstring)
+                      return ValueRef;
+   function BuildExtractElement(Builder : BuilderRef;
+                                VecVal : ValueRef;
+                                Index : ValueRef;
+                                Name : Cstring) return ValueRef;
+   function BuildInsertElement(Builder : BuilderRef;
+                               VecVal : ValueRef;
+                               EltVal : ValueRef;
+                               Index : ValueRef;
+                               Name : Cstring) return ValueRef;
+   function BuildShuffleVector(Builder : BuilderRef;
+                               V1 : ValueRef;
+                               V2 : ValueRef;
+                               Mask : ValueRef;
+                               Name : Cstring) return ValueRef;
+
+   -- Memory buffers ----------------------------------------------------
+
+   function CreateMemoryBufferWithContentsOfFile
+     (Path : Cstring;
+      OutMemBuf : access MemoryBufferRef;
+      OutMessage : access Cstring) return int;
+   function CreateMemoryBufferWithSTDIN
+     (OutMemBuf : access MemoryBufferRef;
+      OutMessage : access Cstring) return int;
+   procedure DisposeMemoryBuffer(MemBuf : MemoryBufferRef);
+
+
+   -- Pass Managers -----------------------------------------------------
+
+   -- Constructs a new whole-module pass pipeline. This type of pipeline is
+   -- suitable for link-time optimization and whole-module transformations.
+   -- See llvm::PassManager::PassManager.
+   function CreatePassManager return PassManagerRef;
+
+   -- Constructs a new function-by-function pass pipeline over the module
+   -- provider. It does not take ownership of the module provider. This type of
+   -- pipeline is suitable for code generation and JIT compilation tasks.
+   -- See llvm::FunctionPassManager::FunctionPassManager.
+   function CreateFunctionPassManagerForModule(M : ModuleRef)
+                                              return PassManagerRef;
+
+   -- Initializes, executes on the provided module, and finalizes all of the
+   -- passes scheduled in the pass manager. Returns 1 if any of the passes
+   -- modified the module, 0 otherwise. See llvm::PassManager::run(Module&).
+   function RunPassManager(PM : PassManagerRef; M : ModuleRef)
+                          return int;
+
+   -- Initializes all of the function passes scheduled in the function pass
+   -- manager. Returns 1 if any of the passes modified the module, 0 otherwise.
+   -- See llvm::FunctionPassManager::doInitialization.
+   function InitializeFunctionPassManager(FPM : PassManagerRef)
+                                         return int;
+
+   --  Executes all of the function passes scheduled in the function
+   --  pass manager on the provided function. Returns 1 if any of the
+   --  passes modified the function, false otherwise.
+   -- See llvm::FunctionPassManager::run(Function&).
+   function RunFunctionPassManager (FPM : PassManagerRef; F : ValueRef)
+                                   return int;
+
+   -- Finalizes all of the function passes scheduled in in the function pass
+   -- manager. Returns 1 if any of the passes modified the module, 0 otherwise.
+   -- See llvm::FunctionPassManager::doFinalization.
+   function FinalizeFunctionPassManager(FPM : PassManagerRef)
+                                       return int;
+
+   --  Frees the memory of a pass pipeline. For function pipelines,
+   --  does not free the module provider.
+   -- See llvm::PassManagerBase::~PassManagerBase.
+   procedure DisposePassManager(PM : PassManagerRef);
+
+private
+   pragma Import (C, ContextCreate, "LLVMContextCreate");
+   pragma Import (C, GetGlobalContext, "LLVMGetGlobalContext");
+   pragma Import (C, ContextDispose, "LLVMContextDispose");
+
+   pragma Import (C, GetMDKindIDInContext, "LLVMGetMDKindIDInContext");
+   pragma Import (C, GetMDKindID, "LLVMGetMDKindID");
+
+   pragma Import (C, DisposeMessage, "LLVMDisposeMessage");
+   pragma Import (C, ModuleCreateWithName, "LLVMModuleCreateWithName");
+   pragma Import (C, DisposeModule, "LLVMDisposeModule");
+   pragma Import (C, GetDataLayout, "LLVMGetDataLayout");
+   pragma Import (C, SetDataLayout, "LLVMSetDataLayout");
+   pragma Import (C, GetTarget, "LLVMGetTarget");
+   pragma Import (C, SetTarget, "LLVMSetTarget");
+   pragma Import (C, DumpModule, "LLVMDumpModule");
+   pragma Import (C, PrintModuleToFile, "LLVMPrintModuleToFile");
+   pragma Import (C, GetTypeKind, "LLVMGetTypeKind");
+   pragma Import (C, Int1Type, "LLVMInt1Type");
+   pragma Import (C, Int8Type, "LLVMInt8Type");
+   pragma Import (C, Int16Type, "LLVMInt16Type");
+   pragma Import (C, Int32Type, "LLVMInt32Type");
+   pragma Import (C, Int64Type, "LLVMInt64Type");
+   pragma Import (C, IntType, "LLVMIntType");
+   pragma Import (C, GetIntTypeWidth, "LLVMGetIntTypeWidth");
+   pragma Import (C, MetadataType, "LLVMMetadataType_extra");
+
+   pragma Import (C, FloatType, "LLVMFloatType");
+   pragma Import (C, DoubleType, "LLVMDoubleType");
+   pragma Import (C, X86FP80Type, "LLVMX86FP80Type");
+   pragma Import (C, FP128Type, "LLVMFP128Type");
+   pragma Import (C, PPCFP128Type, "LLVMPPCFP128Type");
+
+   pragma Import (C, FunctionType, "LLVMFunctionType");
+   pragma Import (C, IsFunctionVarArg, "LLVMIsFunctionVarArg");
+   pragma Import (C, GetReturnType, "LLVMGetReturnType");
+   pragma Import (C, CountParamTypes, "LLVMCountParamTypes");
+   pragma Import (C, GetParamTypes, "LLVMGetParamTypes");
+
+   pragma Import (C, StructType, "LLVMStructType");
+   pragma Import (C, StructCreateNamed, "LLVMStructCreateNamed");
+   pragma Import (C, StructSetBody, "LLVMStructSetBody");
+   pragma Import (C, CountStructElementTypes, "LLVMCountStructElementTypes");
+   pragma Import (C, GetStructElementTypes, "LLVMGetStructElementTypes");
+   pragma Import (C, IsPackedStruct, "LLVMIsPackedStruct");
+
+   pragma Import (C, ArrayType, "LLVMArrayType");
+   pragma Import (C, PointerType, "LLVMPointerType");
+   pragma Import (C, VectorType, "LLVMVectorType");
+   pragma Import (C, GetElementType, "LLVMGetElementType");
+   pragma Import (C, GetArrayLength, "LLVMGetArrayLength");
+   pragma Import (C, GetPointerAddressSpace, "LLVMGetPointerAddressSpace");
+   pragma Import (C, GetVectorSize, "LLVMGetVectorSize");
+
+   pragma Import (C, VoidType, "LLVMVoidType");
+   pragma Import (C, LabelType, "LLVMLabelType");
+
+   pragma Import (C, TypeOf, "LLVMTypeOf");
+   pragma Import (C, GetValueName, "LLVMGetValueName");
+   pragma Import (C, SetValueName, "LLVMSetValueName");
+   pragma Import (C, DumpValue, "LLVMDumpValue");
+
+   pragma Import (C, ConstNull, "LLVMConstNull");
+   pragma Import (C, ConstAllOnes, "LLVMConstAllOnes");
+   pragma Import (C, GetUndef, "LLVMGetUndef");
+   pragma Import (C, IsConstant, "LLVMIsConstant");
+   pragma Import (C, IsNull, "LLVMIsNull");
+   pragma Import (C, IsUndef, "LLVMIsUndef");
+   pragma Import (C, IsAInstruction, "LLVMIsAInstruction");
+
+   pragma Import (C, ConstInt, "LLVMConstInt");
+   pragma Import (C, ConstReal, "LLVMConstReal");
+   pragma Import (C, ConstIntGetZExtValue, "LLVMConstIntGetZExtValue");
+   pragma Import (C, ConstRealOfString, "LLVMConstRealOfString");
+   pragma Import (C, ConstString, "LLVMConstString");
+   pragma Import (C, ConstArray, "LLVMConstArray");
+   pragma Import (C, ConstStruct, "LLVMConstStruct");
+   pragma Import (C, ConstNamedStruct, "LLVMConstNamedStruct");
+   pragma Import (C, ConstVector, "LLVMConstVector");
+
+   pragma Import (C, SizeOf, "LLVMSizeOf");
+   pragma Import (C, AlignOf, "LLVMAlignOf");
+   pragma Import (C, ConstNeg, "LLVMConstNeg");
+   pragma Import (C, ConstNot, "LLVMConstNot");
+   pragma Import (C, ConstAdd, "LLVMConstAdd");
+   pragma Import (C, ConstSub, "LLVMConstSub");
+   pragma Import (C, ConstMul, "LLVMConstMul");
+   pragma Import (C, ConstUDiv, "LLVMConstUDiv");
+   pragma Import (C, ConstSDiv, "LLVMConstSDiv");
+   pragma Import (C, ConstFDiv, "LLVMConstFDiv");
+   pragma Import (C, ConstURem, "LLVMConstURem");
+   pragma Import (C, ConstSRem, "LLVMConstSRem");
+   pragma Import (C, ConstFRem, "LLVMConstFRem");
+   pragma Import (C, ConstAnd, "LLVMConstAnd");
+   pragma Import (C, ConstOr, "LLVMConstOr");
+   pragma Import (C, ConstXor, "LLVMConstXor");
+   pragma Import (C, ConstICmp, "LLVMConstICmp");
+   pragma Import (C, ConstFCmp, "LLVMConstFCmp");
+   pragma Import (C, ConstShl, "LLVMConstShl");
+   pragma Import (C, ConstLShr, "LLVMConstLShr");
+   pragma Import (C, ConstAShr, "LLVMConstAShr");
+   pragma Import (C, ConstGEP, "LLVMConstGEP");
+   pragma Import (C, ConstTrunc, "LLVMConstTrunc");
+   pragma Import (C, ConstSExt, "LLVMConstSExt");
+   pragma Import (C, ConstZExt, "LLVMConstZExt");
+   pragma Import (C, ConstFPTrunc, "LLVMConstFPTrunc");
+   pragma Import (C, ConstFPExt, "LLVMConstFPExt");
+   pragma Import (C, ConstUIToFP, "LLVMConstUIToFP");
+   pragma Import (C, ConstSIToFP, "LLVMConstSIToFP");
+   pragma Import (C, ConstFPToUI, "LLVMConstFPToUI");
+   pragma Import (C, ConstFPToSI, "LLVMConstFPToSI");
+   pragma Import (C, ConstPtrToInt, "LLVMConstPtrToInt");
+   pragma Import (C, ConstIntToPtr, "LLVMConstIntToPtr");
+   pragma Import (C, ConstBitCast, "LLVMConstBitCast");
+   pragma Import (C, ConstTruncOrBitCast, "LLVMConstTruncOrBitCast");
+   pragma Import (C, ConstSelect, "LLVMConstSelect");
+   pragma Import (C, ConstExtractElement, "LLVMConstExtractElement");
+   pragma Import (C, ConstInsertElement, "LLVMConstInsertElement");
+   pragma Import (C, ConstShuffleVector, "LLVMConstShuffleVector");
+
+   pragma Import (C, GetGlobalParent, "LLVMGetGlobalParent");
+   pragma Import (C, IsDeclaration, "LLVMIsDeclaration");
+   pragma Import (C, GetLinkage, "LLVMGetLinkage");
+   pragma Import (C, SetLinkage, "LLVMSetLinkage");
+   pragma Import (C, GetSection, "LLVMGetSection");
+   pragma Import (C, SetSection, "LLVMSetSection");
+   pragma Import (C, GetVisibility, "LLVMGetVisibility");
+   pragma Import (C, SetVisibility, "LLVMSetVisibility");
+   pragma Import (C, GetAlignment, "LLVMGetAlignment");
+   pragma Import (C, SetAlignment, "LLVMSetAlignment");
+
+   pragma Import (C, AddGlobal, "LLVMAddGlobal");
+   pragma Import (C, GetNamedGlobal, "LLVMGetNamedGlobal");
+   pragma Import (C, GetFirstGlobal, "LLVMGetFirstGlobal");
+   pragma Import (C, GetLastGlobal, "LLVMGetLastGlobal");
+   pragma Import (C, GetNextGlobal, "LLVMGetNextGlobal");
+   pragma Import (C, GetPreviousGlobal, "LLVMGetPreviousGlobal");
+   pragma Import (C, DeleteGlobal, "LLVMDeleteGlobal");
+   pragma Import (C, GetInitializer, "LLVMGetInitializer");
+   pragma Import (C, SetInitializer, "LLVMSetInitializer");
+   pragma Import (C, IsThreadLocal, "LLVMIsThreadLocal");
+   pragma Import (C, SetThreadLocal, "LLVMSetThreadLocal");
+   pragma Import (C, IsGlobalConstant, "LLVMIsGlobalConstant");
+   pragma Import (C, SetGlobalConstant, "LLVMSetGlobalConstant");
+
+   pragma Import (C, GetNamedMetadataNumOperands,
+                  "LLVMGetNamedMetadataNumOperands");
+   pragma Import (C, GetNamedMetadataOperands, "LLVMGetNamedMetadataOperands");
+   pragma Import (C, AddNamedMetadataOperand, "LLVMAddNamedMetadataOperand");
+
+   pragma Import (C, AddFunction, "LLVMAddFunction");
+   pragma Import (C, GetNamedFunction, "LLVMGetNamedFunction");
+   pragma Import (C, GetFirstFunction, "LLVMGetFirstFunction");
+   pragma Import (C, GetLastFunction, "LLVMGetLastFunction");
+   pragma Import (C, GetNextFunction, "LLVMGetNextFunction");
+   pragma Import (C, GetPreviousFunction, "LLVMGetPreviousFunction");
+   pragma Import (C, DeleteFunction, "LLVMDeleteFunction");
+   pragma Import (C, GetIntrinsicID, "LLVMGetIntrinsicID");
+   pragma Import (C, GetFunctionCallConv, "LLVMGetFunctionCallConv");
+   pragma Import (C, SetFunctionCallConv, "LLVMSetFunctionCallConv");
+   pragma Import (C, GetGC, "LLVMGetGC");
+   pragma Import (C, SetGC, "LLVMSetGC");
+
+   pragma Import (C, AddFunctionAttr, "LLVMAddFunctionAttr");
+   pragma import (C, AddTargetDependentFunctionAttr,
+                  "LLVMAddTargetDependentFunctionAttr");
+   pragma Import (C, GetFunctionAttr, "LLVMGetFunctionAttr");
+   pragma Import (C, RemoveFunctionAttr, "LLVMRemoveFunctionAttr");
+
+   pragma Import (C, CountParams, "LLVMCountParams");
+   pragma Import (C, GetParams, "LLVMGetParams");
+   pragma Import (C, GetParam, "LLVMGetParam");
+   pragma Import (C, GetParamParent, "LLVMGetParamParent");
+   pragma Import (C, GetFirstParam, "LLVMGetFirstParam");
+   pragma Import (C, GetLastParam, "LLVMGetLastParam");
+   pragma Import (C, GetNextParam, "LLVMGetNextParam");
+   pragma Import (C, GetPreviousParam, "LLVMGetPreviousParam");
+   pragma Import (C, AddAttribute, "LLVMAddAttribute");
+   pragma Import (C, RemoveAttribute, "LLVMRemoveAttribute");
+   pragma Import (C, SetParamAlignment, "LLVMSetParamAlignment");
+
+   pragma Import (C, MDStringInContext, "LLVMMDStringInContext");
+   pragma Import (C, MDString, "LLVMMDString");
+   pragma Import (C, MDNodeInContext, "LLVMMDNodeInContext");
+   pragma Import (C, MDNode, "LLVMMDNode");
+   pragma Import (C, GetMDString, "LLVMGetMDString");
+   pragma Import (C, GetMDNodeNumOperands, "LLVMGetMDNodeNumOperands");
+   pragma Import (C, GetMDNodeOperands, "LLVMGetMDNodeOperands");
+   pragma Import (C, MDNodeReplaceOperandWith,
+                  "LLVMMDNodeReplaceOperandWith_extra");
+
+   pragma Import (C, BasicBlockAsValue, "LLVMBasicBlockAsValue");
+   pragma Import (C, ValueIsBasicBlock, "LLVMValueIsBasicBlock");
+   pragma Import (C, ValueAsBasicBlock, "LLVMValueAsBasicBlock");
+   pragma Import (C, GetBasicBlockParent, "LLVMGetBasicBlockParent");
+   pragma Import (C, CountBasicBlocks, "LLVMCountBasicBlocks");
+   pragma Import (C, GetBasicBlocks, "LLVMGetBasicBlocks");
+   pragma Import (C, GetFirstBasicBlock, "LLVMGetFirstBasicBlock");
+   pragma Import (C, GetLastBasicBlock, "LLVMGetLastBasicBlock");
+   pragma Import (C, GetNextBasicBlock, "LLVMGetNextBasicBlock");
+   pragma Import (C, GetPreviousBasicBlock, "LLVMGetPreviousBasicBlock");
+   pragma Import (C, GetEntryBasicBlock, "LLVMGetEntryBasicBlock");
+   pragma Import (C, AppendBasicBlock, "LLVMAppendBasicBlock");
+   pragma Import (C, InsertBasicBlock, "LLVMInsertBasicBlock");
+   pragma Import (C, DeleteBasicBlock, "LLVMDeleteBasicBlock");
+
+   pragma Import (C, HasMetadata, "LLVMHasMetadata");
+   pragma Import (C, GetMetadata, "LLVMGetMetadata");
+   pragma Import (C, SetMetadata, "LLVMSetMetadata");
+
+   pragma Import (C, GetInstructionParent, "LLVMGetInstructionParent");
+   pragma Import (C, GetFirstInstruction, "LLVMGetFirstInstruction");
+   pragma Import (C, GetLastInstruction, "LLVMGetLastInstruction");
+   pragma Import (C, GetNextInstruction, "LLVMGetNextInstruction");
+   pragma Import (C, GetPreviousInstruction, "LLVMGetPreviousInstruction");
+
+   pragma Import (C, SetInstructionCallConv, "LLVMSetInstructionCallConv");
+   pragma Import (C, GetInstructionCallConv, "LLVMGetInstructionCallConv");
+   pragma Import (C, AddInstrAttribute, "LLVMAddInstrAttribute");
+   pragma Import (C, RemoveInstrAttribute, "LLVMRemoveInstrAttribute");
+   pragma Import (C, SetInstrParamAlignment, "LLVMSetInstrParamAlignment");
+
+   pragma Import (C, IsTailCall, "LLVMIsTailCall");
+   pragma Import (C, SetTailCall, "LLVMSetTailCall");
+
+   pragma Import (C, AddIncoming, "LLVMAddIncoming");
+   pragma Import (C, CountIncoming, "LLVMCountIncoming");
+   pragma Import (C, GetIncomingValue, "LLVMGetIncomingValue");
+   pragma Import (C, GetIncomingBlock, "LLVMGetIncomingBlock");
+
+   pragma Import (C, CreateBuilder, "LLVMCreateBuilder");
+   pragma Import (C, PositionBuilder, "LLVMPositionBuilder");
+   pragma Import (C, PositionBuilderBefore, "LLVMPositionBuilderBefore");
+   pragma Import (C, PositionBuilderAtEnd, "LLVMPositionBuilderAtEnd");
+   pragma Import (C, GetInsertBlock, "LLVMGetInsertBlock");
+   pragma Import (C, DisposeBuilder, "LLVMDisposeBuilder");
+
+   -- Terminators
+   pragma Import (C, BuildRetVoid, "LLVMBuildRetVoid");
+   pragma Import (C, BuildRet, "LLVMBuildRet");
+   pragma Import (C, BuildBr, "LLVMBuildBr");
+   pragma Import (C, BuildCondBr, "LLVMBuildCondBr");
+   pragma Import (C, BuildSwitch, "LLVMBuildSwitch");
+   pragma Import (C, BuildInvoke, "LLVMBuildInvoke");
+   pragma Import (C, BuildUnwind, "LLVMBuildUnwind");
+   pragma Import (C, BuildUnreachable, "LLVMBuildUnreachable");
+
+   -- Add a case to the switch instruction
+   pragma Import (C, AddCase, "LLVMAddCase");
+
+   -- Arithmetic
+   pragma Import (C, BuildAdd, "LLVMBuildAdd");
+   pragma Import (C, BuildNSWAdd, "LLVMBuildNSWAdd");
+   pragma Import (C, BuildNUWAdd, "LLVMBuildNUWAdd");
+   pragma Import (C, BuildFAdd, "LLVMBuildFAdd");
+   pragma Import (C, BuildSub, "LLVMBuildSub");
+   pragma Import (C, BuildNSWSub, "LLVMBuildNSWSub");
+   pragma Import (C, BuildNUWSub, "LLVMBuildNUWSub");
+   pragma Import (C, BuildFSub, "LLVMBuildFSub");
+   pragma Import (C, BuildMul, "LLVMBuildMul");
+   pragma Import (C, BuildFMul, "LLVMBuildFMul");
+   pragma Import (C, BuildUDiv, "LLVMBuildUDiv");
+   pragma Import (C, BuildSDiv, "LLVMBuildSDiv");
+   pragma Import (C, BuildFDiv, "LLVMBuildFDiv");
+   pragma Import (C, BuildURem, "LLVMBuildURem");
+   pragma Import (C, BuildSRem, "LLVMBuildSRem");
+   pragma Import (C, BuildFRem, "LLVMBuildFRem");
+   pragma Import (C, BuildShl, "LLVMBuildShl");
+   pragma Import (C, BuildLShr, "LLVMBuildLShr");
+   pragma Import (C, BuildAShr, "LLVMBuildAShr");
+   pragma Import (C, BuildAnd, "LLVMBuildAnd");
+   pragma Import (C, BuildOr, "LLVMBuildOr");
+   pragma Import (C, BuildXor, "LLVMBuildXor");
+   pragma Import (C, BuildNeg, "LLVMBuildNeg");
+   pragma Import (C, BuildFNeg, "LLVMBuildFNeg");
+   pragma Import (C, BuildNot, "LLVMBuildNot");
+
+   -- Memory
+   pragma Import (C, BuildMalloc, "LLVMBuildMalloc");
+   pragma Import (C, BuildArrayMalloc, "LLVMBuildArrayMalloc");
+   pragma Import (C, BuildAlloca, "LLVMBuildAlloca");
+   pragma Import (C, BuildArrayAlloca, "LLVMBuildArrayAlloca");
+   pragma Import (C, BuildFree, "LLVMBuildFree");
+   pragma Import (C, BuildLoad, "LLVMBuildLoad");
+   pragma Import (C, BuildStore, "LLVMBuildStore");
+   pragma Import (C, BuildGEP, "LLVMBuildGEP");
+
+   -- Casts
+   pragma Import (C, BuildTrunc, "LLVMBuildTrunc");
+   pragma Import (C, BuildZExt, "LLVMBuildZExt");
+   pragma Import (C, BuildSExt, "LLVMBuildSExt");
+   pragma Import (C, BuildFPToUI, "LLVMBuildFPToUI");
+   pragma Import (C, BuildFPToSI, "LLVMBuildFPToSI");
+   pragma Import (C, BuildUIToFP, "LLVMBuildUIToFP");
+   pragma Import (C, BuildSIToFP, "LLVMBuildSIToFP");
+   pragma Import (C, BuildFPTrunc, "LLVMBuildFPTrunc");
+   pragma Import (C, BuildFPExt, "LLVMBuildFPExt");
+   pragma Import (C, BuildPtrToInt, "LLVMBuildPtrToInt");
+   pragma Import (C, BuildIntToPtr, "LLVMBuildIntToPtr");
+   pragma Import (C, BuildBitCast, "LLVMBuildBitCast");
+
+   -- Comparisons
+   pragma Import (C, BuildICmp, "LLVMBuildICmp");
+   pragma Import (C, BuildFCmp, "LLVMBuildFCmp");
+
+   -- Miscellaneous instructions
+   pragma Import (C, BuildPhi, "LLVMBuildPhi");
+   pragma Import (C, BuildCall, "LLVMBuildCall");
+   pragma Import (C, BuildSelect, "LLVMBuildSelect");
+   pragma Import (C, BuildVAArg, "LLVMBuildVAArg");
+   pragma Import (C, BuildExtractElement, "LLVMBuildExtractElement");
+   pragma Import (C, BuildInsertElement, "LLVMBuildInsertElement");
+   pragma Import (C, BuildShuffleVector, "LLVMBuildShuffleVector");
+
+   -- Memory buffers ----------------------------------------------------
+   pragma Import (C, CreateMemoryBufferWithContentsOfFile,
+                  "LLVMCreateMemoryBufferWithContentsOfFile");
+   pragma Import (C, CreateMemoryBufferWithSTDIN,
+                  "LLVMCreateMemoryBufferWithSTDIN");
+   pragma Import (C, DisposeMemoryBuffer, "LLVMDisposeMemoryBuffer");
+
+   -- Pass Managers -----------------------------------------------------
+   pragma Import (C, CreatePassManager, "LLVMCreatePassManager");
+   pragma Import (C, CreateFunctionPassManagerForModule,
+                  "LLVMCreateFunctionPassManagerForModule");
+   pragma Import (C, RunPassManager, "LLVMRunPassManager");
+   pragma Import (C, InitializeFunctionPassManager,
+                  "LLVMInitializeFunctionPassManager");
+   pragma Import (C, RunFunctionPassManager,
+                  "LLVMRunFunctionPassManager");
+   pragma Import (C, FinalizeFunctionPassManager,
+                  "LLVMFinalizeFunctionPassManager");
+   pragma Import (C, DisposePassManager, "LLVMDisposePassManager");
+
+end LLVM.Core;
diff --git a/src/ortho/llvm/llvm-executionengine.ads b/src/ortho/llvm/llvm-executionengine.ads
new file mode 100644
index 000000000..72d4cda2f
--- /dev/null
+++ b/src/ortho/llvm/llvm-executionengine.ads
@@ -0,0 +1,163 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System; use System;
+with Interfaces; use Interfaces;
+with Interfaces.C; use Interfaces.C;
+with LLVM.Core; use LLVM.Core;
+with LLVM.Target; use LLVM.Target;
+
+package LLVM.ExecutionEngine is
+   type GenericValueRef is new Address;
+   type GenericValueRefArray is array (unsigned range <>) of GenericValueRef;
+   pragma Convention (C, GenericValueRefArray);
+   type ExecutionEngineRef is new Address;
+
+   procedure LinkInJIT;
+   procedure LinkInMCJIT;
+   procedure LinkInInterpreter;
+
+   -- Operations on generic values --------------------------------------
+
+   function CreateGenericValueOfInt(Ty : TypeRef;
+                                    N : Unsigned_64;
+                                    IsSigned : Integer)
+                                   return GenericValueRef;
+
+   function CreateGenericValueOfPointer(P : System.Address)
+                                           return GenericValueRef;
+
+   function CreateGenericValueOfFloat(Ty : TypeRef; N : double)
+                                         return GenericValueRef;
+
+   function GenericValueIntWidth(GenValRef : GenericValueRef)
+                                    return unsigned;
+
+   function GenericValueToInt(GenVal : GenericValueRef;
+                                  IsSigned : Integer) return Unsigned_64;
+
+   function GenericValueToPointer(GenVal : GenericValueRef)
+                                     return System.Address;
+
+   function GenericValueToFloat(TyRef : TypeRef; GenVal : GenericValueRef)
+                               return double;
+
+   procedure DisposeGenericValue(GenVal : GenericValueRef);
+
+   -- Operations on execution engines -----------------------------------
+
+   function CreateExecutionEngineForModule
+     (EE : access ExecutionEngineRef; M : ModuleRef; Error : access Cstring)
+     return Bool;
+
+   function CreateInterpreterForModule (Interp : access ExecutionEngineRef;
+                                        M : ModuleRef;
+                                        Error : access Cstring)
+                                       return Bool;
+
+   function CreateJITCompilerForModule (JIT : access ExecutionEngineRef;
+                                        M : ModuleRef;
+                                        OptLevel : unsigned;
+                                        Error : access Cstring)
+     return Bool;
+
+
+   procedure DisposeExecutionEngine(EE : ExecutionEngineRef);
+
+   procedure RunStaticConstructors(EE : ExecutionEngineRef);
+
+   procedure RunStaticDestructors(EE : ExecutionEngineRef);
+
+   function RunFunctionAsMain(EE : ExecutionEngineRef;
+                              F : ValueRef;
+                              ArgC : unsigned; Argv : Address; EnvP : Address)
+                             return Integer;
+
+   function RunFunction(EE : ExecutionEngineRef;
+                        F : ValueRef;
+                        NumArgs : unsigned;
+                        Args : GenericValueRefArray)
+                       return GenericValueRef;
+
+   procedure FreeMachineCodeForFunction(EE : ExecutionEngineRef; F : ValueRef);
+
+   procedure AddModule(EE : ExecutionEngineRef; M : ModuleRef);
+
+   function RemoveModule(EE : ExecutionEngineRef;
+                         M : ModuleRef;
+                         OutMod : access ModuleRef;
+                         OutError : access Cstring) return Bool;
+
+   function FindFunction(EE : ExecutionEngineRef; Name : Cstring;
+                                                  OutFn : access ValueRef)
+                        return Integer;
+
+   function GetExecutionEngineTargetData(EE : ExecutionEngineRef)
+                                        return TargetDataRef;
+
+   procedure AddGlobalMapping(EE : ExecutionEngineRef; Global : ValueRef;
+                                                       Addr : Address);
+
+   function GetPointerToGlobal (EE : ExecutionEngineRef; GV : ValueRef)
+                               return Address;
+   function GetPointerToFunctionOrStub (EE : ExecutionEngineRef;
+                                        Func : ValueRef)
+                                       return Address;
+
+private
+   pragma Import (C, LinkInJIT, "LLVMLinkInJIT");
+   pragma Import (C, LinkInMCJIT, "LLVMLinkInMCJIT");
+   pragma Import (C, LinkInInterpreter, "LLVMLinkInInterpreter");
+
+   pragma Import (C, CreateGenericValueOfInt, "LLVMCreateGenericValueOfInt");
+   pragma Import (C, CreateGenericValueOfPointer,
+                  "LLVMCreateGenericValueOfPointer");
+   pragma Import (C, CreateGenericValueOfFloat,
+                  "LLVMCreateGenericValueOfFloat");
+   pragma Import (C, GenericValueIntWidth, "LLVMGenericValueIntWidth");
+   pragma Import (C, GenericValueToInt, "LLVMGenericValueToInt");
+   pragma Import (C, GenericValueToPointer, "LLVMGenericValueToPointer");
+   pragma Import (C, GenericValueToFloat, "LLVMGenericValueToFloat");
+   pragma Import (C, DisposeGenericValue, "LLVMDisposeGenericValue");
+
+   -- Operations on execution engines -----------------------------------
+
+   pragma Import (C, CreateExecutionEngineForModule,
+                  "LLVMCreateExecutionEngineForModule");
+   pragma Import (C, CreateInterpreterForModule,
+                  "LLVMCreateInterpreterForModule");
+   pragma Import (C, CreateJITCompilerForModule,
+                  "LLVMCreateJITCompilerForModule");
+   pragma Import (C, DisposeExecutionEngine, "LLVMDisposeExecutionEngine");
+   pragma Import (C, RunStaticConstructors, "LLVMRunStaticConstructors");
+   pragma Import (C, RunStaticDestructors, "LLVMRunStaticDestructors");
+   pragma Import (C, RunFunctionAsMain, "LLVMRunFunctionAsMain");
+   pragma Import (C, RunFunction, "LLVMRunFunction");
+   pragma Import (C, FreeMachineCodeForFunction,
+                  "LLVMFreeMachineCodeForFunction");
+   pragma Import (C, AddModule, "LLVMAddModule");
+   pragma Import (C, RemoveModule, "LLVMRemoveModule");
+   pragma Import (C, FindFunction, "LLVMFindFunction");
+   pragma Import (C, GetExecutionEngineTargetData,
+                "LLVMGetExecutionEngineTargetData");
+   pragma Import (C, AddGlobalMapping, "LLVMAddGlobalMapping");
+
+   pragma Import (C, GetPointerToFunctionOrStub,
+                  "LLVMGetPointerToFunctionOrStub");
+   pragma Import (C, GetPointerToGlobal,
+                  "LLVMGetPointerToGlobal");
+end LLVM.ExecutionEngine;
diff --git a/src/ortho/llvm/llvm-target.ads b/src/ortho/llvm/llvm-target.ads
new file mode 100644
index 000000000..b7c35848a
--- /dev/null
+++ b/src/ortho/llvm/llvm-target.ads
@@ -0,0 +1,84 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Interfaces; use Interfaces;
+with Interfaces.C; use Interfaces.C;
+with LLVM.Core; use LLVM.Core;
+
+package LLVM.Target is
+
+   type TargetDataRef is new System.Address;
+
+   --  LLVMInitializeNativeTarget - The main program should call this function
+   --  to initialize the native target corresponding to the host.  This is
+   --  useful for JIT applications to ensure that the target gets linked in
+   --  correctly.
+   procedure InitializeNativeTarget;
+   pragma Import (C, InitializeNativeTarget,
+                  "LLVMInitializeNativeTarget_noinline");
+
+   --  LLVMInitializeNativeTargetAsmPrinter - The main program should call this
+   --  function to initialize the printer for the native target corresponding
+   --  to the host.
+   procedure InitializeNativeAsmPrinter;
+   pragma Import (C, InitializeNativeAsmPrinter,
+                  "LLVMInitializeNativeAsmPrinter_noinline");
+
+   --  Creates target data from a target layout string.
+   --  See the constructor llvm::DataLayout::DataLayout.
+   function CreateTargetData (StringRep : Cstring) return TargetDataRef;
+   pragma Import (C, CreateTargetData, "LLVMCreateTargetData");
+
+   --  Adds target data information to a pass manager. This does not take
+   --  ownership of the target data.
+   --  See the method llvm::PassManagerBase::add.
+   procedure AddTargetData(TD : TargetDataRef; PM : PassManagerRef);
+   pragma Import (C, AddTargetData, "LLVMAddTargetData");
+
+   --  Converts target data to a target layout string. The string must be
+   --  disposed with LLVMDisposeMessage.
+   --  See the constructor llvm::DataLayout::DataLayout. */
+   function CopyStringRepOfTargetData(TD :TargetDataRef) return Cstring;
+   pragma Import (C, CopyStringRepOfTargetData,
+                  "LLVMCopyStringRepOfTargetData");
+
+   --  Returns the pointer size in bytes for a target.
+   --  See the method llvm::DataLayout::getPointerSize.
+   function PointerSize(TD : TargetDataRef) return unsigned;
+   pragma Import (C, PointerSize, "LLVMPointerSize");
+
+   --  Computes the ABI size of a type in bytes for a target.
+   --  See the method llvm::DataLayout::getTypeAllocSize.
+   function ABISizeOfType (TD : TargetDataRef; Ty: TypeRef) return Unsigned_64;
+   pragma Import (C, ABISizeOfType, "LLVMABISizeOfType");
+
+   --  Computes the ABI alignment of a type in bytes for a target.
+   --  See the method llvm::DataLayout::getTypeABISize.
+   function ABIAlignmentOfType (TD : TargetDataRef; Ty: TypeRef)
+                               return Unsigned_32;
+   pragma Import (C, ABIAlignmentOfType, "LLVMABIAlignmentOfType");
+
+   --  Computes the byte offset of the indexed struct element for a target.
+   --  See the method llvm::StructLayout::getElementContainingOffset.
+   function OffsetOfElement(TD : TargetDataRef;
+                            StructTy : TypeRef;
+                            Element : Unsigned_32)
+                           return Unsigned_64;
+   pragma Import (C, OffsetOfElement, "LLVMOffsetOfElement");
+
+end LLVM.Target;
diff --git a/src/ortho/llvm/llvm-targetmachine.ads b/src/ortho/llvm/llvm-targetmachine.ads
new file mode 100644
index 000000000..cbf074940
--- /dev/null
+++ b/src/ortho/llvm/llvm-targetmachine.ads
@@ -0,0 +1,122 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with LLVM.Core; use LLVM.Core;
+with LLVM.Target; use LLVM.Target;
+
+package LLVM.TargetMachine is
+
+   type TargetMachineRef is new System.Address;
+   Null_TargetMachineRef : constant TargetMachineRef :=
+     TargetMachineRef (System.Null_Address);
+
+   type TargetRef is new System.Address;
+   Null_TargetRef : constant TargetRef := TargetRef (System.Null_Address);
+
+   type CodeGenOptLevel is (CodeGenLevelNone,
+                            CodeGenLevelLess,
+                            CodeGenLevelDefault,
+                            CodeGenLevelAggressive);
+   pragma Convention (C, CodeGenOptLevel);
+
+   type RelocMode is (RelocDefault,
+                      RelocStatic,
+                      RelocPIC,
+                      RelocDynamicNoPic);
+   pragma Convention (C, RelocMode);
+
+   type CodeModel is (CodeModelDefault,
+                      CodeModelJITDefault,
+                      CodeModelSmall,
+                      CodeModelKernel,
+                      CodeModelMedium,
+                      CodeModelLarge);
+   pragma Convention (C, CodeModel);
+
+   type CodeGenFileType is (AssemblyFile,
+                            ObjectFile);
+   pragma Convention (C, CodeGenFileType);
+
+   --  Returns the first llvm::Target in the registered targets list.
+   function GetFirstTarget return TargetRef;
+   pragma Import (C, GetFirstTarget, "LLVMGetFirstTarget");
+
+   --  Returns the next llvm::Target given a previous one (or null if there's
+   --  none) */
+   function GetNextTarget(T : TargetRef) return TargetRef;
+   pragma Import (C, GetNextTarget, "LLVMGetNextTarget");
+
+   --  Target
+
+   --  Finds the target corresponding to the given name and stores it in T.
+   --  Returns 0 on success.
+   function GetTargetFromName (Name : Cstring) return TargetRef;
+   pragma Import (C, GetTargetFromName, "LLVMGetTargetFromName");
+
+   --  Finds the target corresponding to the given triple and stores it in T.
+   --  Returns 0 on success. Optionally returns any error in ErrorMessage.
+   --  Use LLVMDisposeMessage to dispose the message.
+   --  Ada: ErrorMessage is the address of a Cstring.
+   function GetTargetFromTriple
+     (Triple : Cstring; T : access TargetRef; ErrorMessage : access Cstring)
+     return Bool;
+   pragma Import (C, GetTargetFromTriple, "LLVMGetTargetFromTriple");
+
+   --  Returns the name of a target. See llvm::Target::getName
+   function GetTargetName (T: TargetRef) return Cstring;
+   pragma Import (C, GetTargetName, "LLVMGetTargetName");
+
+   --  Returns the description  of a target. See llvm::Target::getDescription
+   function GetTargetDescription (T : TargetRef) return Cstring;
+   pragma Import (C, GetTargetDescription, "LLVMGetTargetDescription");
+
+   --  Target Machine ----------------------------------------------------
+
+   --  Creates a new llvm::TargetMachine. See llvm::Target::createTargetMachine
+
+   function CreateTargetMachine(T : TargetRef;
+                                Triple : Cstring;
+                                CPU : Cstring;
+                                Features : Cstring;
+                                Level : CodeGenOptLevel;
+                                Reloc : RelocMode;
+                                CM : CodeModel)
+                               return TargetMachineRef;
+   pragma Import (C, CreateTargetMachine, "LLVMCreateTargetMachine");
+
+   -- Returns the llvm::DataLayout used for this llvm:TargetMachine.
+   function GetTargetMachineData(T : TargetMachineRef) return TargetDataRef;
+   pragma Import (C, GetTargetMachineData, "LLVMGetTargetMachineData");
+
+   --  Emits an asm or object file for the given module to the filename. This
+   --  wraps several c++ only classes (among them a file stream). Returns any
+   --  error in ErrorMessage. Use LLVMDisposeMessage to dispose the message.
+   function TargetMachineEmitToFile(T : TargetMachineRef;
+                                    M : ModuleRef;
+                                    Filename : Cstring;
+                                    Codegen : CodeGenFileType;
+                                    ErrorMessage : access Cstring)
+                                   return Bool;
+   pragma Import (C, TargetMachineEmitToFile,
+                  "LLVMTargetMachineEmitToFile");
+
+   --  Get a triple for the host machine as a string. The result needs to be
+   --  disposed with LLVMDisposeMessage.
+   function GetDefaultTargetTriple return Cstring;
+   pragma Import (C, GetDefaultTargetTriple, "LLVMGetDefaultTargetTriple");
+end LLVM.TargetMachine;
diff --git a/src/ortho/llvm/llvm-transforms-scalar.ads b/src/ortho/llvm/llvm-transforms-scalar.ads
new file mode 100644
index 000000000..0f23ce87e
--- /dev/null
+++ b/src/ortho/llvm/llvm-transforms-scalar.ads
@@ -0,0 +1,169 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with LLVM.Core; use LLVM.Core;
+
+package LLVM.Transforms.Scalar is
+   --  See llvm::createAggressiveDCEPass function.
+   procedure AddAggressiveDCEPass(PM : PassManagerRef);
+   pragma Import (C, AddAggressiveDCEPass, "LLVMAddAggressiveDCEPass");
+
+   --  See llvm::createCFGSimplificationPass function.
+   procedure AddCFGSimplificationPass(PM : PassManagerRef);
+   pragma Import (C, AddCFGSimplificationPass, "LLVMAddCFGSimplificationPass");
+
+   --  See llvm::createDeadStoreEliminationPass function.
+   procedure AddDeadStoreEliminationPass(PM : PassManagerRef);
+   pragma Import (C, AddDeadStoreEliminationPass,
+                  "LLVMAddDeadStoreEliminationPass");
+
+   --  See llvm::createScalarizerPass function.
+   procedure AddScalarizerPass(PM : PassManagerRef);
+   pragma Import (C, AddScalarizerPass, "LLVMAddScalarizerPass");
+
+   --  See llvm::createGVNPass function.
+   procedure AddGVNPass(PM : PassManagerRef);
+   pragma Import (C, AddGVNPass, "LLVMAddGVNPass");
+
+   --  See llvm::createIndVarSimplifyPass function.
+   procedure AddIndVarSimplifyPass(PM : PassManagerRef);
+   pragma Import (C, AddIndVarSimplifyPass, "LLVMAddIndVarSimplifyPass");
+
+   --  See llvm::createInstructionCombiningPass function.
+   procedure AddInstructionCombiningPass(PM : PassManagerRef);
+   pragma Import (C, AddInstructionCombiningPass,
+                  "LLVMAddInstructionCombiningPass");
+
+   --  See llvm::createJumpThreadingPass function.
+   procedure AddJumpThreadingPass(PM : PassManagerRef);
+   pragma Import (C, AddJumpThreadingPass, "LLVMAddJumpThreadingPass");
+
+   --  See llvm::createLICMPass function.
+   procedure AddLICMPass(PM : PassManagerRef);
+   pragma Import (C, AddLICMPass, "LLVMAddLICMPass");
+
+   --  See llvm::createLoopDeletionPass function.
+   procedure AddLoopDeletionPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopDeletionPass, "LLVMAddLoopDeletionPass");
+
+   --  See llvm::createLoopIdiomPass function
+   procedure AddLoopIdiomPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopIdiomPass, "LLVMAddLoopIdiomPass");
+
+   --  See llvm::createLoopRotatePass function.
+   procedure AddLoopRotatePass(PM : PassManagerRef);
+   pragma Import (C, AddLoopRotatePass, "LLVMAddLoopRotatePass");
+
+   --  See llvm::createLoopRerollPass function.
+   procedure AddLoopRerollPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopRerollPass, "LLVMAddLoopRerollPass");
+
+   --  See llvm::createLoopUnrollPass function.
+   procedure AddLoopUnrollPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopUnrollPass, "LLVMAddLoopUnrollPass");
+
+   --  See llvm::createLoopUnswitchPass function.
+   procedure AddLoopUnswitchPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopUnswitchPass, "LLVMAddLoopUnswitchPass");
+
+   --  See llvm::createMemCpyOptPass function.
+   procedure AddMemCpyOptPass(PM : PassManagerRef);
+   pragma Import (C, AddMemCpyOptPass, "LLVMAddMemCpyOptPass");
+
+   --  See llvm::createPartiallyInlineLibCallsPass function.
+   procedure AddPartiallyInlineLibCallsPass(PM : PassManagerRef);
+   pragma Import (C, AddPartiallyInlineLibCallsPass,
+                  "LLVMAddPartiallyInlineLibCallsPass");
+
+   --  See llvm::createPromoteMemoryToRegisterPass function.
+   procedure AddPromoteMemoryToRegisterPass(PM : PassManagerRef);
+   pragma Import (C, AddPromoteMemoryToRegisterPass,
+                  "LLVMAddPromoteMemoryToRegisterPass");
+
+   --  See llvm::createReassociatePass function.
+   procedure AddReassociatePass(PM : PassManagerRef);
+   pragma Import (C, AddReassociatePass, "LLVMAddReassociatePass");
+
+   --  See llvm::createSCCPPass function.
+   procedure AddSCCPPass(PM : PassManagerRef);
+   pragma Import (C, AddSCCPPass, "LLVMAddSCCPPass");
+
+   --  See llvm::createScalarReplAggregatesPass function.
+   procedure AddScalarReplAggregatesPass(PM : PassManagerRef);
+   pragma Import (C, AddScalarReplAggregatesPass,
+                  "LLVMAddScalarReplAggregatesPass");
+
+   --  See llvm::createScalarReplAggregatesPass function.
+   procedure AddScalarReplAggregatesPassSSA(PM : PassManagerRef);
+   pragma Import (C, AddScalarReplAggregatesPassSSA,
+                  "LLVMAddScalarReplAggregatesPassSSA");
+
+   --  See llvm::createScalarReplAggregatesPass function.
+   procedure AddScalarReplAggregatesPassWithThreshold
+     (PM : PassManagerRef; Threshold : Integer);
+   pragma Import (C, AddScalarReplAggregatesPassWithThreshold,
+                  "LLVMAddScalarReplAggregatesPassWithThreshold");
+
+   --  See llvm::createSimplifyLibCallsPass function.
+   procedure AddSimplifyLibCallsPass(PM : PassManagerRef);
+   pragma Import (C, AddSimplifyLibCallsPass, "LLVMAddSimplifyLibCallsPass");
+
+   --  See llvm::createTailCallEliminationPass function.
+   procedure AddTailCallEliminationPass(PM : PassManagerRef);
+   pragma Import (C, AddTailCallEliminationPass,
+                  "LLVMAddTailCallEliminationPass");
+
+   --  See llvm::createConstantPropagationPass function.
+   procedure AddConstantPropagationPass(PM : PassManagerRef);
+   pragma Import (C, AddConstantPropagationPass,
+                  "LLVMAddConstantPropagationPass");
+
+   --  See llvm::demotePromoteMemoryToRegisterPass function.
+   procedure AddDemoteMemoryToRegisterPass(PM : PassManagerRef);
+   pragma Import (C, AddDemoteMemoryToRegisterPass,
+                  "LLVMAddDemoteMemoryToRegisterPass");
+
+   --  See llvm::createVerifierPass function.
+   procedure AddVerifierPass(PM : PassManagerRef);
+   pragma Import (C, AddVerifierPass, "LLVMAddVerifierPass");
+
+   --  See llvm::createCorrelatedValuePropagationPass function
+   procedure AddCorrelatedValuePropagationPass(PM : PassManagerRef);
+   pragma Import (C, AddCorrelatedValuePropagationPass,
+                  "LLVMAddCorrelatedValuePropagationPass");
+
+   --  See llvm::createEarlyCSEPass function
+   procedure AddEarlyCSEPass(PM : PassManagerRef);
+   pragma Import (C, AddEarlyCSEPass, "LLVMAddEarlyCSEPass");
+
+   --  See llvm::createLowerExpectIntrinsicPass function
+   procedure AddLowerExpectIntrinsicPass(PM : PassManagerRef);
+   pragma Import (C, AddLowerExpectIntrinsicPass,
+                  "LLVMAddLowerExpectIntrinsicPass");
+
+   --  See llvm::createTypeBasedAliasAnalysisPass function
+   procedure AddTypeBasedAliasAnalysisPass(PM : PassManagerRef);
+   pragma Import (C, AddTypeBasedAliasAnalysisPass,
+                  "LLVMAddTypeBasedAliasAnalysisPass");
+
+   --  See llvm::createBasicAliasAnalysisPass function
+   procedure AddBasicAliasAnalysisPass(PM : PassManagerRef);
+   pragma Import (C, AddBasicAliasAnalysisPass,
+                  "LLVMAddBasicAliasAnalysisPass");
+end LLVM.Transforms.Scalar;
+
+
diff --git a/src/ortho/llvm/llvm-transforms.ads b/src/ortho/llvm/llvm-transforms.ads
new file mode 100644
index 000000000..d5a8011ce
--- /dev/null
+++ b/src/ortho/llvm/llvm-transforms.ads
@@ -0,0 +1,21 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package LLVM.Transforms is
+   pragma Pure (LLVM.Transforms);
+end LLVM.Transforms;
diff --git a/src/ortho/llvm/llvm.ads b/src/ortho/llvm/llvm.ads
new file mode 100644
index 000000000..80d036b84
--- /dev/null
+++ b/src/ortho/llvm/llvm.ads
@@ -0,0 +1,21 @@
+--  LLVM binding
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package LLVM is
+   pragma Pure (LLVM);
+end LLVM;
diff --git a/src/ortho/llvm/ortho_code_main.adb b/src/ortho/llvm/ortho_code_main.adb
new file mode 100644
index 000000000..300bb32d1
--- /dev/null
+++ b/src/ortho/llvm/ortho_code_main.adb
@@ -0,0 +1,391 @@
+--  LLVM back-end for ortho - Main subprogram.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
+with Ada.Text_IO; use Ada.Text_IO;
+
+with Ortho_Front; use Ortho_Front;
+with LLVM.BitWriter;
+with LLVM.Core; use LLVM.Core;
+with LLVM.ExecutionEngine; use LLVM.ExecutionEngine;
+with LLVM.Target; use LLVM.Target;
+with LLVM.TargetMachine; use LLVM.TargetMachine;
+with LLVM.Analysis;
+with LLVM.Transforms.Scalar;
+with Ortho_LLVM; use Ortho_LLVM;
+with Interfaces;
+with Interfaces.C; use Interfaces.C;
+
+procedure Ortho_Code_Main is
+   --  Name of the output filename (given by option '-o').
+   Output : String_Acc := null;
+
+   type Output_Kind_Type is (Output_Llvm, Output_Bytecode,
+                             Output_Assembly, Output_Object);
+   Output_Kind : Output_Kind_Type := Output_Llvm;
+
+   --  True if the LLVM output must be displayed (set by '--dump-llvm')
+   Flag_Dump_Llvm : Boolean := False;
+
+   --  Index of the first file argument.
+   First_File : Natural;
+
+   --  Set by '--exec': function to call and its argument (an integer)
+   Exec_Func : String_Acc := null;
+   Exec_Val : Integer := 0;
+
+   --  Current option index.
+   Optind : Natural;
+
+   --  Number of arguments.
+   Argc : constant Natural := Argument_Count;
+
+   --  Name of the module.
+   Module_Name : String := "ortho" & Ascii.Nul;
+
+   --  Target triple.
+   Triple : Cstring := Empty_Cstring;
+
+   --  Execution engine
+   Engine : aliased ExecutionEngineRef;
+
+   Target : aliased TargetRef;
+
+   CPU : constant Cstring := Empty_Cstring;
+   Features : constant Cstring := Empty_Cstring;
+   Reloc : constant RelocMode := RelocDefault;
+
+   procedure Dump_Llvm
+   is
+      use LLVM.Analysis;
+      Msg : aliased Cstring;
+   begin
+      DumpModule (Module);
+      if LLVM.Analysis.VerifyModule
+        (Module, PrintMessageAction, Msg'Access) /= 0
+      then
+         null;
+      end if;
+   end Dump_Llvm;
+
+   function To_String (C : Cstring) return String is
+      function Strlen (C : Cstring) return Natural;
+      pragma Import (C, Strlen);
+
+      subtype Fat_String is String (Positive);
+      type Fat_String_Acc is access Fat_String;
+
+      function To_Fat_String_Acc is new
+        Ada.Unchecked_Conversion (Cstring, Fat_String_Acc);
+   begin
+      return To_Fat_String_Acc (C)(1 .. Strlen (C));
+   end To_String;
+
+   Codegen : CodeGenFileType := ObjectFile;
+
+   Msg : aliased Cstring;
+begin
+   Ortho_Front.Init;
+
+   --  Decode options.
+   First_File := Natural'Last;
+   Optind := 1;
+   while Optind <= Argc loop
+      declare
+         Arg : constant String := Argument (Optind);
+      begin
+         if Arg (1) = '-' then
+            if Arg = "--dump-llvm" then
+               Flag_Dump_Llvm := True;
+            elsif Arg = "-o" then
+               if Optind = Argc then
+                  Put_Line (Standard_Error, "error: missing filename to '-o'");
+                  return;
+               end if;
+               Output := new String'(Argument (Optind + 1) & ASCII.Nul);
+               Optind := Optind + 1;
+            elsif Arg = "-quiet" then
+               --  Skip silently.
+               null;
+            elsif Arg = "-S" then
+               Output_Kind := Output_Assembly;
+               Codegen := AssemblyFile;
+            elsif Arg = "-c" then
+               Output_Kind := Output_Object;
+               Codegen := ObjectFile;
+            elsif Arg = "-O0" then
+               Optimization := CodeGenLevelNone;
+            elsif Arg = "-O1" then
+               Optimization := CodeGenLevelLess;
+            elsif Arg = "-O2" then
+               Optimization := CodeGenLevelDefault;
+            elsif Arg = "-O3" then
+               Optimization := CodeGenLevelAggressive;
+            elsif Arg = "--emit-llvm" then
+               Output_Kind := Output_Llvm;
+            elsif Arg = "--emit-bc" then
+               Output_Kind := Output_Bytecode;
+            elsif Arg = "--exec" then
+               if Optind + 1 >= Argc then
+                  Put_Line (Standard_Error,
+                            "error: missing function name to '--exec'");
+                  return;
+               end if;
+               Exec_Func := new String'(Argument (Optind + 1));
+               Exec_Val := Integer'Value (Argument (Optind + 2));
+               Optind := Optind + 2;
+            elsif Arg = "-g" then
+               Flag_Debug := True;
+            else
+               --  This is really an argument.
+               declare
+                  procedure Unchecked_Deallocation is
+                     new Ada.Unchecked_Deallocation
+                    (Name => String_Acc, Object => String);
+
+                  Opt : String_Acc := new String'(Arg);
+                  Opt_Arg : String_Acc;
+                  Res : Natural;
+               begin
+                  if Optind < Argument_Count then
+                     Opt_Arg := new String'(Argument (Optind + 1));
+                  else
+                     Opt_Arg := null;
+                  end if;
+                  Res := Ortho_Front.Decode_Option (Opt, Opt_Arg);
+                  case Res is
+                     when 0 =>
+                        Put_Line (Standard_Error,
+                                  "unknown option '" & Arg & "'");
+                        return;
+                     when 1 =>
+                        null;
+                     when 2 =>
+                        Optind := Optind + 1;
+                     when others =>
+                        raise Program_Error;
+                  end case;
+                  Unchecked_Deallocation (Opt);
+                  Unchecked_Deallocation (Opt_Arg);
+               end;
+            end if;
+         else
+            First_File := Optind;
+            exit;
+         end if;
+      end;
+      Optind := Optind + 1;
+   end loop;
+
+   --  Link with LLVM libraries.
+   InitializeNativeTarget;
+   InitializeNativeAsmPrinter;
+
+   LinkInJIT;
+
+   Module := ModuleCreateWithName (Module_Name'Address);
+
+   if Output = null and then Exec_Func /= null then
+      -- Now we going to create JIT
+      if CreateExecutionEngineForModule
+        (Engine'Access, Module, Msg'Access) /= 0
+      then
+         Put_Line (Standard_Error,
+                   "cannot create execute: " & To_String (Msg));
+         raise Program_Error;
+      end if;
+
+      Target_Data := GetExecutionEngineTargetData (Engine);
+   else
+      --  Extract target triple
+      Triple := GetDefaultTargetTriple;
+      SetTarget (Module, Triple);
+
+      --  Get Target
+      if GetTargetFromTriple (Triple, Target'Access, Msg'Access) /= 0 then
+         raise Program_Error;
+      end if;
+
+      --  Create a target machine
+      Target_Machine := CreateTargetMachine
+        (Target, Triple, CPU, Features, Optimization, Reloc, CodeModelDefault);
+
+      Target_Data := GetTargetMachineData (Target_Machine);
+   end if;
+
+   SetDataLayout (Module, CopyStringRepOfTargetData (Target_Data));
+
+   if False then
+      declare
+         Targ : TargetRef;
+      begin
+         Put_Line ("Triple: " & To_String (Triple));
+         New_Line;
+         Put_Line ("Targets:");
+         Targ := GetFirstTarget;
+         while Targ /= Null_TargetRef loop
+            Put_Line (" " & To_String (GetTargetName (Targ))
+                        & ": " & To_String (GetTargetDescription (Targ)));
+            Targ := GetNextTarget (Targ);
+         end loop;
+      end;
+      -- Target_Data := CreateTargetData (Triple);
+   end if;
+
+   Ortho_LLVM.Init;
+
+   Set_Exit_Status (Failure);
+
+   if First_File > Argument_Count then
+      begin
+         if not Parse (null) then
+            return;
+         end if;
+      exception
+         when others =>
+            return;
+      end;
+   else
+      for I in First_File .. Argument_Count loop
+         declare
+            Filename : constant String_Acc :=
+              new String'(Argument (First_File));
+         begin
+            if not Parse (Filename) then
+               return;
+            end if;
+         exception
+            when others =>
+               return;
+         end;
+      end loop;
+   end if;
+
+   if Flag_Debug then
+      Ortho_LLVM.Finish_Debug;
+   end if;
+
+   --  Ortho_Mcode.Finish;
+
+   if Flag_Dump_Llvm then
+      Dump_Llvm;
+   end if;
+
+   --  Verify module.
+   if LLVM.Analysis.VerifyModule
+     (Module, LLVM.Analysis.PrintMessageAction, Msg'Access) /= 0
+   then
+      DisposeMessage (Msg);
+      raise Program_Error;
+   end if;
+
+   if Optimization > CodeGenLevelNone then
+      declare
+         use LLVM.Transforms.Scalar;
+         Global_Manager : constant Boolean := False;
+         Pass_Manager : PassManagerRef;
+         Res : Bool;
+         pragma Unreferenced (Res);
+         A_Func : ValueRef;
+      begin
+         if Global_Manager then
+            Pass_Manager := CreatePassManager;
+         else
+            Pass_Manager := CreateFunctionPassManagerForModule (Module);
+         end if;
+
+         LLVM.Target.AddTargetData (Target_Data, Pass_Manager);
+         AddPromoteMemoryToRegisterPass (Pass_Manager);
+         AddCFGSimplificationPass (Pass_Manager);
+
+         if Global_Manager then
+            Res := RunPassManager (Pass_Manager, Module);
+         else
+            A_Func := GetFirstFunction (Module);
+            while A_Func /= Null_ValueRef loop
+               Res := RunFunctionPassManager (Pass_Manager, A_Func);
+               A_Func := GetNextFunction (A_Func);
+            end loop;
+         end if;
+      end;
+   end if;
+
+   if Output /= null then
+      declare
+         Error : Boolean;
+      begin
+         Msg := Empty_Cstring;
+
+         case Output_Kind is
+            when Output_Assembly
+              | Output_Object =>
+               Error := LLVM.TargetMachine.TargetMachineEmitToFile
+                 (Target_Machine, Module,
+                  Output.all'Address, Codegen, Msg'Access) /= 0;
+            when Output_Bytecode =>
+               Error := LLVM.BitWriter.WriteBitcodeToFile
+                 (Module, Output.all'Address) /= 0;
+            when Output_Llvm =>
+               Error := PrintModuleToFile
+                 (Module, Output.all'Address, Msg'Access) /= 0;
+         end case;
+         if Error then
+            Put_Line (Standard_Error,
+                      "error while writing to " & Output.all);
+            if Msg /= Empty_Cstring then
+               Put_Line (Standard_Error,
+                         "message: " & To_String (Msg));
+               DisposeMessage (Msg);
+            end if;
+            Set_Exit_Status (2);
+            return;
+         end if;
+      end;
+   elsif Exec_Func /= null then
+      declare
+         use Interfaces;
+         Res : GenericValueRef;
+         Vals : GenericValueRefArray (0 .. 0);
+         Func : aliased ValueRef;
+      begin
+         if FindFunction (Engine, Exec_Func.all'Address, Func'Access) /= 0 then
+            raise Program_Error;
+         end if;
+
+         -- Call the function with argument n:
+         Vals (0) := CreateGenericValueOfInt
+           (Int32Type, Unsigned_64 (Exec_Val), 0);
+         Res := RunFunction (Engine, Func, 1, Vals);
+
+         -- import result of execution
+         Put_Line ("Result is "
+                     & Unsigned_64'Image (GenericValueToInt (Res, 0)));
+
+      end;
+   else
+      Dump_Llvm;
+   end if;
+
+   Set_Exit_Status (Success);
+exception
+   when others =>
+      Set_Exit_Status (2);
+      raise;
+end Ortho_Code_Main;
diff --git a/src/ortho/llvm/ortho_ident.adb b/src/ortho/llvm/ortho_ident.adb
new file mode 100644
index 000000000..e7b650539
--- /dev/null
+++ b/src/ortho/llvm/ortho_ident.adb
@@ -0,0 +1,134 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Ortho_Ident is
+   type Chunk (Max : Positive);
+   type Chunk_Acc is access Chunk;
+
+   type Chunk (Max : Positive) is record
+      Prev : Chunk_Acc;
+      Len : Natural := 0;
+      S : String (1 .. Max);
+   end record;
+
+   Cur_Chunk : Chunk_Acc := null;
+
+   subtype Fat_String is String (Positive);
+
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Len : constant Natural := Str'Length;
+      Max : Positive;
+      Org : Positive;
+   begin
+      if Cur_Chunk = null or else Cur_Chunk.Len + Len >= Cur_Chunk.Max then
+         if Cur_Chunk = null then
+            Max := 32 * 1024;
+         else
+            Max := 2 * Cur_Chunk.Max;
+         end if;
+         if Len + 2 > Max then
+            Max := 2 * (Len + 2);
+         end if;
+         declare
+            New_Chunk : Chunk_Acc;
+         begin
+            --  Do not use allocator by expression, as we don't want to
+            --  initialize S.
+            New_Chunk := new Chunk (Max);
+            New_Chunk.Len := 0;
+            New_Chunk.Prev := Cur_Chunk;
+            Cur_Chunk := New_Chunk;
+         end;
+      end if;
+
+      Org := Cur_Chunk.Len + 1;
+      Cur_Chunk.S (Org .. Org + Len - 1) := Str;
+      Cur_Chunk.S (Org + Len) := ASCII.NUL;
+      Cur_Chunk.Len := Org + Len;
+
+      return (Addr => Cur_Chunk.S (Org)'Address);
+   end Get_Identifier;
+
+   function Is_Equal (L, R : O_Ident) return Boolean
+   is
+   begin
+      return L = R;
+   end Is_Equal;
+
+   function Get_String_Length (Id : O_Ident) return Natural
+   is
+      Str : Fat_String;
+      pragma Import (Ada, Str);
+      for Str'Address use Id.Addr;
+   begin
+      for I in Str'Range loop
+         if Str (I) = ASCII.NUL then
+            return I - 1;
+         end if;
+      end loop;
+      raise Program_Error;
+   end Get_String_Length;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      Str : Fat_String;
+      pragma Import (Ada, Str);
+      for Str'Address use Id.Addr;
+   begin
+      for I in Str'Range loop
+         if Str (I) = ASCII.NUL then
+            return Str (1 .. I - 1);
+         end if;
+      end loop;
+      raise Program_Error;
+   end Get_String;
+
+   function Get_Cstring (Id : O_Ident) return System.Address is
+   begin
+      return Id.Addr;
+   end Get_Cstring;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean
+   is
+      Istr : Fat_String;
+      pragma Import (Ada, Istr);
+      for Istr'Address use Id.Addr;
+
+      Str_Len : constant Natural := Str'Length;
+   begin
+      for I in Istr'Range loop
+         if Istr (I) = ASCII.NUL then
+            return I - 1 = Str_Len;
+         end if;
+         if I > Str_Len then
+            return False;
+         end if;
+         if Istr (I) /= Str (Str'First + I - 1) then
+            return False;
+         end if;
+      end loop;
+      raise Program_Error;
+   end Is_Equal;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = O_Ident_Nul;
+   end Is_Nul;
+
+end Ortho_Ident;
diff --git a/src/ortho/llvm/ortho_ident.ads b/src/ortho/llvm/ortho_ident.ads
new file mode 100644
index 000000000..7d3955c02
--- /dev/null
+++ b/src/ortho/llvm/ortho_ident.ads
@@ -0,0 +1,42 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+
+package Ortho_Ident is
+   type O_Ident is private;
+
+   function Get_Identifier (Str : String) return O_Ident;
+   function Is_Equal (L, R : O_Ident) return Boolean;
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   function Is_Nul (Id : O_Ident) return Boolean;
+   function Get_String (Id : O_Ident) return String;
+   function Get_String_Length (Id : O_Ident) return Natural;
+
+   --  Note: the address is always valid.
+   function Get_Cstring (Id : O_Ident) return System.Address;
+
+   O_Ident_Nul : constant O_Ident;
+
+private
+   type O_Ident is record
+      Addr : System.Address;
+   end record;
+   O_Ident_Nul : constant O_Ident := (Addr => System.Null_Address);
+
+   pragma Inline (Get_Cstring);
+end Ortho_Ident;
diff --git a/src/ortho/llvm/ortho_jit.adb b/src/ortho/llvm/ortho_jit.adb
new file mode 100644
index 000000000..fdda667d9
--- /dev/null
+++ b/src/ortho/llvm/ortho_jit.adb
@@ -0,0 +1,151 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+--  with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ada.Text_IO; use Ada.Text_IO;
+
+with Ortho_LLVM; use Ortho_LLVM;
+with Ortho_LLVM.Jit;
+
+with LLVM.Core; use LLVM.Core;
+with LLVM.Target; use LLVM.Target;
+--  with LLVM.TargetMachine; use LLVM.TargetMachine;
+with LLVM.ExecutionEngine; use LLVM.ExecutionEngine;
+with LLVM.Analysis;
+--  with Interfaces;
+with Interfaces.C; use Interfaces.C;
+
+package body Ortho_Jit is
+   --  Snap_Filename : GNAT.OS_Lib.String_Access := null;
+
+   Flag_Dump_Llvm : Boolean := False;
+
+   --  Name of the module.
+   Module_Name : String := "ortho" & Ascii.Nul;
+
+   --  procedure DisableLazyCompilation (EE : ExecutionEngineRef;
+   --                                    Disable : int);
+   --  pragma Import (C, DisableLazyCompilation,
+   --        "LLVMDisableLazyCompilation");
+
+   --  Initialize the whole engine.
+   procedure Init
+   is
+      Msg : aliased Cstring;
+   begin
+      InitializeNativeTarget;
+      InitializeNativeAsmPrinter;
+
+      LinkInJIT;
+
+      Module := ModuleCreateWithName (Module_Name'Address);
+
+      -- Now we going to create JIT
+      if CreateExecutionEngineForModule
+        (Ortho_LLVM.Jit.Engine'Access, Module, Msg'Access) /= 0
+      then
+         Put_Line (Standard_Error, "cannot create execution engine");
+         raise Program_Error;
+      end if;
+
+      Target_Data := GetExecutionEngineTargetData (Ortho_LLVM.Jit.Engine);
+      SetDataLayout (Module, CopyStringRepOfTargetData (Target_Data));
+
+      Ortho_LLVM.Init;
+   end Init;
+
+   procedure Set_Address (Decl : O_Dnode; Addr : Address)
+     renames Ortho_LLVM.Jit.Set_Address;
+
+   function Get_Address (Decl : O_Dnode) return Address
+     renames Ortho_LLVM.Jit.Get_Address;
+
+   --  procedure InstallLazyFunctionCreator (EE : ExecutionEngineRef;
+   --                                        Func : Address);
+   --  pragma Import (C, InstallLazyFunctionCreator,
+   --                 "LLVMInstallLazyFunctionCreator");
+
+   --  Do link.
+   procedure Link (Status : out Boolean)
+   is
+      use LLVM.Analysis;
+      Msg : aliased Cstring;
+   begin
+      if Flag_Debug then
+         Ortho_LLVM.Finish_Debug;
+      end if;
+
+      if Flag_Dump_Llvm then
+         DumpModule (Module);
+      end if;
+
+      --  Verify module.
+      if LLVM.Analysis.VerifyModule
+        (Module, LLVM.Analysis.PrintMessageAction, Msg'Access) /= 0
+      then
+         DisposeMessage (Msg);
+         Status := False;
+         return;
+      end if;
+
+      --  FIXME: optim
+   end Link;
+
+   procedure Finish
+   is
+      --  F : ValueRef;
+      --  Addr : Address;
+      --  pragma Unreferenced (Addr);
+   begin
+      null;
+
+      --  if No_Lazy then
+      --     --  Be sure all functions code has been generated.
+      --     F := GetFirstFunction (Module);
+      --     while F /= Null_ValueRef loop
+      --        if GetFirstBasicBlock (F) /= Null_BasicBlockRef then
+      --           --  Only care about defined functions.
+      --           Addr := GetPointerToFunction (EE, F);
+      --        end if;
+      --        F := GetNextFunction (F);
+      --     end loop;
+      --  end if;
+   end Finish;
+
+   function Decode_Option (Option : String) return Boolean
+   is
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      if Opt = "--llvm-dump" then
+         Flag_Dump_Llvm := True;
+         return True;
+      end if;
+      return False;
+   end Decode_Option;
+
+   procedure Disp_Help is
+   begin
+      null;
+   end Disp_Help;
+
+   function Get_Jit_Name return String is
+   begin
+      return "LLVM";
+   end Get_Jit_Name;
+
+end Ortho_Jit;
diff --git a/src/ortho/llvm/ortho_llvm-jit.adb b/src/ortho/llvm/ortho_llvm-jit.adb
new file mode 100644
index 000000000..9155a02c7
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm-jit.adb
@@ -0,0 +1,55 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Ortho_LLVM.Jit is
+   --  procedure AddExternalFunction (Name : Cstring; Val : Address);
+   --  pragma Import (C, AddExternalFunction, "ortho_AddExternalFunction");
+
+   function GetPointerToFunction (EE : ExecutionEngineRef; Func : ValueRef)
+                                 return Address;
+   pragma Import (C, GetPointerToFunction, "LLVMGetPointerToFunction");
+
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address) is
+   begin
+      case Decl.Kind is
+         when ON_Var_Decl | ON_Const_Decl =>
+            AddGlobalMapping (Engine, Decl.LLVM, Addr);
+         when ON_Subprg_Decl =>
+            null;
+            --  AddExternalFunction (GetValueName (Decl.LLVM), Addr);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Set_Address;
+
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address
+   is
+   begin
+      case Decl.Kind is
+         when ON_Var_Decl | ON_Const_Decl =>
+            return GetPointerToGlobal (Engine, Decl.LLVM);
+         when ON_Subprg_Decl =>
+            return GetPointerToFunction (Engine, Decl.LLVM);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Get_Address;
+
+end Ortho_LLVM.Jit;
diff --git a/src/ortho/llvm/ortho_llvm-jit.ads b/src/ortho/llvm/ortho_llvm-jit.ads
new file mode 100644
index 000000000..5296e2ed8
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm-jit.ads
@@ -0,0 +1,31 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with System; use System;
+with LLVM.ExecutionEngine; use LLVM.ExecutionEngine;
+
+package Ortho_LLVM.Jit is
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address);
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address;
+
+   --  Execution engine
+   Engine : aliased ExecutionEngineRef;
+
+end Ortho_LLVM.Jit;
diff --git a/src/ortho/llvm/ortho_llvm.adb b/src/ortho/llvm/ortho_llvm.adb
new file mode 100644
index 000000000..dd8e64971
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm.adb
@@ -0,0 +1,2881 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with LLVM.Target; use LLVM.Target;
+with GNAT.Directory_Operations;
+
+package body Ortho_LLVM is
+   --  The current function for LLVM (needed to add new basic blocks).
+   Cur_Func : ValueRef;
+
+   --  The current function node (needed for return type).
+   Cur_Func_Decl : O_Dnode;
+
+   --  Wether the code is currently unreachable.  LLVM doesn't accept basic
+   --  blocks that cannot be reached (using trivial rules).  So we need to
+   --  discard instructions after a return, a next or an exit statement.
+   Unreach : Boolean;
+
+   --  Builder for statements.
+   Builder : BuilderRef;
+
+   --  Builder for declarations (local variables).
+   Decl_Builder : BuilderRef;
+
+   --  Temporary builder.
+   Extra_Builder : BuilderRef;
+
+   --  Declaration of llvm.dbg.declare
+   Llvm_Dbg_Declare : ValueRef;
+
+   Debug_ID : unsigned;
+
+   Current_Directory : constant String :=
+     GNAT.Directory_Operations.Get_Current_Dir;
+
+   --  Additional data for declare blocks.
+   type Declare_Block_Type;
+   type Declare_Block_Acc is access Declare_Block_Type;
+
+   type Declare_Block_Type is record
+      --  First basic block of the declare.
+      Stmt_Bb : BasicBlockRef;
+
+      --  Stack pointer at entry of the block.  This value has to be restore
+      --  when leaving the block (either normally or via exit/next).  Set only
+      --  if New_Alloca was used.
+      --  FIXME: TODO: restore stack pointer on exit/next stmts.
+      Stack_Value : ValueRef;
+
+      --  Debug data for the scope of the declare block.
+      Dbg_Scope : ValueRef;
+
+      --  Previous element in the stack.
+      Prev : Declare_Block_Acc;
+   end record;
+
+   --  Current declare block.
+   Cur_Declare_Block : Declare_Block_Acc;
+
+   --  Chain of unused blocks to be recycled.
+   Old_Declare_Block : Declare_Block_Acc;
+
+   Stacksave_Fun : ValueRef;
+   Stacksave_Name : constant String := "llvm.stacksave" & ASCII.NUL;
+   Stackrestore_Fun : ValueRef;
+   Stackrestore_Name : constant String := "llvm.stackrestore" & ASCII.NUL;
+
+   --  For debugging
+
+   DW_Version : constant := 16#c_0000#;
+   DW_TAG_Array_Type       : constant := DW_Version + 16#01#;
+   DW_TAG_Enumeration_Type : constant := DW_Version + 16#04#;
+   DW_TAG_Lexical_Block    : constant := DW_Version + 16#0b#;
+   DW_TAG_Member           : constant := DW_Version + 16#0d#;
+   DW_TAG_Pointer_Type     : constant := DW_Version + 16#0f#;
+   DW_TAG_Compile_Unit     : constant := DW_Version + 16#11#;
+   DW_TAG_Structure_Type   : constant := DW_Version + 16#13#;
+   DW_TAG_Subroutine_Type  : constant := DW_Version + 16#15#;
+   DW_TAG_Subrange_Type    : constant := DW_Version + 16#21#;
+   DW_TAG_Base_Type        : constant := DW_Version + 16#24#;
+   DW_TAG_Enumerator       : constant := DW_Version + 16#28#;
+   DW_TAG_File_Type        : constant := DW_Version + 16#29#;
+   DW_TAG_Subprogram       : constant := DW_Version + 16#2e#;
+   DW_TAG_Variable         : constant := DW_Version + 16#34#;
+
+   DW_TAG_Auto_Variable    : constant := DW_Version + 16#100#;
+   DW_TAG_Arg_Variable     : constant := DW_Version + 16#101#;
+
+   DW_ATE_address  : constant := 16#01#;
+   DW_ATE_boolean  : constant := 16#02#;
+   DW_ATE_float    : constant := 16#04#;
+   DW_ATE_signed   : constant := 16#05#;
+   DW_ATE_unsigned : constant := 16#07#;
+   pragma Unreferenced (DW_ATE_address, DW_ATE_boolean);
+
+   --  File + Dir metadata
+   Dbg_Current_Filedir : ValueRef;
+   Dbg_Current_File : ValueRef; -- The DW_TAG_File_Type
+
+   Dbg_Current_Line : unsigned := 0;
+
+   Dbg_Current_Scope : ValueRef;
+   Scope_Uniq_Id : Unsigned_64 := 0;
+
+   --  Metadata for the instruction
+   Dbg_Insn_MD : ValueRef;
+   Dbg_Insn_MD_Line : unsigned := 0;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (ValueRefArray, ValueRefArray_Acc);
+
+   package Dbg_Utils is
+      type Dyn_MDNode is private;
+
+      procedure Append (D : in out Dyn_MDNode; Val : ValueRef);
+      function Get_Value (D : Dyn_MDNode) return ValueRef;
+
+      --  Reset D.  FIXME: should be done automatically within Get_Value.
+      procedure Clear (D : out Dyn_MDNode);
+   private
+      Chunk_Length : constant unsigned := 32;
+      type MD_Chunk;
+      type MD_Chunk_Acc is access MD_Chunk;
+
+      type MD_Chunk is record
+         Vals : ValueRefArray (1 .. Chunk_Length);
+         Next : MD_Chunk_Acc;
+      end record;
+
+      type Dyn_MDNode is record
+         First : MD_Chunk_Acc;
+         Last : MD_Chunk_Acc;
+         Nbr : unsigned := 0;
+      end record;
+   end Dbg_Utils;
+
+   package body Dbg_Utils is
+      procedure Append (D : in out Dyn_MDNode; Val : ValueRef) is
+         Chunk : MD_Chunk_Acc;
+         Pos : constant unsigned := D.Nbr rem Chunk_Length;
+      begin
+         if Pos = 0 then
+            Chunk := new MD_Chunk;
+            if D.First = null then
+               D.First := Chunk;
+            else
+               D.Last.Next := Chunk;
+            end if;
+            D.Last := Chunk;
+         else
+            Chunk := D.Last;
+         end if;
+         Chunk.Vals (Pos + 1) := Val;
+         D.Nbr := D.Nbr + 1;
+      end Append;
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (MD_Chunk, MD_Chunk_Acc);
+
+      function Get_Value (D : Dyn_MDNode) return ValueRef
+      is
+         Vals : ValueRefArray (1 .. D.Nbr);
+         Pos : unsigned;
+         Chunk : MD_Chunk_Acc := D.First;
+         Next_Chunk : MD_Chunk_Acc;
+         Nbr : constant unsigned := D.Nbr;
+      begin
+         Pos := 0;
+         --  Copy by chunks
+         while Pos + Chunk_Length < Nbr loop
+            Vals (Pos + 1 .. Pos + Chunk_Length) := Chunk.Vals;
+            Pos := Pos + Chunk_Length;
+            Next_Chunk := Chunk.Next;
+            Free (Chunk);
+            Chunk := Next_Chunk;
+         end loop;
+         --  Last chunk
+         if Pos < Nbr then
+            Vals (Pos + 1 .. Pos + Nbr - Pos) := Chunk.Vals (1 .. Nbr - Pos);
+            Free (Chunk);
+         end if;
+         return MDNode (Vals, Vals'Length);
+      end Get_Value;
+
+      procedure Clear (D : out Dyn_MDNode) is
+      begin
+         D := (null, null, 0);
+      end Clear;
+   end Dbg_Utils;
+
+   use Dbg_Utils;
+
+   --  List of debug info for subprograms.
+   Subprg_Nodes: Dyn_MDNode;
+
+   --  List of literals for enumerated type
+   Enum_Nodes : Dyn_MDNode;
+
+   --  List of global variables
+   Global_Nodes : Dyn_MDNode;
+
+   --  Create a MDString from an Ada string.
+   function MDString (Str : String) return ValueRef is
+   begin
+      return MDString (Str'Address, Str'Length);
+   end MDString;
+
+   function MDString (Id : O_Ident) return ValueRef is
+   begin
+      return MDString (Get_Cstring (Id), unsigned (Get_String_Length (Id)));
+   end MDString;
+
+   function Dbg_Size (Atype : TypeRef) return ValueRef is
+   begin
+      return ConstInt (Int64Type, 8 * ABISizeOfType (Target_Data, Atype), 0);
+   end Dbg_Size;
+
+   function Dbg_Align (Atype : TypeRef) return ValueRef is
+   begin
+      return ConstInt
+        (Int64Type,
+         Unsigned_64 (8 * ABIAlignmentOfType (Target_Data, Atype)), 0);
+   end Dbg_Align;
+
+   function Dbg_Line return ValueRef is
+   begin
+      return ConstInt (Int32Type, Unsigned_64 (Dbg_Current_Line), 0);
+   end Dbg_Line;
+
+   --  Set debug metadata on instruction INSN.
+   --  FIXME: check if INSN is really an instruction
+   procedure Set_Insn_Dbg (Insn : ValueRef) is
+   begin
+      if Flag_Debug then
+         if Dbg_Current_Line /= Dbg_Insn_MD_Line then
+            declare
+               Vals : ValueRefArray (0 .. 3);
+            begin
+               Vals := (Dbg_Line,
+                        ConstInt (Int32Type, 0, 0), --  col
+                        Dbg_Current_Scope,          --  context
+                        Null_ValueRef);             --  inline
+               Dbg_Insn_MD := MDNode (Vals, Vals'Length);
+               Dbg_Insn_MD_Line := Dbg_Current_Line;
+            end;
+         end if;
+         SetMetadata (Insn, Debug_ID, Dbg_Insn_MD);
+      end if;
+   end Set_Insn_Dbg;
+
+   procedure Dbg_Create_Variable (Tag : Unsigned_32;
+                                  Ident : O_Ident;
+                                  Vtype : O_Tnode;
+                                  Argno : Natural;
+                                  Addr : ValueRef)
+   is
+      Vals : ValueRefArray (0 .. 7);
+      Str : constant ValueRef := MDString (Ident);
+      Call_Vals : ValueRefArray (0 .. 1);
+      Call : ValueRef;
+   begin
+      Vals := (ConstInt (Int32Type, Unsigned_64 (Tag), 0),
+               Dbg_Current_Scope,
+               Str,
+               Dbg_Current_File,
+               ConstInt (Int32Type,
+                         Unsigned_64 (Dbg_Current_Line)
+                           + Unsigned_64 (Argno) * 2 ** 24, 0),
+               Vtype.Dbg,
+               ConstInt (Int32Type, 0, 0), --  flags
+               ConstInt (Int32Type, 0, 0));
+
+      Call_Vals := (MDNode ((0 => Addr), 1),
+                    MDNode (Vals, Vals'Length));
+      Call := BuildCall (Decl_Builder, Llvm_Dbg_Declare,
+                         Call_Vals, Call_Vals'Length, Empty_Cstring);
+      Set_Insn_Dbg (Call);
+   end Dbg_Create_Variable;
+
+   procedure Create_Declare_Block
+   is
+      Res : Declare_Block_Acc;
+   begin
+      --  Try to recycle an unused record.
+      if Old_Declare_Block /= null then
+         Res := Old_Declare_Block;
+         Old_Declare_Block := Res.Prev;
+      else
+         --  Create a new one if no unused records.
+         Res := new Declare_Block_Type;
+      end if;
+
+      --  Chain.
+      Res.all := (Stmt_Bb => Null_BasicBlockRef,
+                  Stack_Value => Null_ValueRef,
+                  Dbg_Scope => Null_ValueRef,
+                  Prev => Cur_Declare_Block);
+      Cur_Declare_Block := Res;
+
+      if not Unreach then
+         Res.Stmt_Bb := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      end if;
+   end Create_Declare_Block;
+
+   procedure Destroy_Declare_Block
+   is
+      Blk : constant Declare_Block_Acc := Cur_Declare_Block;
+   begin
+      --  Unchain.
+      Cur_Declare_Block := Blk.Prev;
+
+      --  Put on the recyle list.
+      Blk.Prev := Old_Declare_Block;
+      Old_Declare_Block := Blk;
+   end Destroy_Declare_Block;
+
+   -----------------------
+   -- Start_Record_Type --
+   -----------------------
+
+   procedure Start_Record_Type (Elements : out O_Element_List) is
+   begin
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => O_Tnode_Null,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Record_Type;
+
+   ----------------------
+   -- New_Record_Field --
+   ----------------------
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+      O_El : O_Element_Acc;
+   begin
+      El := (Kind => OF_Record,
+             Index => Elements.Nbr_Elements,
+             Ftype => Etype);
+      Elements.Nbr_Elements := Elements.Nbr_Elements + 1;
+      O_El := new O_Element'(Next => null,
+                             Etype => Etype,
+                             Ident => Ident);
+      if Elements.First_Elem = null then
+         Elements.First_Elem := O_El;
+      else
+         Elements.Last_Elem.Next := O_El;
+      end if;
+      Elements.Last_Elem := O_El;
+   end New_Record_Field;
+
+   ------------------------
+   -- Finish_Record_Type --
+   ------------------------
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List;
+      Res : out O_Tnode)
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (O_Element, O_Element_Acc);
+
+      Count : constant unsigned := unsigned (Elements.Nbr_Elements);
+      El : O_Element_Acc;
+      Next_El : O_Element_Acc;
+      Types : TypeRefArray (1 .. Count);
+   begin
+      El := Elements.First_Elem;
+      for I in Types'Range loop
+         Types (I) := Get_LLVM_Type (El.Etype);
+         El := El.Next;
+      end loop;
+
+      if Elements.Rec_Type /= null then
+         --  Completion
+         StructSetBody (Elements.Rec_Type.LLVM, Types, Count, 0);
+         Res := Elements.Rec_Type;
+      else
+         Res := new O_Tnode_Type'(Kind => ON_Record_Type,
+                                  LLVM => StructType (Types, Count, 0),
+                                  Dbg => Null_ValueRef);
+      end if;
+
+      if Flag_Debug then
+         declare
+            Fields : ValueRefArray (1 .. Count);
+            Vals : ValueRefArray (0 .. 9);
+            Ftype : TypeRef;
+            Fields_Arr : ValueRef;
+         begin
+            El := Elements.First_Elem;
+            for I in Fields'Range loop
+               Ftype := Get_LLVM_Type (El.Etype);
+               Vals :=
+                 (ConstInt (Int32Type, DW_TAG_Member, 0),
+                  Dbg_Current_File,
+                  Null_ValueRef,
+                  MDString (El.Ident),
+                  ConstInt (Int32Type, 0, 0),    -- linenum
+                  Dbg_Size (Ftype),
+                  Dbg_Align (Ftype),
+                  ConstInt
+                    (Int32Type,
+                     8 * OffsetOfElement (Target_Data,
+                                          Res.LLVM, Unsigned_32 (I - 1)), 0),
+                  ConstInt (Int32Type, 0, 0),    --  Flags
+                  El.Etype.Dbg);
+               Fields (I) := MDNode (Vals, Vals'Length);
+               El := El.Next;
+            end loop;
+            Fields_Arr := MDNode (Fields, Fields'Length);
+            if Elements.Rec_Type /= null then
+               --  Completion
+               MDNodeReplaceOperandWith (Res.Dbg, 10, Fields_Arr);
+               MDNodeReplaceOperandWith (Res.Dbg, 5, Dbg_Size (Res.LLVM));
+               MDNodeReplaceOperandWith (Res.Dbg, 6, Dbg_Align (Res.LLVM));
+            else
+               --  Temporary borrowed.
+               Res.Dbg := Fields_Arr;
+            end if;
+         end;
+      end if;
+
+      --  Free elements
+      El := Elements.First_Elem;
+      for I in Types'Range loop
+         Next_El := El.Next;
+         Free (El);
+         El := Next_El;
+      end loop;
+   end Finish_Record_Type;
+
+   --------------------------------
+   -- New_Uncomplete_Record_Type --
+   --------------------------------
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      --  LLVM type will be created when the type is declared.
+      Res := new O_Tnode_Type'(Kind => ON_Incomplete_Record_Type,
+                               LLVM => Null_TypeRef,
+                               Dbg => Null_ValueRef);
+   end New_Uncomplete_Record_Type;
+
+   ----------------------------------
+   -- Start_Uncomplete_Record_Type --
+   ----------------------------------
+
+   procedure Start_Uncomplete_Record_Type
+     (Res : O_Tnode;
+      Elements : out O_Element_List)
+   is
+   begin
+      if Res.Kind /= ON_Incomplete_Record_Type then
+         raise Program_Error;
+      end if;
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => Res,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Uncomplete_Record_Type;
+
+   ----------------------
+   -- Start_Union_Type --
+   ----------------------
+
+   procedure Start_Union_Type (Elements : out O_Element_List) is
+   begin
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => O_Tnode_Null,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Union_Type;
+
+   ---------------------
+   -- New_Union_Field --
+   ---------------------
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+      pragma Unreferenced (Ident);
+
+      El_Type : constant TypeRef := Get_LLVM_Type (Etype);
+      Size : constant unsigned :=
+        unsigned (ABISizeOfType (Target_Data, El_Type));
+      Align : constant Unsigned_32 :=
+        ABIAlignmentOfType (Target_Data, El_Type);
+   begin
+      El := (Kind => OF_Union, Utype => El_Type, Ftype => Etype);
+      if Size > Elements.Size then
+         Elements.Size := Size;
+      end if;
+      if Elements.Align_Type = Null_TypeRef or else Align > Elements.Align then
+         Elements.Align := Align;
+         Elements.Align_Type := El_Type;
+      end if;
+   end New_Union_Field;
+
+   -----------------------
+   -- Finish_Union_Type --
+   -----------------------
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List;
+      Res : out O_Tnode)
+   is
+      Count : unsigned;
+      Types : TypeRefArray (1 .. 2);
+      Pad : unsigned;
+   begin
+      if Elements.Align_Type = Null_TypeRef then
+         --  An empty union.  Is it allowed ?
+         Count := 0;
+      else
+         --  The first element is the field with the biggest alignment
+         Types (1) := Elements.Align_Type;
+         --  Possibly complete with an array of bytes.
+         Pad := Elements.Size
+           - unsigned (ABISizeOfType (Target_Data, Elements.Align_Type));
+         if Pad /= 0 then
+            Types (2) := ArrayType (Int8Type, Pad);
+            Count := 2;
+         else
+            Count := 1;
+         end if;
+      end if;
+      Res := new O_Tnode_Type'(Kind => ON_Union_Type,
+                               LLVM => StructType (Types, Count, 0),
+                               Dbg => Null_ValueRef,
+                               Un_Size => Elements.Size,
+                               Un_Main_Field => Elements.Align_Type);
+   end Finish_Union_Type;
+
+   ---------------------
+   -- New_Access_Type --
+   ---------------------
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode is
+   begin
+      if Dtype = O_Tnode_Null then
+         --  LLVM type will be built by New_Type_Decl, so that the name
+         --  can be used for the structure.
+         return new O_Tnode_Type'(Kind => ON_Incomplete_Access_Type,
+                                  LLVM => Null_TypeRef,
+                                  Dbg => Null_ValueRef,
+                                  Acc_Type => O_Tnode_Null);
+      else
+         return new O_Tnode_Type'(Kind => ON_Access_Type,
+                                  LLVM => PointerType (Get_LLVM_Type (Dtype)),
+                                  Dbg => Null_ValueRef,
+                                  Acc_Type => Dtype);
+      end if;
+   end New_Access_Type;
+
+   ------------------------
+   -- Finish_Access_Type --
+   ------------------------
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode)
+   is
+      Types : TypeRefArray (1 .. 1);
+   begin
+      if Atype.Kind /= ON_Incomplete_Access_Type then
+         --  Not an incomplete access type.
+         raise Program_Error;
+      end if;
+      if Atype.Acc_Type /= O_Tnode_Null then
+         --  Already completed.
+         raise Program_Error;
+      end if;
+      --  Completion
+      Types (1) := Get_LLVM_Type (Dtype);
+      StructSetBody (GetElementType (Atype.LLVM), Types, Types'Length, 0);
+      Atype.Acc_Type := Dtype;
+
+      --  Debug.
+      --  FIXME.
+   end Finish_Access_Type;
+
+   --------------------
+   -- New_Array_Type --
+   --------------------
+
+   function Dbg_Array (El_Type : O_Tnode; Len : ValueRef; Atype : O_Tnode)
+                      return ValueRef
+   is
+      Rng : ValueRefArray (0 .. 2);
+      Rng_Arr : ValueRefArray (0 .. 0);
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Rng := (ConstInt (Int32Type, DW_TAG_Subrange_Type, 0),
+              ConstInt (Int64Type, 0, 0), -- Lo
+              Len); -- Count
+      Rng_Arr := (0 => MDNode (Rng, Rng'Length));
+      Vals := (ConstInt (Int32Type, DW_TAG_Array_Type, 0),
+               Null_ValueRef,
+               Null_ValueRef,           --  context
+               Null_ValueRef,
+               ConstInt (Int32Type, 0, 0), -- line
+               Dbg_Size (Atype.LLVM),
+               Dbg_Align (Atype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               El_Type.Dbg, --  element type
+               MDNode (Rng_Arr, Rng_Arr'Length), -- subscript
+               ConstInt (Int32Type, 0, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               Null_ValueRef); --  Runtime lang
+      return MDNode (Vals, Vals'Length);
+   end Dbg_Array;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+                           return O_Tnode
+   is
+      pragma Unreferenced (Index_Type);
+      Res : O_Tnode;
+   begin
+      Res := new O_Tnode_Type'
+        (Kind => ON_Array_Type,
+         LLVM => ArrayType (Get_LLVM_Type (El_Type), 0),
+         Dbg => Null_ValueRef,
+         Arr_El_Type => El_Type);
+
+      if Flag_Debug then
+         Res.Dbg := Dbg_Array
+           (El_Type, ConstInt (Int64Type, Unsigned_64'Last, 1), Res);
+      end if;
+
+      return Res;
+   end New_Array_Type;
+
+   --------------------------------
+   -- New_Constrained_Array_Type --
+   --------------------------------
+
+   function New_Constrained_Array_Type
+     (Atype : O_Tnode; Length : O_Cnode) return O_Tnode
+   is
+      Res : O_Tnode;
+      Len : constant unsigned := unsigned (ConstIntGetZExtValue (Length.LLVM));
+   begin
+      Res := new O_Tnode_Type'
+        (Kind => ON_Array_Sub_Type,
+         LLVM => ArrayType (GetElementType (Get_LLVM_Type (Atype)), Len),
+         Dbg => Null_ValueRef,
+         Arr_El_Type => Atype.Arr_El_Type);
+
+      if Flag_Debug then
+         Res.Dbg := Dbg_Array
+           (Atype.Arr_El_Type,
+            ConstInt (Int64Type, Unsigned_64 (Len), 0), Res);
+      end if;
+
+      return Res;
+   end New_Constrained_Array_Type;
+
+   -----------------------
+   -- New_Unsigned_Type --
+   -----------------------
+
+   function Size_To_Llvm (Size : Natural) return TypeRef is
+      Llvm : TypeRef;
+   begin
+      case Size is
+         when 8 =>
+            Llvm := Int8Type;
+         when 32 =>
+            Llvm := Int32Type;
+         when 64 =>
+            Llvm := Int64Type;
+         when others =>
+            raise Program_Error;
+      end case;
+      return Llvm;
+   end Size_To_Llvm;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Unsigned_Type,
+                               LLVM => Size_To_Llvm (Size),
+                               Dbg => Null_ValueRef,
+                               Scal_Size => Size);
+   end New_Unsigned_Type;
+
+   ---------------------
+   -- New_Signed_Type --
+   ---------------------
+
+   function New_Signed_Type (Size : Natural) return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Signed_Type,
+                               LLVM => Size_To_Llvm (Size),
+                               Dbg => Null_ValueRef,
+                               Scal_Size => Size);
+   end New_Signed_Type;
+
+   --------------------
+   -- New_Float_Type --
+   --------------------
+
+   function New_Float_Type return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Float_Type,
+                               LLVM => DoubleType,
+                               Dbg => Null_ValueRef,
+                               Scal_Size => 64);
+   end New_Float_Type;
+
+   procedure Dbg_Add_Enumeration (Id : O_Ident; Val : Unsigned_64) is
+      Vals : ValueRefArray (0 .. 2);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Enumerator, 0),
+               MDString (Id),
+               ConstInt (Int64Type, Val, 0));
+      --  FIXME: make it local to List ?
+      Append (Enum_Nodes, MDNode (Vals, Vals'Length));
+   end Dbg_Add_Enumeration;
+
+   ----------------------
+   -- New_Boolean_Type --
+   ----------------------
+
+   procedure New_Boolean_Type
+     (Res : out O_Tnode;
+      False_Id : O_Ident; False_E : out O_Cnode;
+      True_Id : O_Ident; True_E : out O_Cnode)
+   is
+   begin
+      Res := new O_Tnode_Type'(Kind => ON_Boolean_Type,
+                               LLVM => Int1Type,
+                               Dbg => Null_ValueRef,
+                               Scal_Size => 1);
+      False_E := O_Cnode'(LLVM => ConstInt (Res.LLVM, 0, 0),
+                          Ctype => Res);
+      True_E := O_Cnode'(LLVM => ConstInt (Res.LLVM, 1, 0),
+                         Ctype => Res);
+      if Flag_Debug then
+         Dbg_Add_Enumeration (False_Id, 0);
+         Dbg_Add_Enumeration (True_Id, 1);
+      end if;
+   end New_Boolean_Type;
+
+   ---------------------
+   -- Start_Enum_Type --
+   ---------------------
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+      LLVM : constant TypeRef := Size_To_Llvm (Size);
+   begin
+      List := (LLVM => LLVM,
+               Num => 0,
+               Etype => new O_Tnode_Type'(Kind => ON_Enum_Type,
+                                          LLVM => LLVM,
+                                          Scal_Size => Size,
+                                          Dbg => Null_ValueRef));
+
+   end Start_Enum_Type;
+
+   ----------------------
+   -- New_Enum_Literal --
+   ----------------------
+
+   procedure New_Enum_Literal
+     (List : in out O_Enum_List; Ident : O_Ident; Res : out O_Cnode)
+   is
+   begin
+      Res := O_Cnode'(LLVM => ConstInt (List.LLVM, Unsigned_64 (List.Num), 0),
+                      Ctype => List.Etype);
+      if Flag_Debug then
+         Dbg_Add_Enumeration (Ident, Unsigned_64 (List.Num));
+      end if;
+
+      List.Num := List.Num + 1;
+   end New_Enum_Literal;
+
+   ----------------------
+   -- Finish_Enum_Type --
+   ----------------------
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := List.Etype;
+   end Finish_Enum_Type;
+
+   ------------------------
+   -- New_Signed_Literal --
+   ------------------------
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode
+   is
+      function To_Unsigned_64 is new Ada.Unchecked_Conversion
+        (Integer_64, Unsigned_64);
+   begin
+      return O_Cnode'(LLVM => ConstInt (Get_LLVM_Type (Ltype),
+                                        To_Unsigned_64 (Value), 1),
+                     Ctype => Ltype);
+   end New_Signed_Literal;
+
+   --------------------------
+   -- New_Unsigned_Literal --
+   --------------------------
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstInt (Get_LLVM_Type (Ltype), Value, 0),
+                      Ctype => Ltype);
+   end New_Unsigned_Literal;
+
+   -----------------------
+   -- New_Float_Literal --
+   -----------------------
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstReal (Get_LLVM_Type (Ltype),
+                                         Interfaces.C.double (Value)),
+                      Ctype => Ltype);
+   end New_Float_Literal;
+
+   ---------------------
+   -- New_Null_Access --
+   ---------------------
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstNull (Get_LLVM_Type (Ltype)),
+                      Ctype => Ltype);
+   end New_Null_Access;
+
+   -----------------------
+   -- Start_Record_Aggr --
+   -----------------------
+
+   procedure Start_Record_Aggr
+     (List : out O_Record_Aggr_List;
+      Atype : O_Tnode)
+   is
+      Llvm : constant TypeRef := Get_LLVM_Type (Atype);
+   begin
+      List :=
+        (Len => 0,
+         Vals => new ValueRefArray (1 .. CountStructElementTypes (Llvm)),
+         Atype => Atype);
+   end Start_Record_Aggr;
+
+   ------------------------
+   -- New_Record_Aggr_El --
+   ------------------------
+
+   procedure New_Record_Aggr_El
+     (List : in out O_Record_Aggr_List; Value : O_Cnode)
+   is
+   begin
+      List.Len := List.Len + 1;
+      List.Vals (List.Len) := Value.LLVM;
+   end New_Record_Aggr_El;
+
+   ------------------------
+   -- Finish_Record_Aggr --
+   ------------------------
+
+   procedure Finish_Record_Aggr
+     (List : in out O_Record_Aggr_List;
+      Res : out O_Cnode)
+   is
+   begin
+      Res := (LLVM => ConstStruct (List.Vals.all, List.Len, 0),
+              Ctype => List.Atype);
+      Free (List.Vals);
+   end Finish_Record_Aggr;
+
+   ----------------------
+   -- Start_Array_Aggr --
+   ----------------------
+
+   procedure Start_Array_Aggr
+     (List : out O_Array_Aggr_List;
+      Atype : O_Tnode)
+   is
+      Llvm : constant TypeRef := Get_LLVM_Type (Atype);
+   begin
+      List := (Len => 0,
+               Vals => new ValueRefArray (1 .. GetArrayLength (Llvm)),
+               El_Type => GetElementType (Llvm),
+               Atype => Atype);
+   end Start_Array_Aggr;
+
+   -----------------------
+   -- New_Array_Aggr_El --
+   -----------------------
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode)
+   is
+   begin
+      List.Len := List.Len + 1;
+      List.Vals (List.Len) := Value.LLVM;
+   end New_Array_Aggr_El;
+
+   -----------------------
+   -- Finish_Array_Aggr --
+   -----------------------
+
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode)
+   is
+   begin
+      Res := (LLVM => ConstArray (List.El_Type,
+                                  List.Vals.all, List.Len),
+             Ctype => List.Atype);
+      Free (List.Vals);
+   end Finish_Array_Aggr;
+
+   --------------------
+   -- New_Union_Aggr --
+   --------------------
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      Values : ValueRefArray (1 .. 2);
+      Count : unsigned;
+      Size : constant unsigned :=
+        unsigned (ABISizeOfType (Target_Data, Field.Utype));
+
+   begin
+      Values (1) := Value.LLVM;
+      if Size < Atype.Un_Size then
+         Values (2) := GetUndef (ArrayType (Int8Type, Atype.Un_Size - Size));
+         Count := 2;
+      else
+         Count := 1;
+      end if;
+
+      --  If `FIELD` is the main field of the union, create a struct using
+      --  the same type as the union (and possibly pad).
+      if Field.Utype = Atype.Un_Main_Field then
+         return O_Cnode'
+           (LLVM => ConstNamedStruct (Atype.LLVM, Values, Count),
+            Ctype => Atype);
+      else
+         --  Create an on-the-fly record.
+         return O_Cnode'(LLVM => ConstStruct (Values, Count, 0),
+                         Ctype => Atype);
+      end if;
+   end New_Union_Aggr;
+
+   ----------------
+   -- New_Sizeof --
+   ----------------
+
+   --  Return VAL with type RTYPE (either unsigned or access)
+   function Const_To_Cnode (Rtype : O_Tnode; Val : Unsigned_64) return O_Cnode
+   is
+      Tmp : ValueRef;
+   begin
+      case Rtype.Kind is
+         when ON_Scalar_Types =>
+            --  Well, unsigned in fact.
+            return O_Cnode'(LLVM => ConstInt (Rtype.LLVM, Val, 0),
+                            Ctype => Rtype);
+         when ON_Access_Type =>
+            Tmp := ConstInt (Int64Type, Val, 0);
+            return O_Cnode'(LLVM => ConstIntToPtr (Tmp, Rtype.LLVM),
+                            Ctype => Rtype);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Const_To_Cnode;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype, ABISizeOfType (Target_Data, Get_LLVM_Type (Atype)));
+   end New_Sizeof;
+
+   -----------------
+   -- New_Alignof --
+   -----------------
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype,
+         Unsigned_64
+           (ABIAlignmentOfType (Target_Data, Get_LLVM_Type (Atype))));
+   end New_Alignof;
+
+   ------------------
+   -- New_Offsetof --
+   ------------------
+
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype,
+         OffsetOfElement (Target_Data,
+                          Get_LLVM_Type (Atype),
+                          Unsigned_32 (Field.Index)));
+   end New_Offsetof;
+
+   ----------------------------
+   -- New_Subprogram_Address --
+   ----------------------------
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode is
+   begin
+      return O_Cnode'
+        (LLVM => ConstBitCast (Subprg.LLVM, Get_LLVM_Type (Atype)),
+         Ctype => Atype);
+   end New_Subprogram_Address;
+
+   ------------------------
+   -- New_Global_Address --
+   ------------------------
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstBitCast (Decl.LLVM, Get_LLVM_Type (Atype)),
+                      Ctype => Atype);
+   end New_Global_Address;
+
+   ----------------------------------
+   -- New_Global_Unchecked_Address --
+   ----------------------------------
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode
+   is
+   begin
+      return O_Cnode'(LLVM => ConstBitCast (Decl.LLVM, Get_LLVM_Type (Atype)),
+                      Ctype => Atype);
+   end New_Global_Unchecked_Address;
+
+   -------------
+   -- New_Lit --
+   -------------
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode'(LLVM => Lit.LLVM,
+                      Etype => Lit.Ctype);
+   end New_Lit;
+
+   -------------------
+   -- New_Dyadic_Op --
+   -------------------
+
+   function New_Smod (L, R : ValueRef; Res_Type : TypeRef)
+                     return ValueRef
+   is
+      Cond : ValueRef;
+      Br : ValueRef;
+      pragma Unreferenced (Br);
+
+      --  The result of 'L rem R'.
+      Rm : ValueRef;
+
+      --  Rm + R
+      Rm_Plus_R : ValueRef;
+
+      --  The result of 'L xor R'.
+      R_Xor : ValueRef;
+
+      Adj : ValueRef;
+      Phi : ValueRef;
+
+      --  Basic basic for the non-overflow branch
+      Normal_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      Adjust_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      --  Basic block after the result
+      Next_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      Vals : ValueRefArray (1 .. 3);
+      BBs  : BasicBlockRefArray (1 .. 3);
+   begin
+      --  Avoid overflow with -1:
+      --   if R = -1 then
+      --     result := 0;
+      --   else
+      --     ...
+      Cond := BuildICmp
+        (Builder, IntEQ, R, ConstAllOnes (Res_Type), Empty_Cstring);
+      Br := BuildCondBr (Builder, Cond, Next_Bb, Normal_Bb);
+      Vals (1) := ConstNull (Res_Type);
+      BBs (1) := GetInsertBlock (Builder);
+
+      --  Rm := Left rem Right
+      PositionBuilderAtEnd (Builder, Normal_Bb);
+      Rm := BuildSRem (Builder, L, R, Empty_Cstring);
+
+      --  if R = 0 then
+      --    result := 0
+      --  else
+      Cond := BuildICmp
+        (Builder, IntEQ, Rm, ConstNull (Res_Type), Empty_Cstring);
+      Br := BuildCondBr (Builder, Cond, Next_Bb, Adjust_Bb);
+      Vals (2) := ConstNull (Res_Type);
+      BBs (2) := Normal_Bb;
+
+      --  if L xor R < 0 then
+      --    result := Rm + R
+      --  else
+      --    result := Rm;
+      --  end if;
+      PositionBuilderAtEnd (Builder, Adjust_Bb);
+      R_Xor := BuildXor (Builder, L, R, Empty_Cstring);
+      Cond := BuildICmp
+        (Builder, IntSLT, R_Xor, ConstNull (Res_Type), Empty_Cstring);
+      Rm_Plus_R := BuildAdd (Builder, Rm, R, Empty_Cstring);
+      Adj := BuildSelect (Builder, Cond, Rm_Plus_R, Rm, Empty_Cstring);
+      Br := BuildBr (Builder, Next_Bb);
+      Vals (3) := Adj;
+      BBs (3) := Adjust_Bb;
+
+      --  The Phi node
+      PositionBuilderAtEnd (Builder, Next_Bb);
+      Phi := BuildPhi (Builder, Res_Type, Empty_Cstring);
+      AddIncoming (Phi, Vals, BBs, Vals'Length);
+
+      return Phi;
+   end New_Smod;
+
+   type Dyadic_Builder_Acc is access
+     function (Builder : BuilderRef;
+               LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+              return ValueRef;
+   pragma Convention (C, Dyadic_Builder_Acc);
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+                          return O_Enode
+   is
+      Build : Dyadic_Builder_Acc := null;
+      Res : ValueRef := Null_ValueRef;
+   begin
+      if Unreach then
+         return O_Enode'(LLVM => Null_ValueRef, Etype => Left.Etype);
+      end if;
+
+      case Left.Etype.Kind is
+         when ON_Integer_Types =>
+            case Kind is
+               when ON_And =>
+                  Build := BuildAnd'Access;
+               when ON_Or =>
+                  Build := BuildOr'Access;
+               when ON_Xor =>
+                  Build := BuildXor'Access;
+
+               when ON_Add_Ov =>
+                  Build := BuildAdd'Access;
+               when ON_Sub_Ov =>
+                  Build := BuildSub'Access;
+               when ON_Mul_Ov =>
+                  Build := BuildMul'Access;
+
+               when ON_Div_Ov =>
+                  case Left.Etype.Kind is
+                     when ON_Unsigned_Type =>
+                        Build := BuildUDiv'Access;
+                     when ON_Signed_Type =>
+                        Build := BuildSDiv'Access;
+                     when others =>
+                        null;
+                  end case;
+
+               when ON_Mod_Ov
+                 | ON_Rem_Ov => -- FIXME...
+                  case Left.Etype.Kind is
+                     when ON_Unsigned_Type =>
+                        Build := BuildURem'Access;
+                     when ON_Signed_Type =>
+                        if Kind = ON_Rem_Ov then
+                           Build := BuildSRem'Access;
+                        else
+                           Res := New_Smod
+                             (Left.LLVM, Right.LLVM, Left.Etype.LLVM);
+                        end if;
+                     when others =>
+                        null;
+                  end case;
+            end case;
+
+         when ON_Float_Type =>
+            case Kind is
+               when ON_Add_Ov =>
+                  Build := BuildFAdd'Access;
+               when ON_Sub_Ov =>
+                  Build := BuildFSub'Access;
+               when ON_Mul_Ov =>
+                  Build := BuildFMul'Access;
+               when ON_Div_Ov =>
+                  Build := BuildFDiv'Access;
+
+               when others =>
+                  null;
+            end case;
+
+         when others =>
+            null;
+      end case;
+
+      if Build /= null then
+         pragma Assert (Res = Null_ValueRef);
+         Res := Build.all (Builder,  Left.LLVM, Right.LLVM, Empty_Cstring);
+      end if;
+
+      if Res = Null_ValueRef then
+         raise Program_Error with "Unimplemented New_Dyadic_Op "
+           & ON_Dyadic_Op_Kind'Image (Kind)
+           & " for type "
+           & ON_Type_Kind'Image (Left.Etype.Kind);
+      end if;
+
+      Set_Insn_Dbg (Res);
+
+      return O_Enode'(LLVM => Res, Etype => Left.Etype);
+   end New_Dyadic_Op;
+
+   --------------------
+   -- New_Monadic_Op --
+   --------------------
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+                           return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      case Operand.Etype.Kind is
+         when ON_Integer_Types =>
+            case Kind is
+               when ON_Not =>
+                  Res := BuildNot (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Neg_Ov =>
+                  Res := BuildNeg (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Abs_Ov =>
+                  Res := BuildSelect
+                    (Builder,
+                     BuildICmp (Builder, IntSLT,
+                                Operand.LLVM,
+                                ConstInt (Get_LLVM_Type (Operand.Etype), 0, 0),
+                                Empty_Cstring),
+                     BuildNeg (Builder, Operand.LLVM, Empty_Cstring),
+                     Operand.LLVM,
+                     Empty_Cstring);
+            end case;
+         when ON_Float_Type =>
+            case Kind is
+               when ON_Not =>
+                  raise Program_Error;
+               when ON_Neg_Ov =>
+                  Res := BuildFNeg (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Abs_Ov =>
+                  Res := BuildSelect
+                    (Builder,
+                     BuildFCmp (Builder, RealOLT,
+                                Operand.LLVM,
+                                ConstReal (Get_LLVM_Type (Operand.Etype), 0.0),
+                                Empty_Cstring),
+                     BuildFNeg (Builder, Operand.LLVM, Empty_Cstring),
+                     Operand.LLVM,
+                     Empty_Cstring);
+            end case;
+         when others =>
+            raise Program_Error;
+      end case;
+
+      if IsAInstruction (Res) /= Null_ValueRef then
+         Set_Insn_Dbg (Res);
+      end if;
+
+      return O_Enode'(LLVM => Res, Etype => Operand.Etype);
+   end New_Monadic_Op;
+
+   --------------------
+   -- New_Compare_Op --
+   --------------------
+
+   type Compare_Op_Entry is record
+      Signed_Pred   : IntPredicate;
+      Unsigned_Pred : IntPredicate;
+      Real_Pred     : RealPredicate;
+   end record;
+
+   type Compare_Op_Table_Type is array (ON_Compare_Op_Kind) of
+     Compare_Op_Entry;
+
+   Compare_Op_Table : constant Compare_Op_Table_Type :=
+     (ON_Eq  => (IntEQ,  IntEQ,  RealOEQ),
+      ON_Neq => (IntNE,  IntNE,  RealONE),
+      ON_Le  => (IntSLE, IntULE, RealOLE),
+      ON_Lt  => (IntSLT, IntULT, RealOLT),
+      ON_Ge  => (IntSGE, IntUGE, RealOGE),
+      ON_Gt  => (IntSGT, IntUGT, RealOGT));
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind;
+      Left, Right : O_Enode;
+      Ntype : O_Tnode)
+      return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      case Left.Etype.Kind is
+         when ON_Unsigned_Type
+           | ON_Boolean_Type
+           | ON_Enum_Type
+           | ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            Res := BuildICmp (Builder, Compare_Op_Table (Kind).Unsigned_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Signed_Type =>
+            Res := BuildICmp (Builder, Compare_Op_Table (Kind).Signed_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Float_Type =>
+            Res := BuildFCmp (Builder, Compare_Op_Table (Kind).Real_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Array_Type
+           | ON_Array_Sub_Type
+           | ON_Record_Type
+           | ON_Incomplete_Record_Type
+           | ON_Union_Type
+           | ON_No_Type =>
+            raise Program_Error;
+      end case;
+      Set_Insn_Dbg (Res);
+      return O_Enode'(LLVM => Res, Etype => Ntype);
+   end New_Compare_Op;
+
+   -------------------------
+   -- New_Indexed_Element --
+   -------------------------
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode) return O_Lnode
+   is
+      Idx : constant ValueRefArray (1 .. 2) :=
+        (ConstInt (Int32Type, 0, 0),
+         Index.LLVM);
+   begin
+      return O_Lnode'
+        (Direct => False,
+         LLVM => BuildGEP (Builder, Arr.LLVM, Idx, Idx'Length, Empty_Cstring),
+         Ltype => Arr.Ltype.Arr_El_Type);
+   end New_Indexed_Element;
+
+   ---------------
+   -- New_Slice --
+   ---------------
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+      return O_Lnode
+   is
+      Idx : constant ValueRefArray (1 .. 2) :=
+        (ConstInt (Int32Type, 0, 0),
+         Index.LLVM);
+      Tmp : ValueRef;
+   begin
+      Tmp := BuildGEP (Builder, Arr.LLVM, Idx, Idx'Length, Empty_Cstring);
+      Tmp := BuildBitCast
+        (Builder, Tmp, PointerType (Get_LLVM_Type (Res_Type)), Empty_Cstring);
+      return O_Lnode'(Direct => False, LLVM => Tmp, Ltype => Res_Type);
+   end New_Slice;
+
+   --------------------------
+   -- New_Selected_Element --
+   --------------------------
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+                                 return O_Lnode
+   is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         Res := Null_ValueRef;
+      else
+         declare
+            Idx : constant ValueRefArray (1 .. 2) :=
+              (ConstInt (Int32Type, 0, 0),
+               ConstInt (Int32Type, Unsigned_64 (El.Index), 0));
+         begin
+            Res := BuildGEP (Builder, Rec.LLVM, Idx, 2, Empty_Cstring);
+         end;
+      end if;
+      return O_Lnode'(Direct => False, LLVM => Res, Ltype => El.Ftype);
+   end New_Selected_Element;
+
+   ------------------------
+   -- New_Access_Element --
+   ------------------------
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      Res : ValueRef;
+   begin
+      case Acc.Etype.Kind is
+         when ON_Access_Type =>
+            Res := Acc.LLVM;
+         when ON_Incomplete_Access_Type =>
+            --  Unwrap the structure
+            declare
+               Idx : constant ValueRefArray (1 .. 2) :=
+                 (ConstInt (Int32Type, 0, 0), ConstInt (Int32Type, 0, 0));
+            begin
+               Res := BuildGEP (Builder, Acc.LLVM, Idx, 2, Empty_Cstring);
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+      return O_Lnode'(Direct => False,
+                      LLVM => Res,
+                      Ltype => Acc.Etype.Acc_Type);
+   end New_Access_Element;
+
+   --------------------
+   -- New_Convert_Ov --
+   --------------------
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode
+   is
+      Res : ValueRef := Null_ValueRef;
+   begin
+      if Rtype = Val.Etype then
+         --  Convertion to itself: nothing to do.
+         return Val;
+      end if;
+      if Rtype.LLVM = Val.Etype.LLVM then
+         --  Same underlying LLVM type: nothing to do.
+         return Val;
+      end if;
+
+      case Rtype.Kind is
+         when ON_Integer_Types =>
+            case Val.Etype.Kind is
+               when ON_Integer_Types =>
+                  --  Int to Int
+                  if Val.Etype.Scal_Size > Rtype.Scal_Size then
+                     --  Truncate
+                     Res := BuildTrunc
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  elsif Val.Etype.Scal_Size < Rtype.Scal_Size then
+                     if Val.Etype.Kind = ON_Signed_Type then
+                        Res := BuildSExt
+                          (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                           Empty_Cstring);
+                     else
+                        --  Unsigned, enum
+                        Res := BuildZExt
+                          (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                           Empty_Cstring);
+                     end if;
+                  else
+                     Res := BuildBitCast
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  end if;
+
+               when ON_Float_Type =>
+                  --  Float to Int
+                  if Rtype.Kind = ON_Signed_Type then
+                     Res := BuildFPToSI
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  end if;
+
+               when others =>
+                  null;
+            end case;
+
+         when ON_Float_Type =>
+            if Val.Etype.Kind = ON_Signed_Type then
+               Res := BuildSIToFP
+                 (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                  Empty_Cstring);
+            elsif Val.Etype.Kind = ON_Unsigned_Type then
+               Res := BuildUIToFP
+                 (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                  Empty_Cstring);
+            end if;
+
+         when ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            if GetTypeKind (TypeOf (Val.LLVM)) /= PointerTypeKind then
+               raise Program_Error;
+            end if;
+            Res := BuildBitCast (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                                 Empty_Cstring);
+
+         when others =>
+            null;
+      end case;
+      if Res /= Null_ValueRef then
+         --  FIXME: only if insn was generated
+         --  Set_Insn_Dbg (Res);
+         return O_Enode'(LLVM => Res, Etype => Rtype);
+      else
+         raise Program_Error with "New_Convert_Ov: not implemented for "
+           & ON_Type_Kind'Image (Val.Etype.Kind)
+           & " -> "
+           & ON_Type_Kind'Image (Rtype.Kind);
+      end if;
+   end New_Convert_Ov;
+
+   -----------------
+   -- New_Address --
+   -----------------
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode is
+   begin
+      return O_Enode'
+        (LLVM => BuildBitCast (Builder, Lvalue.LLVM, Get_LLVM_Type (Atype),
+                               Empty_Cstring),
+         Etype => Atype);
+   end New_Address;
+
+   ---------------------------
+   -- New_Unchecked_Address --
+   ---------------------------
+
+   function New_Unchecked_Address  (Lvalue : O_Lnode; Atype : O_Tnode)
+                                   return O_Enode
+   is
+   begin
+      return O_Enode'
+        (LLVM => BuildBitCast (Builder, Lvalue.LLVM, Get_LLVM_Type (Atype),
+                               Empty_Cstring),
+         Etype => Atype);
+   end New_Unchecked_Address;
+
+   ---------------
+   -- New_Value --
+   ---------------
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         Res := Null_ValueRef;
+      else
+         Res := Lvalue.LLVM;
+         if not Lvalue.Direct then
+            Res := BuildLoad (Builder, Res, Empty_Cstring);
+            Set_Insn_Dbg (Res);
+         end if;
+      end if;
+      return O_Enode'(LLVM => Res, Etype => Lvalue.Ltype);
+   end New_Value;
+
+   -------------------
+   -- New_Obj_Value --
+   -------------------
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return New_Value (New_Obj (Obj));
+   end New_Obj_Value;
+
+   -------------
+   -- New_Obj --
+   -------------
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      case Obj.Kind is
+         when ON_Const_Decl
+           | ON_Var_Decl
+           | ON_Local_Decl =>
+            return O_Lnode'(Direct => False,
+                            LLVM => Obj.LLVM,
+                            Ltype => Obj.Dtype);
+
+         when ON_Interface_Decl =>
+            if Flag_Debug then
+               --  The argument was allocated.
+               return O_Lnode'(Direct => False,
+                               LLVM => Obj.Inter.Ival,
+                               Ltype => Obj.Dtype);
+            else
+               return O_Lnode'(Direct => True,
+                               LLVM => Obj.Inter.Ival,
+                               Ltype => Obj.Dtype);
+            end if;
+
+         when ON_Type_Decl
+           | ON_Completed_Type_Decl
+           | ON_Subprg_Decl
+           | ON_No_Decl =>
+            raise Program_Error;
+      end case;
+   end New_Obj;
+
+   ----------------
+   -- New_Alloca --
+   ----------------
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         Res := Null_ValueRef;
+      else
+         if Cur_Declare_Block.Stack_Value = Null_ValueRef
+           and then Cur_Declare_Block.Prev /= null
+         then
+            --  Save stack pointer at entry of block
+            PositionBuilderBefore
+              (Extra_Builder, GetFirstInstruction (Cur_Declare_Block.Stmt_Bb));
+            Cur_Declare_Block.Stack_Value :=
+              BuildCall (Extra_Builder, Stacksave_Fun,
+                         (1 .. 0 => Null_ValueRef), 0, Empty_Cstring);
+         end if;
+
+         Res := BuildArrayAlloca
+           (Builder, Int8Type, Size.LLVM, Empty_Cstring);
+         Set_Insn_Dbg (Res);
+
+         Res := BuildBitCast
+           (Builder, Res, Get_LLVM_Type (Rtype), Empty_Cstring);
+         Set_Insn_Dbg (Res);
+      end if;
+
+      return O_Enode'(LLVM => Res, Etype => Rtype);
+   end New_Alloca;
+
+   -------------------
+   -- New_Type_Decl --
+   -------------------
+
+   function Add_Dbg_Basic_Type (Id : O_Ident; Btype : O_Tnode; Enc : Natural)
+                               return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 9);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Base_Type, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               MDString (Id),
+               ConstInt (Int32Type, 0, 0),    -- linenum
+               Dbg_Size (Btype.LLVM),
+               Dbg_Align (Btype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               ConstInt (Int32Type, Unsigned_64 (Enc), 0)); --  Encoding
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Basic_Type;
+
+   function Add_Dbg_Enum_Type (Id : O_Ident; Etype : O_Tnode) return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Enumeration_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Dbg_Size (Etype.LLVM),
+               Dbg_Align (Etype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               Null_ValueRef,
+               Get_Value (Enum_Nodes),
+               ConstInt (Int32Type, 0, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               Null_ValueRef); --  Runtime lang
+      Clear (Enum_Nodes);
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Enum_Type;
+
+   function Add_Dbg_Pointer_Type (Id : O_Ident; Ptype : O_Tnode)
+                                 return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 9);
+   begin
+      pragma Assert (Ptype.Acc_Type.Dbg /= Null_ValueRef);
+
+      Vals := (ConstInt (Int32Type, DW_TAG_Pointer_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Dbg_Size (Ptype.LLVM),
+               Dbg_Align (Ptype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 1024, 0),    --  Flags
+               Ptype.Acc_Type.Dbg);
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Pointer_Type;
+
+   function Add_Dbg_Record_Type (Id : O_Ident; Rtype : O_Tnode)
+                                return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Structure_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Null_ValueRef,  --  5: Size
+               Null_ValueRef,  --  6: Align
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 1024, 0),    --  Flags
+               Null_ValueRef,
+               Null_ValueRef, -- 10
+               ConstInt (Int32Type, 0, 0),    --  Runtime lang
+               Null_ValueRef, -- Vtable Holder
+               Null_ValueRef, -- ?
+               Null_ValueRef); -- Uniq Id
+      if Rtype /= O_Tnode_Null then
+         Vals (5) := Dbg_Size (Rtype.LLVM);
+         Vals (6) := Dbg_Align (Rtype.LLVM);
+         Vals (10) := Rtype.Dbg;
+      end if;
+
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Record_Type;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) is
+   begin
+      case Atype.Kind is
+         when ON_Incomplete_Record_Type =>
+            Atype.LLVM :=
+              StructCreateNamed (GetGlobalContext, Get_Cstring (Ident));
+         when ON_Incomplete_Access_Type =>
+            Atype.LLVM := PointerType
+              (StructCreateNamed (GetGlobalContext, Get_Cstring (Ident)));
+         when others =>
+            null;
+      end case;
+
+      --  Emit debug info
+      if Flag_Debug then
+         case Atype.Kind is
+            when ON_Unsigned_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_unsigned);
+            when ON_Signed_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_signed);
+            when ON_Float_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_float);
+            when ON_Enum_Type =>
+               Atype.Dbg := Add_Dbg_Enum_Type (Ident, Atype);
+            when ON_Boolean_Type =>
+               Atype.Dbg := Add_Dbg_Enum_Type (Ident, Atype);
+            when ON_Access_Type =>
+               Atype.Dbg := Add_Dbg_Pointer_Type (Ident, Atype);
+            when ON_Record_Type =>
+               Atype.Dbg := Add_Dbg_Record_Type (Ident, Atype);
+            when ON_Incomplete_Record_Type =>
+               Atype.Dbg := Add_Dbg_Record_Type (Ident, O_Tnode_Null);
+            when ON_Array_Type
+              | ON_Array_Sub_Type =>
+               --  FIXME: typedef
+               null;
+            when ON_Incomplete_Access_Type =>
+               --  FIXME: todo
+               null;
+            when ON_Union_Type =>
+               --  FIXME: todo
+               null;
+            when ON_No_Type =>
+               raise Program_Error;
+         end case;
+      end if;
+   end New_Type_Decl;
+
+   -----------------------------
+   -- New_Debug_Filename_Decl --
+   -----------------------------
+
+   procedure New_Debug_Filename_Decl (Filename : String) is
+      Vals : ValueRefArray (1 .. 2);
+   begin
+      if Flag_Debug then
+         Vals := (MDString (Filename),
+                  MDString (Current_Directory));
+         Dbg_Current_Filedir := MDNode (Vals, 2);
+
+         Vals := (ConstInt (Int32Type, DW_TAG_File_Type, 0),
+                  Dbg_Current_Filedir);
+         Dbg_Current_File := MDNode (Vals, 2);
+      end if;
+   end New_Debug_Filename_Decl;
+
+   -------------------------
+   -- New_Debug_Line_Decl --
+   -------------------------
+
+   procedure New_Debug_Line_Decl (Line : Natural) is
+   begin
+      Dbg_Current_Line := unsigned (Line);
+   end New_Debug_Line_Decl;
+
+   ----------------------------
+   -- New_Debug_Comment_Decl --
+   ----------------------------
+
+   procedure New_Debug_Comment_Decl (Comment : String) is
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   --------------------
+   -- New_Const_Decl --
+   --------------------
+
+   procedure Dbg_Add_Global_Var (Id : O_Ident;
+                                 Atype : O_Tnode;
+                                 Storage : O_Storage;
+                                 Decl : O_Dnode)
+   is
+      pragma Assert (Atype.Dbg /= Null_ValueRef);
+      Vals : ValueRefArray (0 .. 12);
+      Name : constant ValueRef := MDString (Id);
+      Is_Local : constant Boolean := Storage = O_Storage_Private;
+      Is_Def : constant Boolean := Storage /= O_Storage_External;
+   begin
+      Vals :=
+        (ConstInt (Int32Type, DW_TAG_Variable, 0),
+         Null_ValueRef,
+         Null_ValueRef, -- context
+         Name,
+         Name,
+         Null_ValueRef, -- linkageName
+         Dbg_Current_File,
+         Dbg_Line,
+         Atype.Dbg,
+         ConstInt (Int1Type, Boolean'Pos (Is_Local), 0), -- isLocal
+         ConstInt (Int1Type, Boolean'Pos (Is_Def), 0), -- isDef
+         Decl.LLVM,
+         Null_ValueRef);
+      Append (Global_Nodes, MDNode (Vals, Vals'Length));
+   end Dbg_Add_Global_Var;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode; Ident : O_Ident; Storage : O_Storage; Atype : O_Tnode)
+   is
+      Decl : ValueRef;
+   begin
+      if Storage = O_Storage_External then
+         Decl := GetNamedGlobal (Module, Get_Cstring (Ident));
+      else
+         Decl := Null_ValueRef;
+      end if;
+      if Decl = Null_ValueRef then
+         Decl := AddGlobal
+           (Module, Get_LLVM_Type (Atype), Get_Cstring (Ident));
+      end if;
+
+      Res := (Kind => ON_Const_Decl, LLVM => Decl, Dtype => Atype);
+      SetGlobalConstant (Res.LLVM, 1);
+      if Storage = O_Storage_Private then
+         SetLinkage (Res.LLVM, InternalLinkage);
+      end if;
+      if Flag_Debug then
+         Dbg_Add_Global_Var (Ident, Atype, Storage, Res);
+      end if;
+   end New_Const_Decl;
+
+   -----------------------
+   -- Start_Const_Value --
+   -----------------------
+
+   procedure Start_Const_Value (Const : in out O_Dnode) is
+   begin
+      null;
+   end Start_Const_Value;
+
+   ------------------------
+   -- Finish_Const_Value --
+   ------------------------
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) is
+   begin
+      SetInitializer (Const.LLVM, Val.LLVM);
+   end Finish_Const_Value;
+
+   ------------------
+   -- New_Var_Decl --
+   ------------------
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode; Ident : O_Ident; Storage : O_Storage; Atype : O_Tnode)
+   is
+      Decl : ValueRef;
+   begin
+      if Storage = O_Storage_Local then
+         Res := (Kind => ON_Local_Decl,
+                 LLVM => BuildAlloca
+                   (Decl_Builder, Get_LLVM_Type (Atype), Get_Cstring (Ident)),
+                 Dtype => Atype);
+         if Flag_Debug then
+            Dbg_Create_Variable (DW_TAG_Auto_Variable,
+                                 Ident, Atype, 0, Res.LLVM);
+         end if;
+      else
+         if Storage = O_Storage_External then
+            Decl := GetNamedGlobal (Module, Get_Cstring (Ident));
+         else
+            Decl := Null_ValueRef;
+         end if;
+         if Decl = Null_ValueRef then
+            Decl := AddGlobal
+              (Module, Get_LLVM_Type (Atype), Get_Cstring (Ident));
+         end if;
+
+         Res := (Kind => ON_Var_Decl, LLVM => Decl, Dtype => Atype);
+
+         --  Set linkage.
+         case Storage is
+            when O_Storage_Private =>
+               SetLinkage (Res.LLVM, InternalLinkage);
+            when O_Storage_Public
+              | O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               raise Program_Error;
+         end case;
+
+         --  Set initializer.
+         case Storage is
+            when O_Storage_Private
+              | O_Storage_Public =>
+               SetInitializer (Res.LLVM, ConstNull (Get_LLVM_Type (Atype)));
+            when O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               raise Program_Error;
+         end case;
+
+         if Flag_Debug then
+            Dbg_Add_Global_Var (Ident, Atype, Storage, Res);
+         end if;
+      end if;
+   end New_Var_Decl;
+
+   -------------------------
+   -- Start_Function_Decl --
+   -------------------------
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Interfaces := (Ident => Ident,
+                     Storage => Storage,
+                     Res_Type => Rtype,
+                     Nbr_Inter => 0,
+                     First_Inter => null,
+                     Last_Inter => null);
+   end Start_Function_Decl;
+
+   --------------------------
+   -- Start_Procedure_Decl --
+   --------------------------
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage)
+   is
+   begin
+      Interfaces := (Ident => Ident,
+                     Storage => Storage,
+                     Res_Type => O_Tnode_Null,
+                     Nbr_Inter => 0,
+                     First_Inter => null,
+                     Last_Inter => null);
+   end Start_Procedure_Decl;
+
+   ------------------------
+   -- New_Interface_Decl --
+   ------------------------
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode)
+   is
+      Inter : constant O_Inter_Acc := new O_Inter'(Itype => Atype,
+                                                   Ival => Null_ValueRef,
+                                                   Ident => Ident,
+                                                   Next => null);
+   begin
+      Res := (Kind => ON_Interface_Decl,
+              Dtype => Atype,
+              LLVM => Null_ValueRef,
+              Inter => Inter);
+      Interfaces.Nbr_Inter := Interfaces.Nbr_Inter + 1;
+      if Interfaces.First_Inter = null then
+         Interfaces.First_Inter := Inter;
+      else
+         Interfaces.Last_Inter.Next := Inter;
+      end if;
+      Interfaces.Last_Inter := Inter;
+   end New_Interface_Decl;
+
+   ----------------------------
+   -- Finish_Subprogram_Decl --
+   ----------------------------
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode)
+   is
+      Count : constant unsigned := unsigned (Interfaces.Nbr_Inter);
+      Inter : O_Inter_Acc;
+      Types : TypeRefArray (1 .. Count);
+      Ftype : TypeRef;
+      Rtype : TypeRef;
+      Decl : ValueRef;
+      Id : constant Cstring := Get_Cstring (Interfaces.Ident);
+   begin
+      --  Fill Types (from interfaces list)
+      Inter := Interfaces.First_Inter;
+      for I in 1 .. Count loop
+         Types (I) := Inter.Itype.LLVM;
+         Inter := Inter.Next;
+      end loop;
+
+      --  Build function type.
+      if Interfaces.Res_Type = O_Tnode_Null then
+         Rtype := VoidType;
+      else
+         Rtype := Interfaces.Res_Type.LLVM;
+      end if;
+      Ftype := FunctionType (Rtype, Types, Count, 0);
+
+      if Interfaces.Storage = O_Storage_External then
+         Decl := GetNamedFunction (Module, Id);
+      else
+         Decl := Null_ValueRef;
+      end if;
+      if Decl = Null_ValueRef then
+         Decl := AddFunction (Module, Id, Ftype);
+      end if;
+
+      Res := (Kind => ON_Subprg_Decl,
+              Dtype => Interfaces.Res_Type,
+              Subprg_Id => Interfaces.Ident,
+              Nbr_Args => Count,
+              Subprg_Inters => Interfaces.First_Inter,
+              LLVM => Decl);
+      SetFunctionCallConv (Res.LLVM, CCallConv);
+
+      --  Translate interfaces.
+      Inter := Interfaces.First_Inter;
+      for I in 1 .. Count loop
+         Inter.Ival := GetParam (Res.LLVM, I - 1);
+         SetValueName (Inter.Ival, Get_Cstring (Inter.Ident));
+         Inter := Inter.Next;
+      end loop;
+   end Finish_Subprogram_Decl;
+
+   ---------------------------
+   -- Start_Subprogram_Body --
+   ---------------------------
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+      --  Basic block at function entry that contains all the declarations.
+      Decl_BB : BasicBlockRef;
+   begin
+      if Cur_Func /= Null_ValueRef then
+         --  No support for nested subprograms.
+         raise Program_Error;
+      end if;
+
+      Cur_Func := Func.LLVM;
+      Cur_Func_Decl := Func;
+      Unreach := False;
+
+      Decl_BB := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      PositionBuilderAtEnd (Decl_Builder, Decl_BB);
+
+      Create_Declare_Block;
+
+      PositionBuilderAtEnd (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      if Flag_Debug then
+         declare
+            Type_Vals : ValueRefArray (0 .. Func.Nbr_Args);
+            Vals : ValueRefArray (0 .. 14);
+            Arg : O_Inter_Acc;
+            Subprg_Type : ValueRef;
+
+            Subprg_Vals : ValueRefArray (0 .. 19);
+            Name : ValueRef;
+         begin
+            Arg := Func.Subprg_Inters;
+            if Func.Dtype /= O_Tnode_Null then
+               Type_Vals (0) := Func.Dtype.Dbg;
+            else
+               --  Void
+               Type_Vals (0) := Null_ValueRef;
+            end if;
+            for I in 1 .. Type_Vals'Last loop
+               Type_Vals (I) := Arg.Itype.Dbg;
+               Arg := Arg.Next;
+            end loop;
+            Vals :=
+              (ConstInt (Int32Type, DW_TAG_Subroutine_Type, 0),
+               ConstInt (Int32Type, 0, 0),  --  1 ??
+               Null_ValueRef,               --  2 Context
+               MDString (Empty_Cstring, 0), --  3 name
+               ConstInt (Int32Type, 0, 0),  --  4 linenum
+               ConstInt (Int64Type, 0, 0),  --  5 size
+               ConstInt (Int64Type, 0, 0),  --  6 align
+               ConstInt (Int64Type, 0, 0),  --  7 offset
+               ConstInt (Int32Type, 0, 0),  --  8 flags
+               Null_ValueRef,               --  9 derived from
+               MDNode (Type_Vals, Type_Vals'Length), --  10 type
+               ConstInt (Int32Type, 0, 0),  --  11 runtime lang
+               Null_ValueRef,               --  12 containing type
+               Null_ValueRef,               --  13 template params
+               Null_ValueRef);              --  14 ??
+            Subprg_Type := MDNode (Vals, Vals'Length);
+
+            --  Create TAG_subprogram.
+            Name := MDString (Func.Subprg_Id);
+
+            Subprg_Vals :=
+              (ConstInt (Int32Type, DW_TAG_Subprogram, 0),
+               Dbg_Current_Filedir,             --  1 loc
+               Dbg_Current_File,                --  2 context
+               Name,                            --  3 name
+               Name,                            --  4 display name
+               Null_ValueRef,                   --  5 linkage name
+               Dbg_Line,                        --  6 line num
+               Subprg_Type,                     --  7 type
+               ConstInt (Int1Type, 0, 0),       --  8 islocal (FIXME)
+               ConstInt (Int1Type, 1, 0),       --  9 isdef (FIXME)
+               ConstInt (Int32Type, 0, 0),      --  10 virtuality
+               ConstInt (Int32Type, 0, 0),      --  11 virtual index
+               Null_ValueRef,                   --  12 containing type
+               ConstInt (Int32Type, 256, 0),    --  13 flags: prototyped
+               ConstInt (Int1Type, 0, 0),       --  14 isOpt (FIXME)
+               Cur_Func,                        --  15 function
+               Null_ValueRef,                   --  16 template param
+               Null_ValueRef,                   --  17 function decl
+               Null_ValueRef,                   --  18 variables ???
+               Dbg_Line);                       --  19 scope ln
+            Cur_Declare_Block.Dbg_Scope :=
+              MDNode (Subprg_Vals, Subprg_Vals'Length);
+            Append (Subprg_Nodes, Cur_Declare_Block.Dbg_Scope);
+            Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+         end;
+
+         --  Create local variables for arguments.
+         declare
+            Arg : O_Inter_Acc;
+            Tmp : ValueRef;
+            St : ValueRef;
+            pragma Unreferenced (St);
+            Argno : Natural;
+         begin
+            Arg := Func.Subprg_Inters;
+            Argno := 1;
+            while Arg /= null loop
+               Tmp := BuildAlloca (Decl_Builder, Get_LLVM_Type (Arg.Itype),
+                                   Empty_Cstring);
+               Dbg_Create_Variable (DW_TAG_Arg_Variable,
+                                    Arg.Ident, Arg.Itype, Argno, Tmp);
+               St := BuildStore (Decl_Builder, Arg.Ival, Tmp);
+               Arg.Ival := Tmp;
+
+               Arg := Arg.Next;
+               Argno := Argno + 1;
+            end loop;
+         end;
+      end if;
+   end Start_Subprogram_Body;
+
+   ----------------------------
+   -- Finish_Subprogram_Body --
+   ----------------------------
+
+   procedure Finish_Subprogram_Body is
+      Ret : ValueRef;
+      pragma Unreferenced (Ret);
+   begin
+      --  Add a jump from the declare basic block to the first statement BB.
+      Ret := BuildBr (Decl_Builder, Cur_Declare_Block.Stmt_Bb);
+
+      --  Terminate the statement BB.
+      if not Unreach then
+         if Cur_Func_Decl.Dtype = O_Tnode_Null then
+            Ret := BuildRetVoid (Builder);
+         else
+            Ret := BuildUnreachable (Builder);
+         end if;
+      end if;
+
+      Destroy_Declare_Block;
+
+      Cur_Func := Null_ValueRef;
+      Dbg_Current_Scope := Null_ValueRef;
+   end Finish_Subprogram_Body;
+
+   -------------------------
+   -- New_Debug_Line_Stmt --
+   -------------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural) is
+   begin
+      Dbg_Current_Line := unsigned (Line);
+   end New_Debug_Line_Stmt;
+
+   ----------------------------
+   -- New_Debug_Comment_Stmt --
+   ----------------------------
+
+   procedure New_Debug_Comment_Stmt (Comment : String) is
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   ------------------------
+   -- Start_Declare_Stmt --
+   ------------------------
+
+   procedure Start_Declare_Stmt
+   is
+      Br : ValueRef;
+      pragma Unreferenced (Br);
+   begin
+      Create_Declare_Block;
+
+      if Unreach then
+         return;
+      end if;
+
+      --  Add a jump to the new BB.
+      Br := BuildBr (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      PositionBuilderAtEnd (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      if Flag_Debug then
+         declare
+            Vals : ValueRefArray (0 .. 5);
+         begin
+            Vals :=
+              (ConstInt (Int32Type, DW_TAG_Lexical_Block, 0),
+               Dbg_Current_Filedir,             --  1 loc
+               Dbg_Current_Scope,               --  2 context
+               Dbg_Line,                        --  3 line num
+               ConstInt (Int32Type, 0, 0),       --  4 col
+               ConstInt (Int32Type, Scope_Uniq_Id, 0));
+            Cur_Declare_Block.Dbg_Scope := MDNode (Vals, Vals'Length);
+            Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+            Scope_Uniq_Id := Scope_Uniq_Id + 1;
+         end;
+      end if;
+   end Start_Declare_Stmt;
+
+   -------------------------
+   -- Finish_Declare_Stmt --
+   -------------------------
+
+   procedure Finish_Declare_Stmt
+   is
+      Bb : BasicBlockRef;
+      Br : ValueRef;
+      Tmp : ValueRef;
+      pragma Unreferenced (Br, Tmp);
+   begin
+      if not Unreach then
+         --  Create a basic block for the statements after the declare.
+         Bb := AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+         if Cur_Declare_Block.Stack_Value /= Null_ValueRef then
+            --  Restore stack pointer.
+            Tmp := BuildCall (Builder, Stackrestore_Fun,
+                              (1 .. 1 => Cur_Declare_Block.Stack_Value), 1,
+                              Empty_Cstring);
+         end if;
+
+         --  Execution will continue on the next statement
+         Br := BuildBr (Builder, Bb);
+
+         PositionBuilderAtEnd (Builder, Bb);
+      end if;
+
+      --  Do not reset Unread.
+
+      Destroy_Declare_Block;
+
+      Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+   end Finish_Declare_Stmt;
+
+   -----------------------
+   -- Start_Association --
+   -----------------------
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+   begin
+      Assocs := (Subprg => Subprg,
+                 Idx => 0,
+                 Vals => new ValueRefArray (1 .. Subprg.Nbr_Args));
+   end Start_Association;
+
+   ---------------------
+   -- New_Association --
+   ---------------------
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode) is
+   begin
+      Assocs.Idx := Assocs.Idx + 1;
+      Assocs.Vals (Assocs.Idx) := Val.LLVM;
+   end New_Association;
+
+   -----------------------
+   -- New_Function_Call --
+   -----------------------
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+      Res : ValueRef;
+      Old_Vals : ValueRefArray_Acc;
+   begin
+      Res := BuildCall (Builder, Assocs.Subprg.LLVM,
+                        Assocs.Vals.all, Assocs.Vals'Last, Empty_Cstring);
+      Old_Vals := Assocs.Vals;
+      Free (Old_Vals);
+      Set_Insn_Dbg (Res);
+      return O_Enode'(LLVM => Res, Etype => Assocs.Subprg.Dtype);
+   end New_Function_Call;
+
+   ------------------------
+   -- New_Procedure_Call --
+   ------------------------
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List)
+   is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildCall (Builder, Assocs.Subprg.LLVM,
+                           Assocs.Vals.all, Assocs.Vals'Last, Empty_Cstring);
+         Set_Insn_Dbg (Res);
+      end if;
+      Free (Assocs.Vals);
+   end New_Procedure_Call;
+
+   ---------------------
+   -- New_Assign_Stmt --
+   ---------------------
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      Res : ValueRef;
+   begin
+      if Target.Direct then
+         raise Program_Error;
+      end if;
+      if not Unreach then
+         Res := BuildStore (Builder, Value.LLVM, Target.LLVM);
+         Set_Insn_Dbg (Res);
+      end if;
+   end New_Assign_Stmt;
+
+   ---------------------
+   -- New_Return_Stmt --
+   ---------------------
+
+   procedure New_Return_Stmt (Value : O_Enode) is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         return;
+      end if;
+      Res := BuildRet (Builder, Value.LLVM);
+      Set_Insn_Dbg (Res);
+      Unreach := True;
+   end New_Return_Stmt;
+
+   ---------------------
+   -- New_Return_Stmt --
+   ---------------------
+
+   procedure New_Return_Stmt is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         return;
+      end if;
+      Res := BuildRetVoid (Builder);
+      Set_Insn_Dbg (Res);
+      Unreach := True;
+   end New_Return_Stmt;
+
+   -------------------
+   -- Start_If_Stmt --
+   -------------------
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode) is
+      Res : ValueRef;
+      Bb_Then : BasicBlockRef;
+   begin
+      --  FIXME: check Unreach
+      Bb_Then := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      Block := (Bb => AppendBasicBlock (Cur_Func, Empty_Cstring));
+      Res := BuildCondBr (Builder, Cond.LLVM, Bb_Then, Block.Bb);
+      Set_Insn_Dbg (Res);
+
+      PositionBuilderAtEnd (Builder, Bb_Then);
+   end Start_If_Stmt;
+
+   -------------------
+   -- New_Else_Stmt --
+   -------------------
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+      Bb_Next : BasicBlockRef;
+   begin
+      if not Unreach then
+         Bb_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         Res := BuildBr (Builder, Bb_Next);
+      else
+         Bb_Next := Null_BasicBlockRef;
+      end if;
+
+      PositionBuilderAtEnd (Builder, Block.Bb);
+
+      Block := (Bb => Bb_Next);
+      Unreach := False;
+   end New_Else_Stmt;
+
+   --------------------
+   -- Finish_If_Stmt --
+   --------------------
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+      Bb_Next : BasicBlockRef;
+   begin
+      if not Unreach then
+         --  The branch can continue.
+         if Block.Bb = Null_BasicBlockRef then
+            Bb_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         else
+            Bb_Next := Block.Bb;
+         end if;
+         Res := BuildBr (Builder, Bb_Next);
+         PositionBuilderAtEnd (Builder, Bb_Next);
+      else
+         --  The branch doesn't continue.
+         if Block.Bb /= Null_BasicBlockRef then
+            --  There is a fall-through (either from the then branch, or
+            --  there is no else).
+            Unreach := False;
+            PositionBuilderAtEnd (Builder, Block.Bb);
+         else
+            Unreach := True;
+         end if;
+      end if;
+   end Finish_If_Stmt;
+
+   ---------------------
+   -- Start_Loop_Stmt --
+   ---------------------
+
+   procedure Start_Loop_Stmt (Label : out O_Snode)
+   is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      --  FIXME: check Unreach
+      Label := (Bb_Entry => AppendBasicBlock (Cur_Func, Empty_Cstring),
+                Bb_Exit => AppendBasicBlock (Cur_Func, Empty_Cstring));
+      Res := BuildBr (Builder, Label.Bb_Entry);
+      PositionBuilderAtEnd (Builder, Label.Bb_Entry);
+   end Start_Loop_Stmt;
+
+   ----------------------
+   -- Finish_Loop_Stmt --
+   ----------------------
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, Label.Bb_Entry);
+      end if;
+      if Label.Bb_Exit /= Null_BasicBlockRef then
+         --  FIXME: always true...
+         PositionBuilderAtEnd (Builder, Label.Bb_Exit);
+         Unreach := False;
+      else
+         Unreach := True;
+      end if;
+   end Finish_Loop_Stmt;
+
+   -------------------
+   -- New_Exit_Stmt --
+   -------------------
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, L.Bb_Exit);
+         Set_Insn_Dbg (Res);
+         Unreach := True;
+      end if;
+   end New_Exit_Stmt;
+
+   -------------------
+   -- New_Next_Stmt --
+   -------------------
+
+   procedure New_Next_Stmt (L : O_Snode) is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, L.Bb_Entry);
+         Set_Insn_Dbg (Res);
+         Unreach := True;
+      end if;
+   end New_Next_Stmt;
+
+   ---------------------
+   -- Start_Case_Stmt --
+   ---------------------
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode) is
+   begin
+      Block := (BB_Prev => GetInsertBlock (Builder),
+                Value => Value.LLVM,
+                Vtype => Value.Etype,
+                BB_Next => Null_BasicBlockRef,
+                BB_Others => Null_BasicBlockRef,
+                BB_Choice => Null_BasicBlockRef,
+                Nbr_Choices => 0,
+                Choices => new O_Choice_Array (1 .. 8));
+   end Start_Case_Stmt;
+
+   ------------------
+   -- Start_Choice --
+   ------------------
+
+   procedure Finish_Branch (Block : in out O_Case_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      --  Close previous branch.
+      if not Unreach then
+         if Block.BB_Next = Null_BasicBlockRef then
+            Block.BB_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         end if;
+         Res := BuildBr (Builder, Block.BB_Next);
+      end if;
+   end Finish_Branch;
+
+   procedure Start_Choice (Block : in out O_Case_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      if Block.BB_Choice /= Null_BasicBlockRef then
+         --  Close previous branch.
+         Finish_Branch (Block);
+      end if;
+
+      Unreach := False;
+      Block.BB_Choice := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      PositionBuilderAtEnd (Builder, Block.BB_Choice);
+   end Start_Choice;
+
+   ---------------------
+   -- New_Expr_Choice --
+   ---------------------
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (O_Choice_Array, O_Choice_Array_Acc);
+
+   procedure New_Choice (Block : in out O_Case_Block;
+                         Low, High : ValueRef)
+   is
+      Choices : O_Choice_Array_Acc;
+   begin
+      if Block.Nbr_Choices = Block.Choices'Last then
+         Choices := new O_Choice_Array (1 .. Block.Choices'Last * 2);
+         Choices (1 .. Block.Choices'Last) := Block.Choices.all;
+         Free (Block.Choices);
+         Block.Choices := Choices;
+      end if;
+      Block.Nbr_Choices := Block.Nbr_Choices + 1;
+      Block.Choices (Block.Nbr_Choices) := (Low => Low,
+                                            High => High,
+                                            Bb => Block.BB_Choice);
+   end New_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode) is
+   begin
+      New_Choice (Block, Expr.LLVM, Null_ValueRef);
+   end New_Expr_Choice;
+
+   ----------------------
+   -- New_Range_Choice --
+   ----------------------
+
+   procedure New_Range_Choice
+     (Block : in out O_Case_Block; Low, High : O_Cnode)
+   is
+   begin
+      New_Choice (Block, Low.LLVM, High.LLVM);
+   end New_Range_Choice;
+
+   ------------------------
+   -- New_Default_Choice --
+   ------------------------
+
+   procedure New_Default_Choice (Block : in out O_Case_Block) is
+   begin
+      Block.BB_Others := Block.BB_Choice;
+   end New_Default_Choice;
+
+   -------------------
+   -- Finish_Choice --
+   -------------------
+
+   procedure Finish_Choice (Block : in out O_Case_Block) is
+   begin
+      null;
+   end Finish_Choice;
+
+   ----------------------
+   -- Finish_Case_Stmt --
+   ----------------------
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block)
+   is
+      Bb_Default : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+      Bb_Default_Last : BasicBlockRef;
+      Nbr_Cases : unsigned := 0;
+      GE, LE : IntPredicate;
+      Res : ValueRef;
+   begin
+      if Block.BB_Choice /= Null_BasicBlockRef then
+         --  Close previous branch.
+         Finish_Branch (Block);
+      end if;
+
+      --  Strategy: use a switch instruction for simple choices, put range
+      --   choices in the default using if statements.
+      case Block.Vtype.Kind is
+         when ON_Unsigned_Type
+           | ON_Enum_Type
+           | ON_Boolean_Type =>
+            GE := IntUGE;
+            LE := IntULE;
+         when ON_Signed_Type =>
+            GE := IntSGE;
+            LE := IntSLE;
+         when others =>
+            raise Program_Error;
+      end case;
+
+      --  BB for the default case of the LLVM switch.
+      PositionBuilderAtEnd (Builder, Bb_Default);
+      Bb_Default_Last := Bb_Default;
+
+      for I in 1 .. Block.Nbr_Choices loop
+         declare
+            C : O_Choice_Type renames Block.Choices (I);
+         begin
+            if C.High /= Null_ValueRef then
+               Bb_Default_Last := AppendBasicBlock (Cur_Func, Empty_Cstring);
+               Res := BuildCondBr (Builder,
+                                   BuildAnd (Builder,
+                                             BuildICmp (Builder, GE,
+                                                        Block.Value, C.Low,
+                                                        Empty_Cstring),
+                                             BuildICmp (Builder, LE,
+                                                        Block.Value, C.High,
+                                                        Empty_Cstring),
+                                             Empty_Cstring),
+                                   C.Bb, Bb_Default_Last);
+               PositionBuilderAtEnd (Builder, Bb_Default_Last);
+            else
+               Nbr_Cases := Nbr_Cases + 1;
+            end if;
+         end;
+      end loop;
+
+      --  Insert the switch
+      PositionBuilderAtEnd (Builder, Block.BB_Prev);
+      Res := BuildSwitch (Builder, Block.Value, Bb_Default, Nbr_Cases);
+      for I in 1 .. Block.Nbr_Choices loop
+         declare
+            C : O_Choice_Type renames Block.Choices (I);
+         begin
+            if C.High = Null_ValueRef then
+               AddCase (Res, C.Low, C.Bb);
+            end if;
+         end;
+      end loop;
+
+      --  Insert the others.
+      PositionBuilderAtEnd (Builder, Bb_Default_Last);
+      if Block.BB_Others /= Null_BasicBlockRef then
+         Res := BuildBr (Builder, Block.BB_Others);
+      else
+         Res := BuildUnreachable (Builder);
+      end if;
+
+      if Block.BB_Next /= Null_BasicBlockRef then
+         Unreach := False;
+         PositionBuilderAtEnd (Builder, Block.BB_Next);
+      else
+         Unreach := True;
+      end if;
+
+      Free (Block.Choices);
+   end Finish_Case_Stmt;
+
+   function Get_LLVM_Type (Atype : O_Tnode) return TypeRef is
+   begin
+      case Atype.Kind is
+         when ON_Incomplete_Record_Type
+           | ON_Incomplete_Access_Type =>
+            if Atype.LLVM = Null_TypeRef then
+               raise Program_Error with "early use of incomplete type";
+            end if;
+            return Atype.LLVM;
+         when ON_Union_Type
+           | ON_Scalar_Types
+           | ON_Access_Type
+           | ON_Array_Type
+           | ON_Array_Sub_Type
+           | ON_Record_Type =>
+            return Atype.LLVM;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Get_LLVM_Type;
+
+   procedure Finish_Debug is
+   begin
+      declare
+         Dbg_Cu : constant String := "llvm.dbg.cu" & ASCII.NUL;
+         Producer : constant String := "ortho llvm";
+         Vals : ValueRefArray (0 .. 12);
+      begin
+         Vals :=
+           (ConstInt (Int32Type, DW_TAG_Compile_Unit, 0),
+            Dbg_Current_Filedir,         --  1 file+dir
+            ConstInt (Int32Type, 1, 0),  --  2 language (C)
+            MDString (Producer),         --  3 producer
+            ConstInt (Int1Type, 0, 0),   --  4 isOpt
+            MDString (""),               --  5 flags
+            ConstInt (Int32Type, 0, 0),  --  6 runtime version
+            Null_ValueRef,               --  7 enum types
+            Null_ValueRef,               --  8 retained types
+            Get_Value (Subprg_Nodes),    --  9 subprograms
+            Get_Value (Global_Nodes),    --  10 global var
+            Null_ValueRef,               --  11 imported entities
+            Null_ValueRef);              --  12 split debug
+
+         AddNamedMetadataOperand
+           (Module, Dbg_Cu'Address, MDNode (Vals, Vals'Length));
+      end;
+
+      declare
+         Module_Flags : constant String := "llvm.module.flags" & ASCII.NUL;
+         Flags1 : ValueRefArray (0 .. 2);
+         Flags2 : ValueRefArray (0 .. 2);
+      begin
+         Flags1 := (ConstInt (Int32Type, 1, 0),
+                    MDString ("Debug Info Version"),
+                    ConstInt (Int32Type, 1, 0));
+         AddNamedMetadataOperand
+           (Module, Module_Flags'Address, MDNode (Flags1, Flags1'Length));
+         Flags2 := (ConstInt (Int32Type, 2, 0),
+                    MDString ("Dwarf Version"),
+                    ConstInt (Int32Type, 2, 0));
+         AddNamedMetadataOperand
+           (Module, Module_Flags'Address, MDNode (Flags2, Flags2'Length));
+      end;
+   end Finish_Debug;
+
+   Dbg_Str : constant String := "dbg";
+
+   procedure Init is
+      --  Some predefined types and functions.
+      I8_Ptr_Type : TypeRef;
+   begin
+      Builder := CreateBuilder;
+      Decl_Builder := CreateBuilder;
+      Extra_Builder := CreateBuilder;
+
+      --  Create type i8 *.
+      I8_Ptr_Type := PointerType (Int8Type);
+
+      --  Create intrinsic 'i8 *stacksave (void)'.
+      Stacksave_Fun := AddFunction
+        (Module, Stacksave_Name'Address,
+         FunctionType (I8_Ptr_Type, (1 .. 0 => Null_TypeRef), 0, 0));
+
+      --  Create intrinsic 'void stackrestore (i8 *)'.
+      Stackrestore_Fun := AddFunction
+        (Module, Stackrestore_Name'Address,
+         FunctionType (VoidType, (1 => I8_Ptr_Type), 1, 0));
+
+      if Flag_Debug then
+         Debug_ID := GetMDKindID (Dbg_Str, Dbg_Str'Length);
+
+         declare
+            Atypes : TypeRefArray (1 .. 2);
+            Ftype : TypeRef;
+            Name : String := "llvm.dbg.declare" & ASCII.NUL;
+         begin
+            Atypes := (MetadataType, MetadataType);
+            Ftype := FunctionType (VoidType, Atypes, Atypes'Length, 0);
+            Llvm_Dbg_Declare := AddFunction (Module, Name'Address, Ftype);
+            AddFunctionAttr (Llvm_Dbg_Declare,
+                             NoUnwindAttribute + ReadNoneAttribute);
+         end;
+      end if;
+   end Init;
+
+end Ortho_LLVM;
diff --git a/src/ortho/llvm/ortho_llvm.ads b/src/ortho/llvm/ortho_llvm.ads
new file mode 100644
index 000000000..8e68eb139
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm.ads
@@ -0,0 +1,737 @@
+--  DO NOT MODIFY - this file was generated from:
+--  ortho_nodes.common.ads and ortho_llvm.private.ads
+--
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Interfaces; use Interfaces;
+with Interfaces.C; use Interfaces.C;
+with Ortho_Ident; use Ortho_Ident;
+with LLVM.Core; use LLVM.Core;
+with LLVM.TargetMachine;
+with LLVM.Target;
+
+--  Interface to create nodes.
+package Ortho_LLVM is
+   procedure Init;
+   procedure Finish_Debug;
+
+   --  LLVM specific: the module.
+   Module : ModuleRef;
+
+   --  Descriptor for the layout.
+   Target_Data : LLVM.Target.TargetDataRef;
+
+   Target_Machine : LLVM.TargetMachine.TargetMachineRef;
+
+   --  Optimization level
+   Optimization : LLVM.TargetMachine.CodeGenOptLevel :=
+     LLVM.TargetMachine.CodeGenLevelDefault;
+
+   --  Set by -g to generate debug info.
+   Flag_Debug : Boolean := False;
+
+--  Start of common part
+
+   type O_Enode is private;
+   type O_Cnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+   type O_Dnode is private;
+   type O_Fnode is private;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+   --  True if the code generated supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+--  End of common part
+private
+   --  No support for nested subprograms in LLVM.
+   Has_Nested_Subprograms : constant Boolean := False;
+
+   type O_Tnode_Type (<>);
+   type O_Tnode is access O_Tnode_Type;
+   O_Tnode_Null : constant O_Tnode := null;
+
+   type ON_Type_Kind is
+     (ON_No_Type,
+      ON_Unsigned_Type, ON_Signed_Type, ON_Enum_Type, ON_Boolean_Type,
+      ON_Float_Type,
+      ON_Array_Type, ON_Array_Sub_Type,
+      ON_Incomplete_Record_Type,
+      ON_Record_Type, ON_Union_Type,
+      ON_Incomplete_Access_Type, ON_Access_Type);
+
+   subtype ON_Scalar_Types is ON_Type_Kind range
+     ON_Unsigned_Type .. ON_Float_Type;
+
+   subtype ON_Integer_Types is ON_Type_Kind range
+     ON_Unsigned_Type .. ON_Boolean_Type;
+
+   type O_Tnode_Type (Kind : ON_Type_Kind := ON_No_Type) is record
+      LLVM : TypeRef;
+      Dbg : ValueRef;
+      case Kind is
+         when ON_No_Type =>
+            null;
+         when ON_Union_Type =>
+            Un_Size : unsigned;
+            Un_Main_Field : TypeRef;
+         when ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            Acc_Type : O_Tnode;
+         when ON_Scalar_Types =>
+            Scal_Size : Natural;
+         when ON_Array_Type
+           | ON_Array_Sub_Type =>
+            --  Type of the element
+            Arr_El_Type : O_Tnode;
+         when ON_Record_Type
+           | ON_Incomplete_Record_Type =>
+            null;
+      end case;
+   end record;
+
+   type O_Inter;
+   type O_Inter_Acc is access O_Inter;
+   type O_Inter is record
+      Itype : O_Tnode;
+      Ival : ValueRef;
+      Ident : O_Ident;
+      Next : O_Inter_Acc;
+   end record;
+
+   type On_Decl_Kind is
+     (ON_Type_Decl, ON_Completed_Type_Decl,
+      ON_Const_Decl,
+      ON_Var_Decl, ON_Local_Decl, ON_Interface_Decl,
+      ON_Subprg_Decl,
+      ON_No_Decl);
+
+   type O_Dnode (Kind : On_Decl_Kind := ON_No_Decl) is record
+      Dtype : O_Tnode;
+      LLVM : ValueRef;
+      case Kind is
+         when ON_Var_Decl
+           | ON_Const_Decl
+           | ON_Local_Decl =>
+            null;
+         when ON_Subprg_Decl =>
+            Subprg_Id : O_Ident;
+            Nbr_Args : unsigned;
+            Subprg_Inters : O_Inter_Acc;
+         when ON_Interface_Decl =>
+            Inter : O_Inter_Acc;
+         when others =>
+            null;
+      end case;
+   end record;
+
+   O_Dnode_Null : constant O_Dnode := (Kind => ON_No_Decl,
+                                       Dtype => O_Tnode_Null,
+                                       LLVM => Null_ValueRef);
+
+   type OF_Kind is (OF_None, OF_Record, OF_Union);
+   type O_Fnode (Kind : OF_Kind := OF_None) is record
+      Ftype : O_Tnode;
+      case Kind is
+         when OF_None =>
+            null;
+         when OF_Record =>
+            Index : Natural;
+         when OF_Union =>
+            Utype : TypeRef;
+      end case;
+   end record;
+
+   O_Fnode_Null : constant O_Fnode := (Kind => OF_None,
+                                       Ftype => O_Tnode_Null);
+
+   type O_Anode_Type;
+   type O_Anode is access O_Anode_Type;
+   type O_Anode_Type is record
+      Next : O_Anode;
+      Formal : O_Dnode;
+      Actual : O_Enode;
+   end record;
+
+   type O_Cnode is record
+      LLVM : ValueRef;
+      Ctype : O_Tnode;
+   end record;
+   O_Cnode_Null : constant O_Cnode := (LLVM => Null_ValueRef,
+                                       Ctype => O_Tnode_Null);
+
+   type O_Enode is record
+      LLVM : ValueRef;
+      Etype : O_Tnode;
+   end record;
+   O_Enode_Null : constant O_Enode := (LLVM => Null_ValueRef,
+                                       Etype => O_Tnode_Null);
+
+
+   type O_Lnode is record
+      --  If True, the LLVM component is the value (used for arguments).
+      --  If False, the LLVM component is the address of the value (used
+      --   for everything else).
+      Direct : Boolean;
+      LLVM : ValueRef;
+      Ltype : O_Tnode;
+   end record;
+
+   O_Lnode_Null : constant O_Lnode := (False, Null_ValueRef, O_Tnode_Null);
+
+   type O_Snode is record
+      --  First BB in the loop body.
+      Bb_Entry : BasicBlockRef;
+
+      --  BB after the loop.
+      Bb_Exit : BasicBlockRef;
+   end record;
+
+   O_Snode_Null : constant O_Snode := (Null_BasicBlockRef,
+                                       Null_BasicBlockRef);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Res_Type : O_Tnode;
+      Nbr_Inter : Natural;
+      First_Inter, Last_Inter : O_Inter_Acc;
+   end record;
+
+   type O_Element;
+   type O_Element_Acc is access O_Element;
+   type O_Element is record
+      --  Identifier for the element
+      Ident : O_Ident;
+
+      --  Type of the element
+      Etype : O_Tnode;
+
+      --  Next element (in the linked list)
+      Next : O_Element_Acc;
+   end record;
+
+   --  Record and union builder.
+   type O_Element_List is record
+      Nbr_Elements : Natural;
+
+      --  For record: the access to the incomplete (but named) type.
+      Rec_Type : O_Tnode;
+
+      --  For unions: biggest for size and alignment
+      Size : unsigned;
+      Align : Unsigned_32;
+      Align_Type : TypeRef;
+
+      First_Elem, Last_Elem : O_Element_Acc;
+   end record;
+
+   type ValueRefArray_Acc is access ValueRefArray;
+
+   type O_Record_Aggr_List is record
+      --  Current number of elements in Vals.
+      Len : unsigned;
+
+      --  Value of elements.
+      Vals : ValueRefArray_Acc;
+
+      --  Type of the aggregate.
+      Atype : O_Tnode;
+   end record;
+
+   type O_Array_Aggr_List is record
+      --  Current number of elements in Vals.
+      Len : unsigned;
+
+      --  Value of elements.
+      Vals : ValueRefArray_Acc;
+      El_Type : TypeRef;
+
+      --  Type of the aggregate.
+      Atype : O_Tnode;
+   end record;
+
+   type O_Assoc_List is record
+      Subprg : O_Dnode;
+      Idx : unsigned;
+      Vals : ValueRefArray_Acc;
+   end record;
+
+   type O_Enum_List is record
+      LLVM : TypeRef;
+      Num : Natural;
+      Etype : O_Tnode;
+   end record;
+
+   type O_Choice_Type is record
+      Low, High : ValueRef;
+      Bb : BasicBlockRef;
+   end record;
+
+   type O_Choice_Array is array (Natural range <>) of O_Choice_Type;
+   type O_Choice_Array_Acc is access O_Choice_Array;
+
+   type O_Case_Block is record
+      --  BB before the case.
+      BB_Prev : BasicBlockRef;
+
+      --  Select expression
+      Value : ValueRef;
+      Vtype : O_Tnode;
+
+      --  BB after the case statement.
+      BB_Next : BasicBlockRef;
+
+      --  BB for others
+      BB_Others : BasicBlockRef;
+
+      --  BB for the current choice
+      BB_Choice : BasicBlockRef;
+
+      --  List of choices.
+      Nbr_Choices : Natural;
+      Choices : O_Choice_Array_Acc;
+   end record;
+
+   type O_If_Block is record
+      --  The next basic block.
+      --  After the 'If', this is the BB for the else part.  If there is no
+      --   else part, this is the BB for statements after the if.
+      --  After the 'else', this is the BB for statements after the if.
+      Bb : BasicBlockRef;
+   end record;
+
+   function Get_LLVM_Type (Atype : O_Tnode) return TypeRef;
+end Ortho_LLVM;
diff --git a/src/ortho/llvm/ortho_llvm.private.ads b/src/ortho/llvm/ortho_llvm.private.ads
new file mode 100644
index 000000000..842a119b5
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm.private.ads
@@ -0,0 +1,305 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Interfaces; use Interfaces;
+with Interfaces.C; use Interfaces.C;
+with Ortho_Ident; use Ortho_Ident;
+with LLVM.Core; use LLVM.Core;
+with LLVM.TargetMachine;
+with LLVM.Target;
+
+--  Interface to create nodes.
+package Ortho_LLVM is
+   procedure Init;
+   procedure Finish_Debug;
+
+   --  LLVM specific: the module.
+   Module : ModuleRef;
+
+   --  Descriptor for the layout.
+   Target_Data : LLVM.Target.TargetDataRef;
+
+   Target_Machine : LLVM.TargetMachine.TargetMachineRef;
+
+   --  Optimization level
+   Optimization : LLVM.TargetMachine.CodeGenOptLevel :=
+     LLVM.TargetMachine.CodeGenLevelDefault;
+
+   --  Set by -g to generate debug info.
+   Flag_Debug : Boolean := False;
+
+private
+   --  No support for nested subprograms in LLVM.
+   Has_Nested_Subprograms : constant Boolean := False;
+
+   type O_Tnode_Type (<>);
+   type O_Tnode is access O_Tnode_Type;
+   O_Tnode_Null : constant O_Tnode := null;
+
+   type ON_Type_Kind is
+     (ON_No_Type,
+      ON_Unsigned_Type, ON_Signed_Type, ON_Enum_Type, ON_Boolean_Type,
+      ON_Float_Type,
+      ON_Array_Type, ON_Array_Sub_Type,
+      ON_Incomplete_Record_Type,
+      ON_Record_Type, ON_Union_Type,
+      ON_Incomplete_Access_Type, ON_Access_Type);
+
+   subtype ON_Scalar_Types is ON_Type_Kind range
+     ON_Unsigned_Type .. ON_Float_Type;
+
+   subtype ON_Integer_Types is ON_Type_Kind range
+     ON_Unsigned_Type .. ON_Boolean_Type;
+
+   type O_Tnode_Type (Kind : ON_Type_Kind := ON_No_Type) is record
+      LLVM : TypeRef;
+      Dbg : ValueRef;
+      case Kind is
+         when ON_No_Type =>
+            null;
+         when ON_Union_Type =>
+            Un_Size : unsigned;
+            Un_Main_Field : TypeRef;
+         when ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            Acc_Type : O_Tnode;
+         when ON_Scalar_Types =>
+            Scal_Size : Natural;
+         when ON_Array_Type
+           | ON_Array_Sub_Type =>
+            --  Type of the element
+            Arr_El_Type : O_Tnode;
+         when ON_Record_Type
+           | ON_Incomplete_Record_Type =>
+            null;
+      end case;
+   end record;
+
+   type O_Inter;
+   type O_Inter_Acc is access O_Inter;
+   type O_Inter is record
+      Itype : O_Tnode;
+      Ival : ValueRef;
+      Ident : O_Ident;
+      Next : O_Inter_Acc;
+   end record;
+
+   type On_Decl_Kind is
+     (ON_Type_Decl, ON_Completed_Type_Decl,
+      ON_Const_Decl,
+      ON_Var_Decl, ON_Local_Decl, ON_Interface_Decl,
+      ON_Subprg_Decl,
+      ON_No_Decl);
+
+   type O_Dnode (Kind : On_Decl_Kind := ON_No_Decl) is record
+      Dtype : O_Tnode;
+      LLVM : ValueRef;
+      case Kind is
+         when ON_Var_Decl
+           | ON_Const_Decl
+           | ON_Local_Decl =>
+            null;
+         when ON_Subprg_Decl =>
+            Subprg_Id : O_Ident;
+            Nbr_Args : unsigned;
+            Subprg_Inters : O_Inter_Acc;
+         when ON_Interface_Decl =>
+            Inter : O_Inter_Acc;
+         when others =>
+            null;
+      end case;
+   end record;
+
+   O_Dnode_Null : constant O_Dnode := (Kind => ON_No_Decl,
+                                       Dtype => O_Tnode_Null,
+                                       LLVM => Null_ValueRef);
+
+   type OF_Kind is (OF_None, OF_Record, OF_Union);
+   type O_Fnode (Kind : OF_Kind := OF_None) is record
+      Ftype : O_Tnode;
+      case Kind is
+         when OF_None =>
+            null;
+         when OF_Record =>
+            Index : Natural;
+         when OF_Union =>
+            Utype : TypeRef;
+      end case;
+   end record;
+
+   O_Fnode_Null : constant O_Fnode := (Kind => OF_None,
+                                       Ftype => O_Tnode_Null);
+
+   type O_Anode_Type;
+   type O_Anode is access O_Anode_Type;
+   type O_Anode_Type is record
+      Next : O_Anode;
+      Formal : O_Dnode;
+      Actual : O_Enode;
+   end record;
+
+   type O_Cnode is record
+      LLVM : ValueRef;
+      Ctype : O_Tnode;
+   end record;
+   O_Cnode_Null : constant O_Cnode := (LLVM => Null_ValueRef,
+                                       Ctype => O_Tnode_Null);
+
+   type O_Enode is record
+      LLVM : ValueRef;
+      Etype : O_Tnode;
+   end record;
+   O_Enode_Null : constant O_Enode := (LLVM => Null_ValueRef,
+                                       Etype => O_Tnode_Null);
+
+
+   type O_Lnode is record
+      --  If True, the LLVM component is the value (used for arguments).
+      --  If False, the LLVM component is the address of the value (used
+      --   for everything else).
+      Direct : Boolean;
+      LLVM : ValueRef;
+      Ltype : O_Tnode;
+   end record;
+
+   O_Lnode_Null : constant O_Lnode := (False, Null_ValueRef, O_Tnode_Null);
+
+   type O_Snode is record
+      --  First BB in the loop body.
+      Bb_Entry : BasicBlockRef;
+
+      --  BB after the loop.
+      Bb_Exit : BasicBlockRef;
+   end record;
+
+   O_Snode_Null : constant O_Snode := (Null_BasicBlockRef,
+                                       Null_BasicBlockRef);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Res_Type : O_Tnode;
+      Nbr_Inter : Natural;
+      First_Inter, Last_Inter : O_Inter_Acc;
+   end record;
+
+   type O_Element;
+   type O_Element_Acc is access O_Element;
+   type O_Element is record
+      --  Identifier for the element
+      Ident : O_Ident;
+
+      --  Type of the element
+      Etype : O_Tnode;
+
+      --  Next element (in the linked list)
+      Next : O_Element_Acc;
+   end record;
+
+   --  Record and union builder.
+   type O_Element_List is record
+      Nbr_Elements : Natural;
+
+      --  For record: the access to the incomplete (but named) type.
+      Rec_Type : O_Tnode;
+
+      --  For unions: biggest for size and alignment
+      Size : unsigned;
+      Align : Unsigned_32;
+      Align_Type : TypeRef;
+
+      First_Elem, Last_Elem : O_Element_Acc;
+   end record;
+
+   type ValueRefArray_Acc is access ValueRefArray;
+
+   type O_Record_Aggr_List is record
+      --  Current number of elements in Vals.
+      Len : unsigned;
+
+      --  Value of elements.
+      Vals : ValueRefArray_Acc;
+
+      --  Type of the aggregate.
+      Atype : O_Tnode;
+   end record;
+
+   type O_Array_Aggr_List is record
+      --  Current number of elements in Vals.
+      Len : unsigned;
+
+      --  Value of elements.
+      Vals : ValueRefArray_Acc;
+      El_Type : TypeRef;
+
+      --  Type of the aggregate.
+      Atype : O_Tnode;
+   end record;
+
+   type O_Assoc_List is record
+      Subprg : O_Dnode;
+      Idx : unsigned;
+      Vals : ValueRefArray_Acc;
+   end record;
+
+   type O_Enum_List is record
+      LLVM : TypeRef;
+      Num : Natural;
+      Etype : O_Tnode;
+   end record;
+
+   type O_Choice_Type is record
+      Low, High : ValueRef;
+      Bb : BasicBlockRef;
+   end record;
+
+   type O_Choice_Array is array (Natural range <>) of O_Choice_Type;
+   type O_Choice_Array_Acc is access O_Choice_Array;
+
+   type O_Case_Block is record
+      --  BB before the case.
+      BB_Prev : BasicBlockRef;
+
+      --  Select expression
+      Value : ValueRef;
+      Vtype : O_Tnode;
+
+      --  BB after the case statement.
+      BB_Next : BasicBlockRef;
+
+      --  BB for others
+      BB_Others : BasicBlockRef;
+
+      --  BB for the current choice
+      BB_Choice : BasicBlockRef;
+
+      --  List of choices.
+      Nbr_Choices : Natural;
+      Choices : O_Choice_Array_Acc;
+   end record;
+
+   type O_If_Block is record
+      --  The next basic block.
+      --  After the 'If', this is the BB for the else part.  If there is no
+      --   else part, this is the BB for statements after the if.
+      --  After the 'else', this is the BB for statements after the if.
+      Bb : BasicBlockRef;
+   end record;
+
+   function Get_LLVM_Type (Atype : O_Tnode) return TypeRef;
+end Ortho_LLVM;
diff --git a/src/ortho/llvm/ortho_nodes.ads b/src/ortho/llvm/ortho_nodes.ads
new file mode 100644
index 000000000..34d1dbbc9
--- /dev/null
+++ b/src/ortho/llvm/ortho_nodes.ads
@@ -0,0 +1,20 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ortho_LLVM;
+package Ortho_Nodes renames Ortho_LLVM;
diff --git a/src/ortho/mcode/Makefile b/src/ortho/mcode/Makefile
new file mode 100644
index 000000000..19d5d26aa
--- /dev/null
+++ b/src/ortho/mcode/Makefile
@@ -0,0 +1,37 @@
+ortho_srcdir=..
+GNAT_FLAGS=-gnaty3befhkmr -gnata -gnatf -gnatwlcru -gnat05
+CC=gcc
+BE=mcode
+SED=sed
+
+all: $(ortho_exec)
+
+$(ortho_exec): $(ortho_srcdir)/mcode/ortho_mcode.ads memsegs_c.o force
+	gnatmake -m -o $@ -g -aI$(ortho_srcdir)/mcode -aI$(ortho_srcdir) \
+	$(GNAT_FLAGS) ortho_code_main -bargs -E -largs memsegs_c.o #-static
+
+memsegs_c.o: $(ortho_srcdir)/mcode/memsegs_c.c
+	$(CC) -c $(CFLAGS) -o $@ $<
+
+oread: force
+	gnatmake -m -o $@ -g $(GNAT_FLAGS) -aI../oread ortho_code_main -aI.. -largs memsegs_c.o
+
+elfdump: force
+	gnatmake -m -g $(GNAT_FLAGS) $@
+
+coffdump: force
+	gnatmake -m $(GNAT_FLAGS) $@
+
+clean:
+	$(RM) -f *.o *.ali ortho_code_main elfdump
+	$(RM) b~*.ad? *~
+
+distclean: clean
+
+
+force:
+
+.PHONY: force all clean
+
+ORTHO_BASENAME=ortho_mcode
+include $(ortho_srcdir)/Makefile.inc
diff --git a/src/ortho/mcode/binary_file-coff.adb b/src/ortho/mcode/binary_file-coff.adb
new file mode 100644
index 000000000..cf3cba3f4
--- /dev/null
+++ b/src/ortho/mcode/binary_file-coff.adb
@@ -0,0 +1,407 @@
+--  Binary file COFF writer.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Characters.Latin_1;
+with Coff; use Coff;
+
+package body Binary_File.Coff is
+   NUL : Character renames Ada.Characters.Latin_1.NUL;
+
+   procedure Write_Coff (Fd : GNAT.OS_Lib.File_Descriptor)
+   is
+      use GNAT.OS_Lib;
+
+      procedure Xwrite (Data : System.Address; Len : Natural) is
+      begin
+         if Write (Fd, Data, Len) /= Len then
+            raise Write_Error;
+         end if;
+      end Xwrite;
+
+      type Section_Info_Type is record
+         Sect : Section_Acc;
+         --  File offset for the data.
+         Data_Offset : Natural;
+         --  File offset for the relocs.
+         Reloc_Offset : Natural;
+         --  Number of relocs to write.
+         Nbr_Relocs : Natural;
+      end record;
+      type Section_Info_Array is array (Natural range <>) of Section_Info_Type;
+      Sections : Section_Info_Array (1 .. Nbr_Sections + 3);
+      Nbr_Sect : Natural;
+      Sect_Text : constant Natural := 1;
+      Sect_Data : constant Natural := 2;
+      Sect_Bss : constant Natural := 3;
+      Sect : Section_Acc;
+
+      --Section_Align : constant Natural := 2;
+
+      Offset : Natural;
+      Symtab_Offset : Natural;
+      --  Number of symtab entries.
+      Nbr_Symbols : Natural;
+      Strtab_Offset : Natural;
+
+      function Gen_String (Str : String) return Sym_Name
+      is
+         Res : Sym_Name;
+      begin
+         if Str'Length <= 8 then
+            Res.E_Name := (others => NUL);
+            Res.E_Name (1 .. Str'Length) := Str;
+         else
+            Res.E := (E_Zeroes => 0, E_Offset => Unsigned_32 (Offset));
+            Offset := Offset + Str'Length + 1;
+         end if;
+         return Res;
+      end Gen_String;
+
+      --  Well known sections name.
+      type String_Array is array (Sect_Text .. Sect_Bss) of String (1 .. 8);
+      Sect_Name : constant String_Array :=
+        (Sect_Text => ".text" & NUL & NUL & NUL,
+         Sect_Data => ".data" & NUL & NUL & NUL,
+         Sect_Bss => ".bss" & NUL & NUL & NUL & NUL);
+      type Unsigned32_Array is array (Sect_Text .. Sect_Bss) of Unsigned_32;
+      Sect_Flags : constant Unsigned32_Array :=
+        (Sect_Text => STYP_TEXT,
+         Sect_Data => STYP_DATA,
+         Sect_Bss => STYP_BSS);
+
+      --  If true, do local relocs.
+      Flag_Reloc : constant Boolean := True;
+      --  If true, discard local symbols;
+      Flag_Discard_Local : Boolean := True;
+   begin
+      --  If relocations are not performs, then local symbols cannot be
+      --  discarded.
+      if not Flag_Reloc then
+         Flag_Discard_Local := False;
+      end if;
+
+      --  Fill sections.
+      Sect := Section_Chain;
+      Nbr_Sect := 3;
+      declare
+         N : Natural;
+      begin
+         while Sect /= null loop
+            if Sect.Name.all = ".text" then
+               N := Sect_Text;
+            elsif Sect.Name.all = ".data" then
+               N := Sect_Data;
+            elsif Sect.Name.all = ".bss" then
+               N := Sect_Bss;
+            else
+               Nbr_Sect := Nbr_Sect + 1;
+               N := Nbr_Sect;
+            end if;
+            Sections (N).Sect := Sect;
+            Sect.Number := N;
+            Sect := Sect.Next;
+         end loop;
+      end;
+
+      --  Set data offset.
+      Offset := Filehdr_Size + Nbr_Sect * Scnhdr_Size;
+      for I in 1 .. Nbr_Sect loop
+         if Sections (I).Sect /= null
+           and then Sections (I).Sect.Data /= null
+         then
+            Sections (I).Data_Offset := Offset;
+            Offset := Offset + Natural (Sections (I).Sect.Pc);
+         else
+            Sections (I).Data_Offset := 0;
+         end if;
+      end loop;
+
+      --  Set relocs offset.
+      declare
+         Rel : Reloc_Acc;
+      begin
+         for I in 1 .. Nbr_Sect loop
+            Sections (I).Nbr_Relocs := 0;
+            if Sections (I).Sect /= null then
+               Sections (I).Reloc_Offset := Offset;
+               if not Flag_Reloc then
+                  --  Do local relocations.
+                  Rel := Sections (I).Sect.First_Reloc;
+                  while Rel /= null loop
+                     if S_Local (Rel.Sym) then
+                        if Get_Section (Rel.Sym) = Sections (I).Sect
+                        then
+                           --  Intra section local reloc.
+                           Apply_Reloc (Sections (I).Sect, Rel);
+                        else
+                           --  Inter section local reloc.
+                           --  A relocation is still required.
+                           Sections (I).Nbr_Relocs :=
+                             Sections (I).Nbr_Relocs + 1;
+                           --  FIXME: todo.
+                           raise Program_Error;
+                        end if;
+                     else
+                        Sections (I).Nbr_Relocs := Sections (I).Nbr_Relocs + 1;
+                     end if;
+                     Rel := Rel.Sect_Next;
+                  end loop;
+               else
+                  Sections (I).Nbr_Relocs := Sections (I).Sect.Nbr_Relocs;
+               end if;
+               Offset := Offset + Sections (I).Nbr_Relocs * Relsz;
+            else
+               Sections (I).Reloc_Offset := 0;
+            end if;
+         end loop;
+      end;
+
+      Symtab_Offset := Offset;
+      Nbr_Symbols := 2 + Nbr_Sect * 2; --  2 for file.
+      for I in Symbols.First .. Symbols.Last loop
+         Set_Number (I, Nbr_Symbols);
+         Nbr_Symbols := Nbr_Symbols + 1;
+      end loop;
+      Offset := Offset + Nbr_Symbols * Symesz;
+      Strtab_Offset := Offset;
+      Offset := Offset + 4;
+
+      --  Write file header.
+      declare
+         Hdr : Filehdr;
+      begin
+         Hdr.F_Magic := I386magic;
+         Hdr.F_Nscns := Unsigned_16 (Nbr_Sect);
+         Hdr.F_Timdat := 0;
+         Hdr.F_Symptr := Unsigned_32 (Symtab_Offset);
+         Hdr.F_Nsyms := Unsigned_32 (Nbr_Symbols);
+         Hdr.F_Opthdr := 0;
+         Hdr.F_Flags := F_Lnno;
+         Xwrite (Hdr'Address, Filehdr_Size);
+      end;
+
+      --  Write sections header.
+      for I in 1 .. Nbr_Sect loop
+         declare
+            Hdr : Scnhdr;
+            L : Natural;
+         begin
+            case I is
+               when Sect_Text
+                 | Sect_Data
+                 | Sect_Bss =>
+                  Hdr.S_Name := Sect_Name (I);
+                  Hdr.S_Flags := Sect_Flags (I);
+               when others =>
+                  Hdr.S_Flags := 0;
+                  L := Sections (I).Sect.Name'Length;
+                  if L > Hdr.S_Name'Length then
+                     Hdr.S_Name := Sections (I).Sect.Name
+                       (Sections (I).Sect.Name'First ..
+                        Sections (I).Sect.Name'First + Hdr.S_Name'Length - 1);
+                  else
+                     Hdr.S_Name (1 .. L) := Sections (I).Sect.Name.all;
+                     Hdr.S_Name (L + 1 .. Hdr.S_Name'Last) := (others => NUL);
+                  end if;
+            end case;
+            Hdr.S_Paddr := 0;
+            Hdr.S_Vaddr := 0;
+            Hdr.S_Scnptr := Unsigned_32 (Sections (I).Data_Offset);
+            Hdr.S_Relptr := Unsigned_32 (Sections (I).Reloc_Offset);
+            Hdr.S_Lnnoptr := 0;
+            Hdr.S_Nreloc := Unsigned_16 (Sections (I).Nbr_Relocs);
+            if Sections (I).Sect /= null then
+               Hdr.S_Size := Unsigned_32 (Sections (I).Sect.Pc);
+            else
+               Hdr.S_Size := 0;
+            end if;
+            Hdr.S_Nlnno := 0;
+            Xwrite (Hdr'Address, Scnhdr_Size);
+         end;
+      end loop;
+
+      --  Write sections content.
+      for I in 1 .. Nbr_Sect loop
+         if Sections (I).Sect /= null
+           and then Sections (I).Sect.Data /= null
+         then
+            Xwrite (Sections (I).Sect.Data (0)'Address,
+                    Natural (Sections (I).Sect.Pc));
+         end if;
+      end loop;
+
+      --  Write sections reloc.
+      for I in 1 .. Nbr_Sect loop
+         if Sections (I).Sect /= null then
+            declare
+               R : Reloc_Acc;
+               Rel : Reloc;
+            begin
+               R := Sections (I).Sect.First_Reloc;
+               while R /= null loop
+                  case R.Kind is
+                     when Reloc_32 =>
+                        Rel.R_Type := Reloc_Addr32;
+                     when Reloc_Pc32 =>
+                        Rel.R_Type := Reloc_Rel32;
+                     when others =>
+                        raise Program_Error;
+                  end case;
+                  Rel.R_Vaddr := Unsigned_32 (R.Addr);
+                  Rel.R_Symndx := Unsigned_32 (Get_Number (R.Sym));
+                  Xwrite (Rel'Address, Relsz);
+                  R := R.Sect_Next;
+               end loop;
+            end;
+         end if;
+      end loop;
+
+      --  Write symtab.
+      --   Write file symbol + aux
+      declare
+         Sym : Syment;
+         A_File : Auxent_File;
+      begin
+         Sym := (E => (Inline => True,
+                       E_Name => ".file" & NUL & NUL & NUL),
+                 E_Value => 0,
+                 E_Scnum => N_DEBUG,
+                 E_Type => 0,
+                 E_Sclass => C_FILE,
+                 E_Numaux => 1);
+         Xwrite (Sym'Address, Symesz);
+         A_File := (Inline => True,
+                    X_Fname => "testfile.xxxxx");
+         Xwrite (A_File'Address, Symesz);
+      end;
+      --   Write sections symbol + aux
+      for I in 1 .. Nbr_Sect loop
+         declare
+            A_Scn : Auxent_Scn;
+            Sym : Syment;
+         begin
+            Sym := (E => (Inline => True, E_Name => (others => NUL)),
+                    E_Value => 0,
+                    E_Scnum => Unsigned_16 (I),
+                    E_Type => 0,
+                    E_Sclass => C_STAT,
+                    E_Numaux => 1);
+            if I <= Sect_Bss then
+               Sym.E.E_Name := Sect_Name (I);
+            else
+               Sym.E := Gen_String (Sections (I).Sect.Name.all);
+            end if;
+            Xwrite (Sym'Address, Symesz);
+            if Sections (I).Sect /= null
+              and then Sections (I).Sect.Data /= null
+            then
+               A_Scn :=
+                 (X_Scnlen => Unsigned_32 (Sections (I).Sect.Pc),
+                  X_Nreloc => Unsigned_16 (Sections (I).Nbr_Relocs),
+                  X_Nlinno => 0);
+            else
+               A_Scn := (X_Scnlen => 0, X_Nreloc => 0, X_Nlinno => 0);
+            end if;
+            Xwrite (A_Scn'Address, Symesz);
+         end;
+      end loop;
+
+      --   Write symbols.
+      declare
+         procedure Write_Symbol (S : Symbol)
+         is
+            Sym : Syment;
+         begin
+            Sym := (E => Gen_String (Get_Symbol_Name (S)),
+                    E_Value => Unsigned_32 (Get_Symbol_Value (S)),
+                    E_Scnum => 0,
+                    E_Type => 0,
+                    E_Sclass => C_EXT,
+                    E_Numaux => 0);
+            case Get_Scope (S) is
+               when Sym_Local
+                 | Sym_Private =>
+                  Sym.E_Sclass := C_STAT;
+               when Sym_Undef
+                 | Sym_Global =>
+                  Sym.E_Sclass := C_EXT;
+            end case;
+            if Get_Section (S) /= null then
+               Sym.E_Scnum := Unsigned_16 (Get_Section (S).Number);
+            end if;
+            Xwrite (Sym'Address, Symesz);
+         end Write_Symbol;
+      begin
+         --  First the non-local symbols (1).
+         for I in Symbols.First .. Symbols.Last loop
+            if Get_Scope (I) in Symbol_Scope_External then
+               Write_Symbol (I);
+            end if;
+         end loop;
+         --  Then the local symbols (2).
+         if not Flag_Discard_Local then
+            for I in Symbols.First .. Symbols.Last loop
+               if Get_Scope (I) not in Symbol_Scope_External then
+                  Write_Symbol (I);
+               end if;
+            end loop;
+         end if;
+      end;
+
+      --  Write strtab.
+      --    Write strtab length.
+      declare
+         L : Unsigned_32;
+
+         procedure Write_String (Str : String) is
+         begin
+            if Str (Str'Last) /= NUL then
+               raise Program_Error;
+            end if;
+            if Str'Length <= 9 then
+               return;
+            end if;
+            Xwrite (Str'Address, Str'Length);
+            Strtab_Offset := Strtab_Offset + Str'Length;
+         end Write_String;
+      begin
+         L := Unsigned_32 (Offset - Strtab_Offset);
+         Xwrite (L'Address, 4);
+
+         --  Write section name string.
+         for I in Sect_Bss + 1 .. Nbr_Sect loop
+            if Sections (I).Sect /= null
+              and then Sections (I).Sect.Name'Length > 8
+            then
+               Write_String (Sections (I).Sect.Name.all & NUL);
+            end if;
+         end loop;
+
+         for I in Symbols.First .. Symbols.Last loop
+            declare
+               Str : constant String := Get_Symbol_Name (I);
+            begin
+               Write_String (Str & NUL);
+            end;
+         end loop;
+         if Strtab_Offset + 4 /= Offset then
+            raise Program_Error;
+         end if;
+      end;
+   end Write_Coff;
+
+end Binary_File.Coff;
diff --git a/src/ortho/mcode/binary_file-coff.ads b/src/ortho/mcode/binary_file-coff.ads
new file mode 100644
index 000000000..e671555ea
--- /dev/null
+++ b/src/ortho/mcode/binary_file-coff.ads
@@ -0,0 +1,23 @@
+--  Binary file COFF writer.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with GNAT.OS_Lib;
+
+package Binary_File.Coff is
+   procedure Write_Coff (Fd : GNAT.OS_Lib.File_Descriptor);
+end Binary_File.Coff;
+
diff --git a/src/ortho/mcode/binary_file-elf.adb b/src/ortho/mcode/binary_file-elf.adb
new file mode 100644
index 000000000..329dbacd3
--- /dev/null
+++ b/src/ortho/mcode/binary_file-elf.adb
@@ -0,0 +1,679 @@
+--  Binary file ELF writer.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Characters.Latin_1;
+with Elf_Common;
+with Elf32;
+
+package body Binary_File.Elf is
+   NUL : Character renames Ada.Characters.Latin_1.NUL;
+
+   type Arch_Bool is array (Arch_Kind) of Boolean;
+   Is_Rela : constant Arch_Bool := (Arch_Unknown => False,
+                                    Arch_X86 => False,
+                                    Arch_Sparc => True,
+                                    Arch_Ppc => True);
+
+   procedure Write_Elf (Fd : GNAT.OS_Lib.File_Descriptor)
+   is
+      use Elf_Common;
+      use Elf32;
+      use GNAT.OS_Lib;
+
+      procedure Xwrite (Data : System.Address; Len : Natural) is
+      begin
+         if Write (Fd, Data, Len) /= Len then
+            raise Write_Error;
+         end if;
+      end Xwrite;
+
+      procedure Check_File_Pos (Off : Elf32_Off)
+      is
+         L : Long_Integer;
+      begin
+         L := File_Length (Fd);
+         if L /= Long_Integer (Off) then
+            Put_Line (Standard_Error, "check_file_pos error: expect "
+                      & Elf32_Off'Image (Off) & ", found "
+                      & Long_Integer'Image (L));
+            raise Write_Error;
+         end if;
+      end Check_File_Pos;
+
+      function Sect_Align (V : Elf32_Off) return Elf32_Off
+      is
+         Tmp : Elf32_Off;
+      begin
+         Tmp := V + 2 ** 2 - 1;
+         return Tmp - (Tmp mod 2 ** 2);
+      end Sect_Align;
+
+      type Section_Info_Type is record
+         Sect : Section_Acc;
+         --  Index of the section symbol (in symtab).
+         Sym : Elf32_Word;
+         --  Number of relocs to write.
+         --Nbr_Relocs : Natural;
+      end record;
+      type Section_Info_Array is array (Natural range <>) of Section_Info_Type;
+      Sections : Section_Info_Array (0 .. 3 + 2 * Nbr_Sections);
+      type Elf32_Shdr_Array is array (Natural range <>) of Elf32_Shdr;
+      Shdr : Elf32_Shdr_Array (0 .. 3 + 2 * Nbr_Sections);
+      Nbr_Sect : Natural;
+      Sect : Section_Acc;
+
+      --  The first 4 sections are always present.
+      Sect_Null : constant Natural := 0;
+      Sect_Shstrtab : constant Natural := 1;
+      Sect_Symtab : constant Natural := 2;
+      Sect_Strtab : constant Natural := 3;
+      Sect_First : constant Natural := 4;
+
+      Offset : Elf32_Off;
+
+      --  Size of a relocation entry.
+      Rel_Size : Natural;
+
+      --  If true, do local relocs.
+      Flag_Reloc : constant Boolean := True;
+      --  If true, discard local symbols;
+      Flag_Discard_Local : Boolean := True;
+
+      --  Number of symbols.
+      Nbr_Symbols : Natural := 0;
+   begin
+      --  If relocations are not performs, then local symbols cannot be
+      --  discarded.
+      if not Flag_Reloc then
+         Flag_Discard_Local := False;
+      end if;
+
+      --  Set size of a relocation entry.  This avoids severals conditionnal.
+      if Is_Rela (Arch) then
+         Rel_Size := Elf32_Rela_Size;
+      else
+         Rel_Size := Elf32_Rel_Size;
+      end if;
+
+      --  Set section header.
+
+      --  SHT_NULL.
+      Shdr (Sect_Null) :=
+        Elf32_Shdr'(Sh_Name => 0,
+                    Sh_Type => SHT_NULL,
+                    Sh_Flags => 0,
+                    Sh_Addr => 0,
+                    Sh_Offset => 0,
+                    Sh_Size => 0,
+                    Sh_Link => 0,
+                    Sh_Info => 0,
+                    Sh_Addralign => 0,
+                    Sh_Entsize => 0);
+
+      --  shstrtab.
+      Shdr (Sect_Shstrtab) :=
+        Elf32_Shdr'(Sh_Name => 1,
+                    Sh_Type => SHT_STRTAB,
+                    Sh_Flags => 0,
+                    Sh_Addr => 0,
+                    Sh_Offset => 0,     --  Filled latter.
+      --  NUL: 1, .symtab: 8, .strtab: 8 and .shstrtab: 10.
+                    Sh_Size => 1 + 10 + 8 + 8,
+                    Sh_Link => 0,
+                    Sh_Info => 0,
+                    Sh_Addralign => 1,
+                    Sh_Entsize => 0);
+
+      --  Symtab
+      Shdr (Sect_Symtab) :=
+        Elf32_Shdr'(Sh_Name => 11,
+                    Sh_Type => SHT_SYMTAB,
+                    Sh_Flags => 0,
+                    Sh_Addr => 0,
+                    Sh_Offset => 0,
+                    Sh_Size => 0,
+                    Sh_Link => Elf32_Word (Sect_Strtab),
+                    Sh_Info => 0, --  FIXME
+                    Sh_Addralign => 4,
+                    Sh_Entsize => Elf32_Word (Elf32_Sym_Size));
+
+      --  strtab.
+      Shdr (Sect_Strtab) :=
+        Elf32_Shdr'(Sh_Name => 19,
+                    Sh_Type => SHT_STRTAB,
+                    Sh_Flags => 0,
+                    Sh_Addr => 0,
+                    Sh_Offset => 0,
+                    Sh_Size => 0,
+                    Sh_Link => 0,
+                    Sh_Info => 0,
+                    Sh_Addralign => 1,
+                    Sh_Entsize => 0);
+
+      --  Fill sections.
+      Sect := Section_Chain;
+      Nbr_Sect := Sect_First;
+      Nbr_Symbols := 1;
+      while Sect /= null loop
+         Sections (Nbr_Sect) := (Sect => Sect,
+                                 Sym => Elf32_Word (Nbr_Symbols));
+         Nbr_Symbols := Nbr_Symbols + 1;
+         Sect.Number := Nbr_Sect;
+
+         Shdr (Nbr_Sect) :=
+           Elf32_Shdr'(Sh_Name => Shdr (Sect_Shstrtab).Sh_Size,
+                       Sh_Type => SHT_PROGBITS,
+                       Sh_Flags => 0,
+                       Sh_Addr => Elf32_Addr (Sect.Vaddr),
+                       Sh_Offset => 0,
+                       Sh_Size => 0,
+                       Sh_Link => 0,
+                       Sh_Info => 0,
+                       Sh_Addralign => 2 ** Sect.Align,
+                       Sh_Entsize => Elf32_Word (Sect.Esize));
+         if Sect.Data = null then
+            Shdr (Nbr_Sect).Sh_Type := SHT_NOBITS;
+         end if;
+         if (Sect.Flags and Section_Read) /= 0 then
+            Shdr (Nbr_Sect).Sh_Flags :=
+              Shdr (Nbr_Sect).Sh_Flags or SHF_ALLOC;
+         end if;
+         if (Sect.Flags and Section_Exec) /= 0 then
+            Shdr (Nbr_Sect).Sh_Flags :=
+              Shdr (Nbr_Sect).Sh_Flags or SHF_EXECINSTR;
+         end if;
+         if (Sect.Flags and Section_Write) /= 0 then
+            Shdr (Nbr_Sect).Sh_Flags :=
+              Shdr (Nbr_Sect).Sh_Flags or SHF_WRITE;
+         end if;
+         if Sect.Flags = Section_Strtab then
+            Shdr (Nbr_Sect).Sh_Type := SHT_STRTAB;
+            Shdr (Nbr_Sect).Sh_Addralign := 1;
+            Shdr (Nbr_Sect).Sh_Entsize := 0;
+         end if;
+
+         Shdr (Sect_Shstrtab).Sh_Size := Shdr (Sect_Shstrtab).Sh_Size
+           + Sect.Name'Length + 1;      -- 1 for Nul.
+
+         Nbr_Sect := Nbr_Sect + 1;
+         if Flag_Reloc then
+            if Sect.First_Reloc /= null then
+               Do_Intra_Section_Reloc (Sect);
+            end if;
+         end if;
+         if Sect.First_Reloc /= null then
+            --  Add a section for the relocs.
+            Shdr (Nbr_Sect) := Elf32_Shdr'
+              (Sh_Name => Shdr (Sect_Shstrtab).Sh_Size,
+               Sh_Type => SHT_NULL,
+               Sh_Flags => 0,
+               Sh_Addr => 0,
+               Sh_Offset => 0,
+               Sh_Size => 0,
+               Sh_Link => Elf32_Word (Sect_Symtab),
+               Sh_Info => Elf32_Word (Nbr_Sect - 1),
+               Sh_Addralign => 4,
+               Sh_Entsize => Elf32_Word (Rel_Size));
+
+            if Is_Rela (Arch) then
+               Shdr (Nbr_Sect).Sh_Type := SHT_RELA;
+            else
+               Shdr (Nbr_Sect).Sh_Type := SHT_REL;
+            end if;
+            Shdr (Sect_Shstrtab).Sh_Size := Shdr (Sect_Shstrtab).Sh_Size
+              + Sect.Name'Length + 4        --  4 for ".rel"
+              + Boolean'Pos (Is_Rela (Arch)) + 1; -- 1 for 'a', 1 for Nul.
+
+            Nbr_Sect := Nbr_Sect + 1;
+         end if;
+         Sect := Sect.Next;
+      end loop;
+
+      --  Lay-out sections.
+      Offset := Elf32_Off (Elf32_Ehdr_Size);
+
+      --  Section table
+      Offset := Offset + Elf32_Off (Nbr_Sect * Elf32_Shdr_Size);
+
+      --  shstrtab.
+      Shdr (Sect_Shstrtab).Sh_Offset := Offset;
+
+      Offset := Sect_Align (Offset + Shdr (Sect_Shstrtab).Sh_Size);
+
+      --  user-sections and relocation.
+      for I in Sect_First .. Nbr_Sect - 1 loop
+         Sect := Sections (I).Sect;
+         if Sect /= null then
+            Sect.Pc := Pow_Align (Sect.Pc, Sect.Align);
+            Shdr (Sect.Number).Sh_Size := Elf32_Word (Sect.Pc);
+            if Sect.Data /= null then
+               --  Set data offset.
+               Shdr (Sect.Number).Sh_Offset := Offset;
+               Offset := Offset + Shdr (Sect.Number).Sh_Size;
+
+               --  Set relocs offset.
+               if Sect.First_Reloc /= null then
+                  Shdr (Sect.Number + 1).Sh_Offset := Offset;
+                  Shdr (Sect.Number + 1).Sh_Size :=
+                    Elf32_Word (Sect.Nbr_Relocs * Rel_Size);
+                  Offset := Offset + Shdr (Sect.Number + 1).Sh_Size;
+               end if;
+            end if;
+            --  Set link.
+            if Sect.Link /= null then
+               Shdr (Sect.Number).Sh_Link := Elf32_Word (Sect.Link.Number);
+            end if;
+         end if;
+      end loop;
+
+      --  Number symbols, put local before globals.
+      Nbr_Symbols := 1 + Nbr_Sections;
+
+      --  First local symbols.
+      for I in Symbols.First .. Symbols.Last loop
+         case Get_Scope (I) is
+            when Sym_Private =>
+               Set_Number (I, Nbr_Symbols);
+               Nbr_Symbols := Nbr_Symbols + 1;
+            when Sym_Local =>
+               if not Flag_Discard_Local then
+                  Set_Number (I, Nbr_Symbols);
+                  Nbr_Symbols := Nbr_Symbols + 1;
+               end if;
+            when Sym_Undef
+              | Sym_Global =>
+               null;
+         end case;
+      end loop;
+
+      Shdr (Sect_Symtab).Sh_Info := Elf32_Word (Nbr_Symbols);
+
+      --  Then globals.
+      for I in Symbols.First .. Symbols.Last loop
+         case Get_Scope (I) is
+            when Sym_Private
+              | Sym_Local =>
+               null;
+            when Sym_Undef =>
+               if Get_Used (I) then
+                  Set_Number (I, Nbr_Symbols);
+                  Nbr_Symbols := Nbr_Symbols + 1;
+               end if;
+            when Sym_Global =>
+               Set_Number (I, Nbr_Symbols);
+               Nbr_Symbols := Nbr_Symbols + 1;
+         end case;
+      end loop;
+
+      --  Symtab.
+      Shdr (Sect_Symtab).Sh_Offset := Offset;
+      --  1 for nul.
+      Shdr (Sect_Symtab).Sh_Size := Elf32_Word (Nbr_Symbols * Elf32_Sym_Size);
+
+      Offset := Offset + Shdr (Sect_Symtab).Sh_Size;
+
+      --  Strtab offset.
+      Shdr (Sect_Strtab).Sh_Offset := Offset;
+      Shdr (Sect_Strtab).Sh_Size := 1;
+
+      --  Compute length of strtab.
+      --    First, sections names.
+      Sect := Section_Chain;
+--       while Sect /= null loop
+--          Shdr (Sect_Strtab).Sh_Size :=
+--            Shdr (Sect_Strtab).Sh_Size + Sect.Name'Length + 1;
+--          Sect := Sect.Prev;
+--       end loop;
+      --   Then symbols.
+      declare
+         Len : Natural;
+         L : Natural;
+      begin
+         Len := 0;
+         for I in Symbols.First .. Symbols.Last loop
+            L := Get_Symbol_Name_Length (I) + 1;
+            case Get_Scope (I) is
+               when Sym_Local =>
+                  if Flag_Discard_Local then
+                     L := 0;
+                  end if;
+               when Sym_Private =>
+                  null;
+               when Sym_Global =>
+                  null;
+               when Sym_Undef =>
+                  if not Get_Used (I) then
+                     L := 0;
+                  end if;
+            end case;
+            Len := Len + L;
+         end loop;
+
+         Shdr (Sect_Strtab).Sh_Size :=
+           Shdr (Sect_Strtab).Sh_Size + Elf32_Word (Len);
+      end;
+
+      --  Write file header.
+      declare
+         Ehdr : Elf32_Ehdr;
+      begin
+         Ehdr := (E_Ident => (EI_MAG0 => ELFMAG0,
+                              EI_MAG1 => ELFMAG1,
+                              EI_MAG2 => ELFMAG2,
+                              EI_MAG3 => ELFMAG3,
+                              EI_CLASS => ELFCLASS32,
+                              EI_DATA => ELFDATANONE,
+                              EI_VERSION => EV_CURRENT,
+                              EI_PAD .. 15 => 0),
+                  E_Type => ET_REL,
+                  E_Machine => EM_NONE,
+                  E_Version => Elf32_Word (EV_CURRENT),
+                  E_Entry => 0,
+                  E_Phoff => 0,
+                  E_Shoff => Elf32_Off (Elf32_Ehdr_Size),
+                  E_Flags => 0,
+                  E_Ehsize => Elf32_Half (Elf32_Ehdr_Size),
+                  E_Phentsize => 0,
+                  E_Phnum => 0,
+                  E_Shentsize => Elf32_Half (Elf32_Shdr_Size),
+                  E_Shnum => Elf32_Half (Nbr_Sect),
+                  E_Shstrndx => 1);
+         case Arch is
+            when Arch_X86 =>
+               Ehdr.E_Ident (EI_DATA) := ELFDATA2LSB;
+               Ehdr.E_Machine := EM_386;
+            when Arch_Sparc =>
+               Ehdr.E_Ident (EI_DATA) := ELFDATA2MSB;
+               Ehdr.E_Machine := EM_SPARC;
+            when others =>
+               raise Program_Error;
+         end case;
+         Xwrite (Ehdr'Address, Elf32_Ehdr_Size);
+      end;
+
+      -- Write shdr.
+      Xwrite (Shdr'Address, Nbr_Sect * Elf32_Shdr_Size);
+
+      -- Write shstrtab
+      Check_File_Pos (Shdr (Sect_Shstrtab).Sh_Offset);
+      declare
+         Str : String :=
+           NUL & ".shstrtab" & NUL & ".symtab" & NUL & ".strtab" & NUL;
+         Rela : String := NUL & ".rela";
+      begin
+         Xwrite (Str'Address, Str'Length);
+         Sect := Section_Chain;
+         while Sect /= null loop
+            Xwrite (Sect.Name.all'Address, Sect.Name'Length);
+            if Sect.First_Reloc /= null then
+               if Is_Rela (Arch) then
+                  Xwrite (Rela'Address, Rela'Length);
+               else
+                  Xwrite (Rela'Address, Rela'Length - 1);
+               end if;
+               Xwrite (Sect.Name.all'Address, Sect.Name'Length);
+            end if;
+            Xwrite (NUL'Address, 1);
+            Sect := Sect.Next;
+         end loop;
+      end;
+      --  Pad.
+      declare
+         Delt : Elf32_Word;
+         Nul_Str : String (1 .. 4) := (others => NUL);
+      begin
+         Delt := Shdr (Sect_Shstrtab).Sh_Size and 3;
+         if Delt /= 0 then
+            Xwrite (Nul_Str'Address, Natural (4 - Delt));
+         end if;
+      end;
+
+      --  Write sections content and reloc.
+      for I in 1 .. Nbr_Sect loop
+         Sect := Sections (I).Sect;
+         if Sect /= null then
+            if Sect.Data /= null then
+               Check_File_Pos (Shdr (Sect.Number).Sh_Offset);
+               Xwrite (Sect.Data (0)'Address, Natural (Sect.Pc));
+            end if;
+            declare
+               R : Reloc_Acc;
+               Rel : Elf32_Rel;
+               Rela : Elf32_Rela;
+               S : Elf32_Word;
+               Nbr_Reloc : Natural;
+            begin
+               R := Sect.First_Reloc;
+               Nbr_Reloc := 0;
+               while R /= null loop
+                  if R.Done then
+                     S := Sections (Get_Section (R.Sym).Number).Sym;
+                  else
+                     S := Elf32_Word (Get_Number (R.Sym));
+                  end if;
+
+                  if Is_Rela (Arch) then
+                     case R.Kind is
+                        when Reloc_Disp22 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_WDISP22);
+                        when Reloc_Disp30 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_WDISP30);
+                        when Reloc_Hi22 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_HI22);
+                        when Reloc_Lo10 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_LO10);
+                        when Reloc_32 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_32);
+                        when Reloc_Ua_32 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_UA32);
+                        when others =>
+                           raise Program_Error;
+                     end case;
+                     Rela.R_Addend := 0;
+                     Rela.R_Offset := Elf32_Addr (R.Addr);
+                     Xwrite (Rela'Address, Elf32_Rela_Size);
+                  else
+                     case R.Kind is
+                        when Reloc_32 =>
+                           Rel.R_Info := Elf32_R_Info (S, R_386_32);
+                        when Reloc_Pc32 =>
+                           Rel.R_Info := Elf32_R_Info (S, R_386_PC32);
+                        when others =>
+                           raise Program_Error;
+                     end case;
+                     Rel.R_Offset := Elf32_Addr (R.Addr);
+                     Xwrite (Rel'Address, Elf32_Rel_Size);
+                  end if;
+                  Nbr_Reloc := Nbr_Reloc + 1;
+                  R := R.Sect_Next;
+               end loop;
+               if Nbr_Reloc /= Sect.Nbr_Relocs then
+                  raise Program_Error;
+               end if;
+            end;
+         end if;
+      end loop;
+
+      --  Write symbol table.
+      Check_File_Pos (Shdr (Sect_Symtab).Sh_Offset);
+      declare
+         Str_Off : Elf32_Word;
+
+         procedure Gen_Sym (S : Symbol)
+         is
+            Sym : Elf32_Sym;
+            Bind : Elf32_Uchar;
+            Typ : Elf32_Uchar;
+         begin
+            Sym := Elf32_Sym'(St_Name => Str_Off,
+                              St_Value => Elf32_Addr (Get_Symbol_Value (S)),
+                              St_Size => 0,
+                              St_Info => 0,
+                              St_Other => 0,
+                              St_Shndx => SHN_UNDEF);
+            if Get_Section (S) /= null then
+               Sym.St_Shndx := Elf32_Half (Get_Section (S).Number);
+            end if;
+            case Get_Scope (S) is
+               when Sym_Private
+                 | Sym_Local =>
+                  Bind := STB_LOCAL;
+                  Typ := STT_NOTYPE;
+               when Sym_Global =>
+                  Bind := STB_GLOBAL;
+                  if Get_Section (S) /= null
+                    and then (Get_Section (S).Flags and Section_Exec) /= 0
+                  then
+                     Typ := STT_FUNC;
+                  else
+                     Typ := STT_OBJECT;
+                  end if;
+               when Sym_Undef =>
+                  Bind := STB_GLOBAL;
+                  Typ := STT_NOTYPE;
+            end case;
+            Sym.St_Info := Elf32_St_Info (Bind, Typ);
+
+            Xwrite (Sym'Address, Elf32_Sym_Size);
+
+            Str_Off := Str_Off + Elf32_Off (Get_Symbol_Name_Length (S) + 1);
+         end Gen_Sym;
+
+         Sym : Elf32_Sym;
+      begin
+
+         Str_Off := 1;
+
+         --   write null entry
+         Sym := Elf32_Sym'(St_Name => 0,
+                           St_Value => 0,
+                           St_Size => 0,
+                           St_Info => 0,
+                           St_Other => 0,
+                           St_Shndx => SHN_UNDEF);
+         Xwrite (Sym'Address, Elf32_Sym_Size);
+
+         --   write section entries
+         Sect := Section_Chain;
+         while Sect /= null loop
+--             Sym := Elf32_Sym'(St_Name => Str_Off,
+--                               St_Value => 0,
+--                               St_Size => 0,
+--                               St_Info => Elf32_St_Info (STB_LOCAL,
+--                                                      STT_NOTYPE),
+--                               St_Other => 0,
+--                               St_Shndx => Elf32_Half (Sect.Number));
+--             Xwrite (Sym'Address, Elf32_Sym_Size);
+--             Str_Off := Str_Off + Sect.Name'Length + 1;
+
+            Sym := Elf32_Sym'(St_Name => 0,
+                              St_Value => 0,
+                              St_Size => 0,
+                              St_Info => Elf32_St_Info (STB_LOCAL,
+                                                        STT_SECTION),
+                              St_Other => 0,
+                              St_Shndx => Elf32_Half (Sect.Number));
+            Xwrite (Sym'Address, Elf32_Sym_Size);
+            Sect := Sect.Next;
+         end loop;
+
+         --  First local symbols.
+         for I in Symbols.First .. Symbols.Last loop
+            case Get_Scope (I) is
+               when Sym_Private =>
+                  Gen_Sym (I);
+               when Sym_Local =>
+                  if not Flag_Discard_Local then
+                     Gen_Sym (I);
+                  end if;
+               when Sym_Global
+                 | Sym_Undef =>
+                  null;
+            end case;
+         end loop;
+
+         --  Then global symbols.
+         for I in Symbols.First .. Symbols.Last loop
+            case Get_Scope (I) is
+               when Sym_Global =>
+                  Gen_Sym (I);
+               when Sym_Undef =>
+                  if Get_Used (I) then
+                     Gen_Sym (I);
+                  end if;
+               when Sym_Private
+                 | Sym_Local =>
+                  null;
+            end case;
+         end loop;
+      end;
+
+      -- Write strtab.
+      Check_File_Pos (Shdr (Sect_Strtab).Sh_Offset);
+      --  First is NUL.
+      Xwrite (NUL'Address, 1);
+      --  Then the sections name.
+--       Sect := Section_List;
+--       while Sect /= null loop
+--          Xwrite (Sect.Name.all'Address, Sect.Name'Length);
+--          Xwrite (NUL'Address, 1);
+--          Sect := Sect.Prev;
+--       end loop;
+
+      --  Then the symbols name.
+      declare
+         procedure Write_Sym_Name (S : Symbol)
+         is
+            Str : String := Get_Symbol_Name (S) & NUL;
+         begin
+            Xwrite (Str'Address, Str'Length);
+         end Write_Sym_Name;
+      begin
+         --  First locals.
+         for I in Symbols.First .. Symbols.Last loop
+            case Get_Scope (I) is
+               when Sym_Private =>
+                  Write_Sym_Name (I);
+               when Sym_Local =>
+                  if not Flag_Discard_Local then
+                     Write_Sym_Name (I);
+                  end if;
+               when Sym_Global
+                 | Sym_Undef =>
+                  null;
+            end case;
+         end loop;
+
+         --  Then global symbols.
+         for I in Symbols.First .. Symbols.Last loop
+            case Get_Scope (I) is
+               when Sym_Global =>
+                  Write_Sym_Name (I);
+               when Sym_Undef =>
+                  if Get_Used (I) then
+                     Write_Sym_Name (I);
+                  end if;
+               when Sym_Private
+                 | Sym_Local =>
+                  null;
+            end case;
+         end loop;
+      end;
+   end Write_Elf;
+
+end Binary_File.Elf;
diff --git a/src/ortho/mcode/binary_file-elf.ads b/src/ortho/mcode/binary_file-elf.ads
new file mode 100644
index 000000000..e0d3a4d2a
--- /dev/null
+++ b/src/ortho/mcode/binary_file-elf.ads
@@ -0,0 +1,22 @@
+--  Binary file ELF writer.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with GNAT.OS_Lib;
+
+package Binary_File.Elf is
+   procedure Write_Elf (Fd : GNAT.OS_Lib.File_Descriptor);
+end Binary_File.Elf;
diff --git a/src/ortho/mcode/binary_file-memory.adb b/src/ortho/mcode/binary_file-memory.adb
new file mode 100644
index 000000000..a37af9cb7
--- /dev/null
+++ b/src/ortho/mcode/binary_file-memory.adb
@@ -0,0 +1,101 @@
+--  Binary file execute in memory handler.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Unchecked_Conversion;
+
+package body Binary_File.Memory is
+   --  Absolute section.
+   Sect_Abs : Section_Acc;
+
+   function To_Pc_Type is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Pc_Type);
+
+   procedure Set_Symbol_Address (Sym : Symbol; Addr : System.Address)
+   is
+   begin
+      Set_Symbol_Value (Sym, To_Pc_Type (Addr));
+      Set_Scope (Sym, Sym_Global);
+      Set_Section (Sym, Sect_Abs);
+   end Set_Symbol_Address;
+
+   procedure Write_Memory_Init is
+   begin
+      Create_Section (Sect_Abs, "*ABS*", Section_Exec);
+      Sect_Abs.Vaddr := 0;
+   end Write_Memory_Init;
+
+   procedure Write_Memory_Relocate (Error : out Boolean)
+   is
+      Sect : Section_Acc;
+      Rel : Reloc_Acc;
+      N_Rel : Reloc_Acc;
+   begin
+      --  Relocate section in memory.
+      Sect := Section_Chain;
+      while Sect /= null loop
+         if Sect.Data = null then
+            if Sect.Pc > 0 then
+               Resize (Sect, Sect.Pc);
+               Sect.Data (0 .. Sect.Pc - 1) := (others => 0);
+            else
+               null;
+               --Sect.Data := new Byte_Array (1 .. 0);
+            end if;
+         end if;
+         if Sect.Data_Max > 0
+           and (Sect /= Sect_Abs and Sect.Flags /= Section_Debug)
+         then
+            Sect.Vaddr := To_Pc_Type (Sect.Data (0)'Address);
+         end if;
+         Sect := Sect.Next;
+      end loop;
+
+      --  Do all relocations.
+      Sect := Section_Chain;
+      Error := False;
+      while Sect /= null loop
+--           Put_Line ("Section: " & Sect.Name.all & ", Flags:"
+--                     & Section_Flags'Image (Sect.Flags));
+         Rel := Sect.First_Reloc;
+         while Rel /= null loop
+            N_Rel := Rel.Sect_Next;
+            if Get_Scope (Rel.Sym) = Sym_Undef then
+               Put_Line ("symbol " & Get_Symbol_Name (Rel.Sym)
+                         & " is undefined");
+               Error := True;
+            else
+               Apply_Reloc (Sect, Rel);
+            end if;
+            Free (Rel);
+            Rel := N_Rel;
+         end loop;
+
+         Sect.First_Reloc := null;
+         Sect.Last_Reloc := null;
+         Sect.Nbr_Relocs := 0;
+
+         if (Sect.Flags and Section_Exec) /= 0
+           and (Sect.Flags and Section_Write) = 0
+         then
+            Memsegs.Set_Rx (Sect.Seg);
+         end if;
+
+         Sect := Sect.Next;
+      end loop;
+   end Write_Memory_Relocate;
+end Binary_File.Memory;
diff --git a/src/ortho/mcode/binary_file-memory.ads b/src/ortho/mcode/binary_file-memory.ads
new file mode 100644
index 000000000..a205da527
--- /dev/null
+++ b/src/ortho/mcode/binary_file-memory.ads
@@ -0,0 +1,25 @@
+--  Binary file execute in memory handler.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Binary_File.Memory is
+
+   --  Must be called before set_symbol_address.
+   procedure Write_Memory_Init;
+   procedure Set_Symbol_Address (Sym : Symbol; Addr : System.Address);
+
+   procedure Write_Memory_Relocate (Error : out Boolean);
+end Binary_File.Memory;
diff --git a/src/ortho/mcode/binary_file.adb b/src/ortho/mcode/binary_file.adb
new file mode 100644
index 000000000..6043d7319
--- /dev/null
+++ b/src/ortho/mcode/binary_file.adb
@@ -0,0 +1,977 @@
+--  Binary file handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System.Storage_Elements;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Characters.Latin_1;
+with Ada.Unchecked_Conversion;
+with Hex_Images; use Hex_Images;
+with Disassemble;
+
+package body Binary_File is
+   Cur_Sect : Section_Acc := null;
+
+   HT : Character renames Ada.Characters.Latin_1.HT;
+
+   function To_Byte_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Byte_Array_Acc);
+
+   --  Resize a section to SIZE bytes.
+   procedure Resize (Sect : Section_Acc; Size : Pc_Type)
+   is
+   begin
+      Sect.Data_Max := Size;
+      Memsegs.Resize (Sect.Seg, Natural (Size));
+      Sect.Data := To_Byte_Array_Acc (Memsegs.Get_Address (Sect.Seg));
+   end Resize;
+
+   function Get_Scope (Sym : Symbol) return Symbol_Scope is
+   begin
+      return Symbols.Table (Sym).Scope;
+   end Get_Scope;
+
+   procedure Set_Scope (Sym : Symbol; Scope : Symbol_Scope) is
+   begin
+      Symbols.Table (Sym).Scope := Scope;
+   end Set_Scope;
+
+   function Get_Section (Sym : Symbol) return Section_Acc is
+   begin
+      return Symbols.Table (Sym).Section;
+   end Get_Section;
+
+   procedure Set_Section (Sym : Symbol; Sect : Section_Acc) is
+   begin
+      Symbols.Table (Sym).Section := Sect;
+   end Set_Section;
+
+   function Get_Number (Sym : Symbol) return Natural is
+   begin
+      return Symbols.Table (Sym).Number;
+   end Get_Number;
+
+   procedure Set_Number (Sym : Symbol; Num : Natural) is
+   begin
+      Symbols.Table (Sym).Number := Num;
+   end Set_Number;
+
+   function Get_Relocs (Sym : Symbol) return Reloc_Acc is
+   begin
+      return Symbols.Table (Sym).Relocs;
+   end Get_Relocs;
+
+   procedure Set_Relocs (Sym : Symbol; Reloc : Reloc_Acc) is
+   begin
+      Symbols.Table (Sym).Relocs := Reloc;
+   end Set_Relocs;
+
+   function Get_Name (Sym : Symbol) return O_Ident is
+   begin
+      return Symbols.Table (Sym).Name;
+   end Get_Name;
+
+   function Get_Used (Sym : Symbol) return Boolean is
+   begin
+      return Symbols.Table (Sym).Used;
+   end Get_Used;
+
+   procedure Set_Used (Sym : Symbol; Val : Boolean) is
+   begin
+      Symbols.Table (Sym).Used := Val;
+   end Set_Used;
+
+   function Get_Symbol_Value (Sym : Symbol) return Pc_Type is
+   begin
+      return Symbols.Table (Sym).Value;
+   end Get_Symbol_Value;
+
+   procedure Set_Symbol_Value (Sym : Symbol; Val : Pc_Type) is
+   begin
+      Symbols.Table (Sym).Value := Val;
+   end Set_Symbol_Value;
+
+   function S_Defined (Sym : Symbol) return Boolean is
+   begin
+      return Get_Scope (Sym) /= Sym_Undef;
+   end S_Defined;
+   pragma Unreferenced (S_Defined);
+
+   function S_Local (Sym : Symbol) return Boolean is
+   begin
+      return Get_Scope (Sym) = Sym_Local;
+   end S_Local;
+
+   procedure Create_Section (Sect : out Section_Acc;
+                             Name : String; Flags : Section_Flags)
+   is
+   begin
+      Sect := new Section_Type'(Next => null,
+                                Flags => Flags,
+                                Name => new String'(Name),
+                                Link => null,
+                                Align => 2,
+                                Esize => 0,
+                                Pc => 0,
+                                Insn_Pc => 0,
+                                Data => null,
+                                Data_Max => 0,
+                                First_Reloc => null,
+                                Last_Reloc => null,
+                                Nbr_Relocs => 0,
+                                Number => 0,
+                                Seg => Memsegs.Create,
+                                Vaddr => 0);
+      if (Flags and Section_Zero) = 0 then
+         --  Allocate memory for the segment, unless BSS.
+         Resize (Sect, 8192);
+      end if;
+      if (Flags and Section_Strtab) /= 0 then
+         Sect.Align := 0;
+      end if;
+      if Section_Chain = null then
+         Section_Chain := Sect;
+      else
+         Section_Last.Next := Sect;
+      end if;
+      Section_Last := Sect;
+      Nbr_Sections := Nbr_Sections + 1;
+   end Create_Section;
+
+   procedure Sect_Prealloc (Sect : Section_Acc; L : Pc_Type)
+   is
+      New_Max : Pc_Type;
+   begin
+      if Sect.Pc + L < Sect.Data_Max then
+         return;
+      end if;
+      New_Max := Sect.Data_Max;
+      loop
+         New_Max := New_Max * 2;
+         exit when Sect.Pc + L < New_Max;
+      end loop;
+      Resize (Sect, New_Max);
+   end Sect_Prealloc;
+
+   procedure Merge_Section (Dest : Section_Acc; Src : Section_Acc)
+   is
+      Rel : Reloc_Acc;
+   begin
+      --  Sanity checks.
+      if Src = null or else Dest = Src then
+         raise Program_Error;
+      end if;
+
+      Rel := Src.First_Reloc;
+
+      if Rel /= null then
+         --  Move relocs.
+         if Dest.Last_Reloc = null then
+            Dest.First_Reloc := Rel;
+            Dest.Last_Reloc := Rel;
+         else
+            Dest.Last_Reloc.Sect_Next := Rel;
+            Dest.Last_Reloc := Rel;
+         end if;
+         Dest.Nbr_Relocs := Dest.Nbr_Relocs + Src.Nbr_Relocs;
+
+
+         --  Reloc reloc, since the pc has changed.
+         while Rel /= null loop
+            Rel.Addr := Rel.Addr + Dest.Pc;
+            Rel := Rel.Sect_Next;
+         end loop;
+      end if;
+
+      if Src.Pc > 0 then
+         Sect_Prealloc (Dest, Src.Pc);
+         Dest.Data (Dest.Pc .. Dest.Pc + Src.Pc - 1) :=
+           Src.Data (0 .. Src.Pc - 1);
+         Dest.Pc := Dest.Pc + Src.Pc;
+      end if;
+
+      Memsegs.Delete (Src.Seg);
+      Src.Pc := 0;
+      Src.Data_Max := 0;
+      Src.Data := null;
+      Src.First_Reloc := null;
+      Src.Last_Reloc := null;
+      Src.Nbr_Relocs := 0;
+
+      --  Remove from section_chain.
+      if Section_Chain = Src then
+         Section_Chain := Src.Next;
+      else
+         declare
+            Sect : Section_Acc;
+         begin
+            Sect := Section_Chain;
+            while Sect.Next /= Src loop
+               Sect := Sect.Next;
+            end loop;
+            Sect.Next := Src.Next;
+            if Section_Last = Src then
+               Section_Last := Sect;
+            end if;
+         end;
+      end if;
+      Nbr_Sections := Nbr_Sections - 1;
+   end Merge_Section;
+
+   procedure Set_Section_Info (Sect : Section_Acc;
+                               Link : Section_Acc;
+                               Align : Natural;
+                               Esize : Natural)
+   is
+   begin
+      Sect.Link := Link;
+      Sect.Align := Align;
+      Sect.Esize := Esize;
+   end Set_Section_Info;
+
+   procedure Set_Current_Section (Sect : Section_Acc) is
+   begin
+      --  If the current section does not change, this is a no-op.
+      if Cur_Sect = Sect then
+         return;
+      end if;
+
+      if Dump_Asm then
+         Put_Line (HT & ".section """ & Sect.Name.all & """");
+      end if;
+      Cur_Sect := Sect;
+   end Set_Current_Section;
+
+   function Get_Current_Pc return Pc_Type is
+   begin
+      return Cur_Sect.Pc;
+   end Get_Current_Pc;
+
+   function Get_Pc (Sect : Section_Acc) return Pc_Type is
+   begin
+      return Sect.Pc;
+   end Get_Pc;
+
+
+   procedure Prealloc (L : Pc_Type) is
+   begin
+      Sect_Prealloc (Cur_Sect, L);
+   end Prealloc;
+
+   procedure Start_Insn is
+   begin
+      --  Check there is enough memory for the next instruction.
+      Sect_Prealloc (Cur_Sect, 16);
+      if Cur_Sect.Insn_Pc /= 0 then
+         --  end_insn was not called.
+         raise Program_Error;
+      end if;
+      Cur_Sect.Insn_Pc := Cur_Sect.Pc;
+   end Start_Insn;
+
+   procedure Get_Symbol_At_Addr (Addr : System.Address;
+                                 Line : in out String;
+                                 Line_Len : in out Natural)
+   is
+      use System;
+      use System.Storage_Elements;
+      Off : Pc_Type;
+      Reloc : Reloc_Acc;
+   begin
+      --  Check if addr is in the current section.
+      if Addr < Cur_Sect.Data (0)'Address
+        or else Addr > Cur_Sect.Data (Cur_Sect.Pc)'Address
+      then
+         raise Program_Error;
+         --return;
+      end if;
+      Off := Pc_Type
+        (To_Integer (Addr) - To_Integer (Cur_Sect.Data (0)'Address));
+
+      --  Find a relocation at OFF.
+      Reloc := Cur_Sect.First_Reloc;
+      while Reloc /= null loop
+         if Reloc.Addr = Off then
+            declare
+               Str : constant String := Get_Symbol_Name (Reloc.Sym);
+            begin
+               Line (Line'First .. Line'First + Str'Length - 1) := Str;
+               Line_Len := Line_Len + Str'Length;
+               return;
+            end;
+         end if;
+         Reloc := Reloc.Sect_Next;
+      end loop;
+   end Get_Symbol_At_Addr;
+
+   procedure End_Insn
+   is
+      Str : String (1 .. 256);
+      Len : Natural;
+      Insn_Len : Natural;
+   begin
+      --if Insn_Pc = 0 then
+      --   --  start_insn was not called.
+      --   raise Program_Error;
+      --end if;
+      if Debug_Hex then
+         Put (HT);
+         Put ('#');
+         for I in Cur_Sect.Insn_Pc .. Cur_Sect.Pc - 1 loop
+            Put (' ');
+            Put (Hex_Image (Unsigned_8 (Cur_Sect.Data (I))));
+         end loop;
+         New_Line;
+      end if;
+
+      if Dump_Asm then
+         Disassemble.Disassemble_Insn
+           (Cur_Sect.Data (Cur_Sect.Insn_Pc)'Address,
+            Unsigned_32 (Cur_Sect.Insn_Pc),
+            Str, Len, Insn_Len,
+            Get_Symbol_At_Addr'Access);
+         Put (HT);
+         Put_Line (Str (1 .. Len));
+      end if;
+      --if Natural (Cur_Pc - Insn_Pc) /= Insn_Len then
+      --   raise Program_Error;
+      --end if;
+      Cur_Sect.Insn_Pc := 0;
+   end End_Insn;
+
+   procedure Gen_B8 (B : Byte) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc) := B;
+      Cur_Sect.Pc := Cur_Sect.Pc + 1;
+   end Gen_B8;
+
+   procedure Gen_B16 (B0, B1 : Byte) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := B0;
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := B1;
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_B16;
+
+   procedure Gen_Le8 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc) := Byte (B and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 1;
+   end Gen_Le8;
+
+   procedure Gen_Le16 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := Byte (Shift_Right (B, 0) and 16#Ff#);
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := Byte (Shift_Right (B, 8) and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_Le16;
+
+   procedure Gen_Be16 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := Byte (Shift_Right (B, 8) and 16#Ff#);
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := Byte (Shift_Right (B, 0) and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_Be16;
+
+   procedure Write_B8 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_8) is
+   begin
+      Sect.Data (Pc) := Byte (V);
+   end Write_B8;
+
+   procedure Write_Be16 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 0) and 16#Ff#);
+   end Write_Be16;
+
+   procedure Write_Le32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 0) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 2) := Byte (Shift_Right (V, 16) and 16#Ff#);
+      Sect.Data (Pc + 3) := Byte (Shift_Right (V, 24) and 16#Ff#);
+   end Write_Le32;
+
+   procedure Write_Be32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 24) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 16) and 16#Ff#);
+      Sect.Data (Pc + 2) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 3) := Byte (Shift_Right (V, 0) and 16#Ff#);
+   end Write_Be32;
+
+   procedure Write_16 (Sect : Section_Acc; Pc : Pc_Type; B : Unsigned_32)
+   is
+      subtype B2 is Byte_Array_Base (0 .. 1);
+      function To_B2 is new Ada.Unchecked_Conversion
+        (Source => Unsigned_16, Target => B2);
+   begin
+      Sect.Data (Pc + 0 .. Pc + 1) := To_B2 (Unsigned_16 (B));
+   end Write_16;
+
+   procedure Write_32 (Sect : Section_Acc; Pc : Pc_Type; B : Unsigned_32)
+   is
+      subtype B4 is Byte_Array_Base (0 .. 3);
+      function To_B4 is new Ada.Unchecked_Conversion
+        (Source => Unsigned_32, Target => B4);
+   begin
+      Sect.Data (Pc + 0 .. Pc + 3) := To_B4 (B);
+   end Write_32;
+
+   procedure Gen_16 (B : Unsigned_32) is
+   begin
+      Write_16 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_16;
+
+   procedure Gen_32 (B : Unsigned_32) is
+   begin
+      Write_32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_32;
+
+   function Read_Le32 (Sect : Section_Acc; Pc : Pc_Type) return Unsigned_32 is
+   begin
+      return Shift_Left (Unsigned_32 (Sect.Data (Pc + 0)), 0)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 1)), 8)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 2)), 16)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 3)), 24);
+   end Read_Le32;
+
+   function Read_Be32 (Sect : Section_Acc; Pc : Pc_Type) return Unsigned_32 is
+   begin
+      return Shift_Left (Unsigned_32 (Sect.Data (Pc + 0)), 24)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 1)), 16)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 2)), 8)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 3)), 0);
+   end Read_Be32;
+
+   procedure Add_Le32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Write_Le32 (Sect, Pc, V + Read_Le32 (Sect, Pc));
+   end Add_Le32;
+
+   procedure Patch_Le32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Le32 (Cur_Sect, Pc, V);
+   end Patch_Le32;
+
+   procedure Patch_Be32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Be32 (Cur_Sect, Pc, V);
+   end Patch_Be32;
+
+   procedure Patch_Be16 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 2 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Be16 (Cur_Sect, Pc, V);
+   end Patch_Be16;
+
+   procedure Patch_B8 (Pc : Pc_Type; V : Unsigned_8) is
+   begin
+      if Pc >= Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_B8 (Cur_Sect, Pc, V);
+   end Patch_B8;
+
+   procedure Patch_32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_32 (Cur_Sect, Pc, V);
+   end Patch_32;
+
+   procedure Gen_Le32 (B : Unsigned_32) is
+   begin
+      Write_Le32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_Le32;
+
+   procedure Gen_Be32 (B : Unsigned_32) is
+   begin
+      Write_Be32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_Be32;
+
+   procedure Gen_Data_Le8 (B : Unsigned_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".byte 0x" & Hex_Image (Unsigned_8 (B)));
+      end if;
+      Gen_Le8 (B);
+   end Gen_Data_Le8;
+
+   procedure Gen_Data_Le16 (B : Unsigned_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".half 0x" & Hex_Image (Unsigned_16 (B)));
+      end if;
+      Gen_Le16 (B);
+   end Gen_Data_Le16;
+
+   procedure Gen_Data_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Dump_Asm then
+         if Sym = Null_Symbol then
+            Put_Line (HT & ".word 0x" & Hex_Image (Offset));
+         else
+            if Offset = 0 then
+               Put_Line (HT & ".word " & Get_Symbol_Name (Sym));
+            else
+               Put_Line (HT & ".word " & Get_Symbol_Name (Sym) & " + "
+                         & Hex_Image (Offset));
+            end if;
+         end if;
+      end if;
+      case Arch is
+         when Arch_X86 =>
+            Gen_X86_32 (Sym, Offset);
+         when Arch_Sparc =>
+            Gen_Sparc_32 (Sym, Offset);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Data_32;
+
+   function Create_Symbol (Name : O_Ident) return Symbol
+   is
+   begin
+      Symbols.Append (Symbol_Type'(Section => null,
+                                   Value => 0,
+                                   Scope => Sym_Undef,
+                                   Used => False,
+                                   Name => Name,
+                                   Relocs => null,
+                                   Number => 0));
+      return Symbols.Last;
+   end Create_Symbol;
+
+   Last_Label : Natural := 1;
+
+   function Create_Local_Symbol return Symbol is
+   begin
+      Symbols.Append (Symbol_Type'(Section => Cur_Sect,
+                                   Value => 0,
+                                   Scope => Sym_Local,
+                                   Used => False,
+                                   Name => O_Ident_Nul,
+                                   Relocs => null,
+                                   Number => Last_Label));
+
+      Last_Label := Last_Label + 1;
+
+      return Symbols.Last;
+   end Create_Local_Symbol;
+
+   function Get_Symbol_Name (Sym : Symbol) return String
+   is
+      Res : String (1 .. 10);
+      N : Natural;
+      P : Natural;
+   begin
+      if S_Local (Sym) then
+         N := Get_Number (Sym);
+         P := Res'Last;
+         loop
+            Res (P) := Character'Val ((N mod 10) + Character'Pos ('0'));
+            N := N / 10;
+            P := P - 1;
+            exit when N = 0;
+         end loop;
+         Res (P) := 'L';
+         Res (P - 1) := '.';
+         return Res (P - 1 .. Res'Last);
+      else
+         if Is_Nul (Get_Name (Sym)) then
+            return "ANON";
+         else
+            return Get_String (Get_Name (Sym));
+         end if;
+      end if;
+   end Get_Symbol_Name;
+
+   function Get_Symbol_Name_Length (Sym : Symbol) return Natural
+   is
+      N : Natural;
+   begin
+      if S_Local (Sym) then
+         N := 10;
+         for I in 3 .. 8 loop
+            if Get_Number (Sym) < N then
+               return I;
+            end if;
+            N := N * 10;
+         end loop;
+         raise Program_Error;
+      else
+         return Get_String_Length (Get_Name (Sym));
+      end if;
+   end Get_Symbol_Name_Length;
+
+   function Get_Symbol (Name : String) return Symbol is
+   begin
+      for I in Symbols.First .. Symbols.Last loop
+         if Get_Symbol_Name (I) = Name then
+            return I;
+         end if;
+      end loop;
+      return Null_Symbol;
+   end Get_Symbol;
+
+   function Pow_Align (V : Pc_Type; Align : Natural) return Pc_Type
+   is
+      Tmp : Pc_Type;
+   begin
+      Tmp := V + 2 ** Align - 1;
+      return Tmp - (Tmp mod Pc_Type (2 ** Align));
+   end Pow_Align;
+
+   procedure Gen_Pow_Align (Align : Natural) is
+   begin
+      if Align = 0 then
+         return;
+      end if;
+      if Dump_Asm then
+         Put_Line (HT & ".align" & Natural'Image (Align));
+      end if;
+      Cur_Sect.Pc := Pow_Align (Cur_Sect.Pc, Align);
+   end Gen_Pow_Align;
+
+   --  Generate LENGTH bytes set to 0.
+   procedure Gen_Space (Length : Integer_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".space" & Integer_32'Image (Length));
+      end if;
+      Cur_Sect.Pc := Cur_Sect.Pc + Pc_Type (Length);
+   end Gen_Space;
+
+   procedure Set_Symbol_Pc (Sym : Symbol; Export : Boolean) is
+   begin
+      case Get_Scope (Sym) is
+         when Sym_Local =>
+            if Export then
+               raise Program_Error;
+            end if;
+         when Sym_Private
+           | Sym_Global =>
+            raise Program_Error;
+         when Sym_Undef =>
+            if Export then
+               Set_Scope (Sym, Sym_Global);
+            else
+               Set_Scope (Sym, Sym_Private);
+            end if;
+      end case;
+      --  Set value/section.
+      Set_Symbol_Value (Sym, Cur_Sect.Pc);
+      Set_Section (Sym, Cur_Sect);
+
+      if Dump_Asm then
+         if Export then
+            Put_Line (HT & ".globl " & Get_Symbol_Name (Sym));
+         end if;
+         Put (Get_Symbol_Name (Sym));
+         Put_Line (":");
+      end if;
+   end Set_Symbol_Pc;
+
+   procedure Add_Reloc (Sym : Symbol; Kind : Reloc_Kind)
+   is
+      Reloc : Reloc_Acc;
+   begin
+      Reloc := new Reloc_Type'(Kind => Kind,
+                               Done => False,
+                               Sym_Next => Get_Relocs (Sym),
+                               Sect_Next => null,
+                               Addr => Cur_Sect.Pc,
+                               Sym => Sym);
+      Set_Relocs (Sym, Reloc);
+      if Cur_Sect.First_Reloc = null then
+         Cur_Sect.First_Reloc := Reloc;
+      else
+         Cur_Sect.Last_Reloc.Sect_Next := Reloc;
+      end if;
+      Cur_Sect.Last_Reloc := Reloc;
+      Cur_Sect.Nbr_Relocs := Cur_Sect.Nbr_Relocs + 1;
+   end Add_Reloc;
+
+   procedure Gen_X86_Pc32 (Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Pc32);
+      Gen_Le32 (16#ff_ff_ff_fc#);
+   end Gen_X86_Pc32;
+
+   procedure Gen_Sparc_Disp22 (W : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Disp22);
+      Gen_Be32 (W);
+   end Gen_Sparc_Disp22;
+
+   procedure Gen_Sparc_Disp30 (W : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Disp30);
+      Gen_Be32 (W);
+   end Gen_Sparc_Disp30;
+
+   procedure Gen_Sparc_Hi22 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32)
+   is
+      pragma Unreferenced (Off);
+   begin
+      Add_Reloc (Sym, Reloc_Hi22);
+      Gen_Be32 (W);
+   end Gen_Sparc_Hi22;
+
+   procedure Gen_Sparc_Lo10 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32)
+   is
+      pragma Unreferenced (Off);
+   begin
+      Add_Reloc (Sym, Reloc_Lo10);
+      Gen_Be32 (W);
+   end Gen_Sparc_Lo10;
+
+   function Conv is new Ada.Unchecked_Conversion
+     (Source => Integer_32, Target => Unsigned_32);
+
+   procedure Gen_X86_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_32);
+      end if;
+      Gen_Le32 (Conv (Offset));
+   end Gen_X86_32;
+
+   procedure Gen_Sparc_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_32);
+      end if;
+      Gen_Be32 (Conv (Offset));
+   end Gen_Sparc_32;
+
+   procedure Gen_Sparc_Ua_32 (Sym : Symbol; Offset : Integer_32)
+   is
+      pragma Unreferenced (Offset);
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_Ua_32);
+      end if;
+      Gen_Be32 (0);
+   end Gen_Sparc_Ua_32;
+
+   procedure Gen_Ua_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      case Arch is
+         when Arch_X86 =>
+            Gen_X86_32 (Sym, Offset);
+         when Arch_Sparc =>
+            Gen_Sparc_Ua_32 (Sym, Offset);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Ua_32;
+
+   procedure Gen_Ppc_24 (V : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Ppc_Addr24);
+      Gen_32 (V);
+   end Gen_Ppc_24;
+
+   function Get_Symbol_Vaddr (Sym : Symbol) return Pc_Type is
+   begin
+      return Get_Section (Sym).Vaddr + Get_Symbol_Value (Sym);
+   end Get_Symbol_Vaddr;
+
+   procedure Write_Left_Be32 (Sect : Section_Acc;
+                              Addr : Pc_Type;
+                              Size : Natural;
+                              Val : Unsigned_32)
+   is
+      W : Unsigned_32;
+      Mask : Unsigned_32;
+   begin
+      --  Write value.
+      Mask := Shift_Left (1, Size) - 1;
+      W := Read_Be32 (Sect, Addr);
+      Write_Be32 (Sect, Addr, (W and not Mask) or (Val and Mask));
+   end Write_Left_Be32;
+
+   procedure Set_Wdisp (Sect : Section_Acc;
+                        Addr : Pc_Type;
+                        Sym : Symbol;
+                        Size : Natural)
+   is
+      D : Unsigned_32;
+      Mask : Unsigned_32;
+   begin
+      D := Unsigned_32 (Get_Symbol_Vaddr (Sym) - (Sect.Vaddr + Addr));
+      --  Check overflow.
+      Mask := Shift_Left (1, Size + 2) - 1;
+      if (D and Shift_Left (1, Size + 1)) = 0 then
+         if (D and not Mask) /= 0 then
+            raise Program_Error;
+         end if;
+      else
+         if (D and not Mask) /= not Mask then
+            raise Program_Error;
+         end if;
+      end if;
+      --  Write value.
+      Write_Left_Be32 (Sect, Addr, Size, D / 4);
+   end Set_Wdisp;
+
+   procedure Do_Reloc (Kind : Reloc_Kind;
+                       Sect : Section_Acc; Addr : Pc_Type; Sym : Symbol)
+   is
+   begin
+      if Get_Scope (Sym) = Sym_Undef then
+         raise Program_Error;
+      end if;
+
+      case Kind is
+         when Reloc_32 =>
+            Add_Le32 (Sect, Addr, Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+
+         when Reloc_Pc32 =>
+            Add_Le32 (Sect, Addr,
+                      Unsigned_32 (Get_Symbol_Vaddr (Sym)
+                                     - (Sect.Vaddr + Addr)));
+         when Reloc_Disp22 =>
+            Set_Wdisp (Sect, Addr, Sym, 22);
+         when Reloc_Disp30 =>
+            Set_Wdisp (Sect, Addr, Sym, 30);
+         when Reloc_Hi22 =>
+            Write_Left_Be32 (Sect, Addr, 22,
+                             Unsigned_32 (Get_Symbol_Vaddr (Sym) / 1024));
+         when Reloc_Lo10 =>
+            Write_Left_Be32 (Sect, Addr, 10,
+                             Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+         when Reloc_Ua_32 =>
+            Write_Be32 (Sect, Addr, Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+         when Reloc_Ppc_Addr24 =>
+            raise Program_Error;
+      end case;
+   end Do_Reloc;
+
+   function Is_Reloc_Relative (Reloc : Reloc_Acc) return Boolean is
+   begin
+      case Reloc.Kind is
+         when Reloc_Pc32
+           | Reloc_Disp22
+           | Reloc_Disp30 =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Reloc_Relative;
+
+   procedure Apply_Reloc (Sect : Section_Acc; Reloc : Reloc_Acc) is
+   begin
+      Do_Reloc (Reloc.Kind, Sect, Reloc.Addr, Reloc.Sym);
+   end Apply_Reloc;
+
+   procedure Do_Intra_Section_Reloc (Sect : Section_Acc)
+   is
+      Prev : Reloc_Acc;
+      Rel : Reloc_Acc;
+      Next : Reloc_Acc;
+   begin
+      Rel := Sect.First_Reloc;
+      Prev := null;
+      while Rel /= null loop
+         Next := Rel.Sect_Next;
+         if Get_Scope (Rel.Sym) /= Sym_Undef then
+            Do_Reloc (Rel.Kind, Sect, Rel.Addr, Rel.Sym);
+            Rel.Done := True;
+
+            if Get_Section (Rel.Sym) = Sect
+              and then Is_Reloc_Relative (Rel)
+            then
+               --  Remove reloc.
+               Sect.Nbr_Relocs := Sect.Nbr_Relocs - 1;
+               if Prev = null then
+                  Sect.First_Reloc := Next;
+               else
+                  Prev.Sect_Next := Next;
+               end if;
+               if Next = null then
+                  Sect.Last_Reloc := Prev;
+               end if;
+               Free (Rel);
+            else
+               Prev := Rel;
+            end if;
+         else
+            Set_Used (Rel.Sym, True);
+            Prev := Rel;
+         end if;
+         Rel := Next;
+      end loop;
+   end Do_Intra_Section_Reloc;
+
+   --  Return VAL rounded up to 2 ^ POW.
+--    function Align_Pow (Val : Integer; Pow : Natural) return Integer
+--    is
+--       N : Integer;
+--       Tmp : Integer;
+--    begin
+--       N := 2 ** Pow;
+--       Tmp := Val + N - 1;
+--       return Tmp - (Tmp mod N);
+--    end Align_Pow;
+
+   procedure Disp_Stats is
+   begin
+      Put_Line ("Number of Symbols: " & Symbol'Image (Symbols.Last));
+   end Disp_Stats;
+
+   procedure Finish
+   is
+      Sect : Section_Acc;
+      Rel, N_Rel : Reloc_Acc;
+   begin
+      Symbols.Free;
+      Sect := Section_Chain;
+      while Sect /= null loop
+         --  Free relocs.
+         Rel := Sect.First_Reloc;
+         while Rel /= null loop
+            N_Rel := Rel.Sect_Next;
+            Free (Rel);
+            Rel := N_Rel;
+         end loop;
+         Sect.First_Reloc := null;
+         Sect.Last_Reloc := null;
+
+         Sect := Sect.Next;
+      end loop;
+   end Finish;
+end Binary_File;
diff --git a/src/ortho/mcode/binary_file.ads b/src/ortho/mcode/binary_file.ads
new file mode 100644
index 000000000..1a2bf588d
--- /dev/null
+++ b/src/ortho/mcode/binary_file.ads
@@ -0,0 +1,305 @@
+--  Binary file handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Interfaces; use Interfaces;
+with Ada.Unchecked_Deallocation;
+with Ortho_Ident; use Ortho_Ident;
+with GNAT.Table;
+with Memsegs;
+
+package Binary_File is
+   type Section_Type is limited private;
+   type Section_Acc is access Section_Type;
+
+   type Section_Flags is new Unsigned_32;
+   Section_None   : constant Section_Flags;
+   Section_Exec   : constant Section_Flags;
+   Section_Read   : constant Section_Flags;
+   Section_Write  : constant Section_Flags;
+   Section_Zero   : constant Section_Flags;
+   Section_Strtab : constant Section_Flags;
+   Section_Debug  : constant Section_Flags;
+
+   type Byte is new Unsigned_8;
+
+   type Symbol is range -2 ** 31 .. 2 ** 31 - 1;
+   for Symbol'Size use 32;
+   Null_Symbol : constant Symbol := 0;
+
+   type Pc_Type is mod System.Memory_Size;
+   Null_Pc : constant Pc_Type := 0;
+
+   type Arch_Kind is (Arch_Unknown, Arch_X86, Arch_Sparc, Arch_Ppc);
+   Arch : Arch_Kind := Arch_Unknown;
+
+   --  Dump assembly when generated.
+   Dump_Asm : Boolean := False;
+
+   Debug_Hex : Boolean := False;
+
+   --  Create a section.
+   procedure Create_Section (Sect : out Section_Acc;
+                             Name : String; Flags : Section_Flags);
+   procedure Set_Section_Info (Sect : Section_Acc;
+                               Link : Section_Acc;
+                               Align : Natural;
+                               Esize : Natural);
+
+   procedure Merge_Section (Dest : Section_Acc; Src : Section_Acc);
+
+   --  Set the current section.
+   procedure Set_Current_Section (Sect : Section_Acc);
+
+   --  Create an undefined local (anonymous) symbol in the  current section.
+   function Create_Local_Symbol return Symbol;
+   function Create_Symbol (Name : O_Ident) return Symbol;
+
+   --  Research symbol NAME, very expansive call.
+   --  Return NULL_Symbol if not found.
+   function Get_Symbol (Name : String) return Symbol;
+
+   --  Get the virtual address of a symbol.
+   function Get_Symbol_Vaddr (Sym : Symbol) return Pc_Type;
+   pragma Inline (Get_Symbol_Vaddr);
+
+   --  Set the value of a symbol.
+   procedure Set_Symbol_Pc (Sym : Symbol; Export : Boolean);
+   function Get_Symbol_Value (Sym : Symbol) return Pc_Type;
+
+   --  Get the current PC.
+   function Get_Current_Pc return Pc_Type;
+   pragma Inline (Get_Current_Pc);
+
+   function Get_Pc (Sect : Section_Acc) return Pc_Type;
+   pragma Inline (Get_Pc);
+
+   --  Align the current section of 2 ** ALIGN.
+   procedure Gen_Pow_Align (Align : Natural);
+
+   --  Generate LENGTH times 0.
+   procedure Gen_Space (Length : Integer_32);
+
+   --  Add a reloc in the current section at the current address.
+   procedure Gen_X86_Pc32 (Sym : Symbol);
+   procedure Gen_Sparc_Disp22 (W : Unsigned_32; Sym : Symbol);
+   procedure Gen_Sparc_Disp30 (W : Unsigned_32; Sym : Symbol);
+   procedure Gen_Sparc_Hi22 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32);
+   procedure Gen_Sparc_Lo10 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32);
+
+   --  Add a 32 bits value with a symbol relocation in the current section at
+   --  the current address.
+   procedure Gen_X86_32 (Sym : Symbol; Offset : Integer_32);
+   procedure Gen_Sparc_32 (Sym : Symbol; Offset : Integer_32);
+   procedure Gen_Sparc_Ua_32 (Sym : Symbol; Offset : Integer_32);
+
+   procedure Gen_Ppc_24 (V : Unsigned_32; Sym : Symbol);
+
+   procedure Gen_Ua_32 (Sym : Symbol; Offset : Integer_32);
+
+   --  Start/finish an instruction in the current section.
+   procedure Start_Insn;
+   procedure End_Insn;
+   --  Pre allocate L bytes.
+   procedure Prealloc (L : Pc_Type);
+
+   --  Add bits in the current section.
+   procedure Gen_B8 (B : Byte);
+   procedure Gen_B16 (B0, B1 : Byte);
+   procedure Gen_Le8 (B : Unsigned_32);
+   procedure Gen_Le16 (B : Unsigned_32);
+   procedure Gen_Be16 (B : Unsigned_32);
+   procedure Gen_Le32 (B : Unsigned_32);
+   procedure Gen_Be32 (B : Unsigned_32);
+
+   procedure Gen_16 (B : Unsigned_32);
+   procedure Gen_32 (B : Unsigned_32);
+
+   --  Add bits in the current section, but as stand-alone data.
+   procedure Gen_Data_Le8 (B : Unsigned_32);
+   procedure Gen_Data_Le16 (B : Unsigned_32);
+   procedure Gen_Data_32 (Sym : Symbol; Offset : Integer_32);
+
+   --  Modify already generated code.
+   procedure Patch_B8 (Pc : Pc_Type; V : Unsigned_8);
+   procedure Patch_Le32 (Pc : Pc_Type; V : Unsigned_32);
+   procedure Patch_Be32 (Pc : Pc_Type; V : Unsigned_32);
+   procedure Patch_Be16 (Pc : Pc_Type; V : Unsigned_32);
+   procedure Patch_32 (Pc : Pc_Type; V : Unsigned_32);
+
+   --  Binary writers:
+
+   --  Set ERROR in case of error (undefined symbol).
+   --procedure Write_Memory (Error : out Boolean);
+
+   procedure Disp_Stats;
+   procedure Finish;
+private
+   type Byte_Array_Base is array (Pc_Type range <>) of Byte;
+   subtype Byte_Array is Byte_Array_Base (Pc_Type);
+   type Byte_Array_Acc is access Byte_Array;
+   type String_Acc is access String;
+   --type Section_Flags is new Unsigned_32;
+
+   --  Relocations.
+   type Reloc_Kind is (Reloc_32, Reloc_Pc32,
+                       Reloc_Ua_32,
+                       Reloc_Disp22, Reloc_Disp30,
+                       Reloc_Hi22, Reloc_Lo10,
+                       Reloc_Ppc_Addr24);
+   type Reloc_Type;
+   type Reloc_Acc is access Reloc_Type;
+   type Reloc_Type is record
+      Kind : Reloc_Kind;
+      --  If true, the reloc was already applied.
+      Done : Boolean;
+      --  Next in simply linked list.
+      --  next reloc in the section.
+      Sect_Next : Reloc_Acc;
+      --  next reloc for the symbol.
+      Sym_Next : Reloc_Acc;
+      --  Address that must be relocated.
+      Addr : Pc_Type;
+      --  Symbol.
+      Sym : Symbol;
+   end record;
+
+   type Section_Type is record
+      --  Simply linked list of sections.
+      Next : Section_Acc;
+      --  Flags.
+      Flags : Section_Flags;
+      --  Name of the section.
+      Name : String_Acc;
+      --  Link to another section (used by ELF).
+      Link : Section_Acc;
+      --  Alignment (in power of 2).
+      Align : Natural;
+      --  Entry size (if any).
+      Esize : Natural;
+      --  Offset of the next data in DATA.
+      Pc : Pc_Type;
+      --  Offset of the current instruction.
+      Insn_Pc : Pc_Type;
+      --  Data for this section.
+      Data : Byte_Array_Acc;
+      --  Max address for data (before extending the area).
+      Data_Max : Pc_Type;
+      --  Chain of relocs defined in this section.
+      First_Reloc : Reloc_Acc;
+      Last_Reloc : Reloc_Acc;
+      --  Number of relocs in this section.
+      Nbr_Relocs : Natural;
+      --  Section number (set and used by binary writer).
+      Number : Natural;
+      --  Virtual address, if set.
+      Vaddr : Pc_Type; -- SSE.Integer_Address;
+      --  Memory for this segment.
+      Seg : Memsegs.Memseg_Type;
+   end record;
+
+   Section_Exec   : constant Section_Flags := 2#0000_0001#;
+   Section_Read   : constant Section_Flags := 2#0000_0010#;
+   Section_Write  : constant Section_Flags := 2#0000_0100#;
+   Section_Zero   : constant Section_Flags := 2#0000_1000#;
+   Section_Strtab : constant Section_Flags := 2#0001_0000#;
+   Section_Debug  : constant Section_Flags := 2#0010_0000#;
+   Section_None   : constant Section_Flags := 2#0000_0000#;
+
+   --  Scope of a symbol:
+   --  SYM_PRIVATE: not visible outside of the file.
+   --  SYM_UNDEF: not (yet) defined, unresolved.
+   --  SYM_GLOBAL: visible to all files.
+   --  SYM_LOCAL: locally generated symbol.
+   type Symbol_Scope is (Sym_Undef, Sym_Global, Sym_Private, Sym_Local);
+   subtype Symbol_Scope_External is Symbol_Scope range Sym_Undef .. Sym_Global;
+   type Symbol_Type is record
+      Section : Section_Acc;
+      Value : Pc_Type;
+      Scope : Symbol_Scope;
+      --  True if the symbol is referenced/used.
+      Used : Boolean;
+      --  Name of the symbol.
+      Name : O_Ident;
+      --  List of relocation made with this symbol.
+      Relocs : Reloc_Acc;
+      --  Symbol number, from 0.
+      Number : Natural;
+   end record;
+
+   --  Number of sections.
+   Nbr_Sections : Natural := 0;
+   --  Simply linked list of sections.
+   Section_Chain : Section_Acc := null;
+   Section_Last : Section_Acc := null;
+
+   package Symbols is new GNAT.Table
+     (Table_Component_Type => Symbol_Type,
+      Table_Index_Type => Symbol,
+      Table_Low_Bound => 2,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   function Pow_Align (V : Pc_Type; Align : Natural) return Pc_Type;
+
+   function Get_Symbol_Name (Sym : Symbol) return String;
+   function Get_Symbol_Name_Length (Sym : Symbol) return Natural;
+
+   procedure Set_Symbol_Value (Sym : Symbol; Val : Pc_Type);
+   pragma Inline (Set_Symbol_Value);
+
+   procedure Set_Scope (Sym : Symbol; Scope : Symbol_Scope);
+   pragma Inline (Set_Scope);
+
+   function Get_Scope (Sym : Symbol) return Symbol_Scope;
+   pragma Inline (Get_Scope);
+
+   function Get_Section (Sym : Symbol) return Section_Acc;
+   pragma Inline (Get_Section);
+
+   procedure Set_Section (Sym : Symbol; Sect : Section_Acc);
+   pragma Inline (Set_Section);
+
+   function Get_Name (Sym : Symbol) return O_Ident;
+   pragma Inline (Get_Name);
+
+   procedure Apply_Reloc (Sect : Section_Acc; Reloc : Reloc_Acc);
+   pragma Inline (Apply_Reloc);
+
+   procedure Set_Number (Sym : Symbol; Num : Natural);
+   pragma Inline (Set_Number);
+
+   function Get_Number (Sym : Symbol) return Natural;
+   pragma Inline (Get_Number);
+
+   function Get_Used (Sym : Symbol) return Boolean;
+   pragma Inline (Get_Used);
+
+   procedure Do_Intra_Section_Reloc (Sect : Section_Acc);
+
+   function S_Local (Sym : Symbol) return Boolean;
+   pragma Inline (S_Local);
+
+   procedure Resize (Sect : Section_Acc; Size : Pc_Type);
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => Reloc_Acc, Object => Reloc_Type);
+
+   Write_Error : exception;
+end Binary_File;
diff --git a/src/ortho/mcode/coff.ads b/src/ortho/mcode/coff.ads
new file mode 100644
index 000000000..6ef9cdde9
--- /dev/null
+++ b/src/ortho/mcode/coff.ads
@@ -0,0 +1,208 @@
+--  COFF definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+with System; use System;
+
+package Coff is
+   type Filehdr is record
+      F_Magic : Unsigned_16;    --  Magic number.
+      F_Nscns : Unsigned_16;    --  Number of sections.
+      F_Timdat : Unsigned_32;   --  Time and date stamp.
+      F_Symptr : Unsigned_32;   --  File pointer to symtab.
+      F_Nsyms : Unsigned_32;    --  Number of symtab entries.
+      F_Opthdr : Unsigned_16;   --  Size of optionnal header.
+      F_Flags : Unsigned_16;    --  Flags;
+   end record;
+
+   --  Size of Filehdr.
+   Filehdr_Size : constant Natural := Filehdr'Size / Storage_Unit;
+
+   --  Magic numbers.
+   I386magic : constant Unsigned_16 := 16#014c#;
+
+   --  Flags of file header.
+   --  Relocation info stripped from file.
+   F_Relflg : constant Unsigned_16 := 16#0001#;
+
+   --  File is executable (no unresolved symbols).
+   F_Exec : constant Unsigned_16 := 16#0002#;
+
+   --  Line numbers stripped from file.
+   F_Lnno : constant Unsigned_16 := 16#0004#;
+
+   --  Local symbols stripped from file.
+   F_Lsyms : constant Unsigned_16 := 16#0008#;
+
+   type Scnhdr is record
+      S_Name : String (1 .. 8); --  Section name.
+      S_Paddr : Unsigned_32;    --  Physical address.
+      S_Vaddr : Unsigned_32;    --  Virtual address.
+      S_Size : Unsigned_32;     --  Section size.
+      S_Scnptr : Unsigned_32;   --  File pointer to raw section data.
+      S_Relptr : Unsigned_32;   --  File pointer to relocation data.
+      S_Lnnoptr : Unsigned_32;  --  File pointer to line number data.
+      S_Nreloc : Unsigned_16;   --  Number of relocation entries.
+      S_Nlnno : Unsigned_16;    --  Number of line number entries.
+      S_Flags : Unsigned_32;    --  Flags.
+   end record;
+   Scnhdr_Size : constant Natural := Scnhdr'Size / Storage_Unit;
+
+   -- section contains text only.
+   STYP_TEXT : constant Unsigned_32 := 16#0020#;
+   -- section contains data only.
+   STYP_DATA : constant Unsigned_32 := 16#0040#;
+   -- section contains bss only.
+   STYP_BSS  : constant Unsigned_32 := 16#0080#;
+
+   type Strent_Type is record
+      E_Zeroes : Unsigned_32;
+      E_Offset : Unsigned_32;
+   end record;
+
+   type Sym_Name (Inline : Boolean := True) is record
+      case Inline is
+         when True =>
+            E_Name : String (1 .. 8);
+         when False =>
+            E : Strent_Type;
+      end case;
+   end record;
+   pragma Unchecked_Union (Sym_Name);
+   for Sym_Name'Size use 64;
+
+   type Syment is record
+      E : Sym_Name;             --  Name of the symbol
+      E_Value : Unsigned_32;    --  Value
+      E_Scnum : Unsigned_16;    --  Section
+      E_Type : Unsigned_16;
+      E_Sclass : Unsigned_8;
+      E_Numaux : Unsigned_8;
+   end record;
+   Symesz : constant Natural := 18;
+   for Syment'Size use Symesz * Storage_Unit;
+
+   --  An undefined (extern) symbol.
+   N_UNDEF : constant Unsigned_16 := 16#00_00#;
+   --  An absolute symbol (e_value is a constant, not an address).
+   N_ABS   : constant Unsigned_16 := 16#Ff_Ff#;
+   --  A debugging symbol.
+   N_DEBUG : constant Unsigned_16 := 16#Ff_Fe#;
+
+   C_NULL    : constant Unsigned_8 := 0;
+   C_AUTO    : constant Unsigned_8 := 1;
+   C_EXT     : constant Unsigned_8 := 2;
+   C_STAT    : constant Unsigned_8 := 3;
+   C_REG     : constant Unsigned_8 := 4;
+   C_EXTDEF  : constant Unsigned_8 := 5;
+   C_LABEL   : constant Unsigned_8 := 6;
+   C_ULABEL  : constant Unsigned_8 := 7;
+   C_MOS     : constant Unsigned_8 := 8;
+   C_ARG     : constant Unsigned_8 := 9;
+   C_STRTAG  : constant Unsigned_8 := 10;
+   C_MOU     : constant Unsigned_8 := 11;
+   C_UNTAG   : constant Unsigned_8 := 12;
+   C_TPDEF   : constant Unsigned_8 := 13;
+   C_USTATIC : constant Unsigned_8 := 14;
+   C_ENTAG   : constant Unsigned_8 := 15;
+   C_MOE     : constant Unsigned_8 := 16;
+   C_REGPARM : constant Unsigned_8 := 17;
+   C_FIELD   : constant Unsigned_8 := 18;
+   C_AUTOARG : constant Unsigned_8 := 19;
+   C_LASTENT : constant Unsigned_8 := 20;
+   C_BLOCK   : constant Unsigned_8 := 100;
+   C_FCN     : constant Unsigned_8 := 101;
+   C_EOS     : constant Unsigned_8 := 102;
+   C_FILE    : constant Unsigned_8 := 103;
+   C_LINE    : constant Unsigned_8 := 104;
+   C_ALIAS   : constant Unsigned_8 := 105;
+   C_HIDDEN  : constant Unsigned_8 := 106;
+   C_EFCN    : constant Unsigned_8 := 255;
+
+   --  Textual description of sclass.
+   type Const_String_Acc is access constant String;
+   type Sclass_Desc_Type is record
+      Name : Const_String_Acc;
+      Meaning : Const_String_Acc;
+   end record;
+   type Sclass_Desc_Array_Type is array (Unsigned_8) of Sclass_Desc_Type;
+   Sclass_Desc : constant Sclass_Desc_Array_Type;
+
+   type Auxent_File (Inline : Boolean := True) is record
+      case Inline is
+         when True =>
+            X_Fname : String (1 .. 14);
+         when False =>
+            X_N : Strent_Type;
+      end case;
+   end record;
+   pragma Unchecked_Union (Auxent_File);
+
+   type Auxent_Scn is record
+      X_Scnlen : Unsigned_32;
+      X_Nreloc : Unsigned_16;
+      X_Nlinno : Unsigned_16;
+   end record;
+
+   --  Relocation.
+   type Reloc is record
+      R_Vaddr : Unsigned_32;
+      R_Symndx : Unsigned_32;
+      R_Type : Unsigned_16;
+   end record;
+   Relsz : constant Natural := Reloc'Size / Storage_Unit;
+
+   Reloc_Rel32  : constant Unsigned_16 := 20;
+   Reloc_Addr32 : constant Unsigned_16 := 6;
+
+private
+   subtype S is String;
+   Sclass_Desc : constant Sclass_Desc_Array_Type :=
+     (C_NULL => (new S'("C_NULL"), new S'("No entry")),
+      C_AUTO => (new S'("C_AUTO"), new S'("Automatic variable")),
+      C_EXT => (new S'("C_EXT"), new S'("External/public symbol")),
+      C_STAT => (new S'("C_STAT"), new S'("static (private) symbol")),
+      C_REG => (new S'("C_REG"), new S'("register variable")),
+      C_EXTDEF => (new S'("C_EXTDEF"), new S'("External definition")),
+      C_LABEL => (new S'("C_LABEL"), new S'("label")),
+      C_ULABEL => (new S'("C_ULABEL"), new S'("undefined label")),
+      C_MOS => (new S'("C_MOS"), new S'("member of structure")),
+      C_ARG => (new S'("C_ARG"), new S'("function argument")),
+      C_STRTAG => (new S'("C_STRTAG"), new S'("structure tag")),
+      C_MOU => (new S'("C_MOU"), new S'("member of union")),
+      C_UNTAG => (new S'("C_UNTAG"), new S'("union tag")),
+      C_TPDEF => (new S'("C_TPDEF"), new S'("type definition")),
+      C_USTATIC => (new S'("C_USTATIC"), new S'("undefined static")),
+      C_ENTAG => (new S'("C_ENTAG"), new S'("enumaration tag")),
+      C_MOE => (new S'("C_MOE"), new S'("member of enumeration")),
+      C_REGPARM => (new S'("C_REGPARM"), new S'("register parameter")),
+      C_FIELD => (new S'("C_FIELD"), new S'("bit field")),
+      C_AUTOARG => (new S'("C_AUTOARG"), new S'("auto argument")),
+      C_LASTENT => (new S'("C_LASTENT"), new S'("dummy entry (end of block)")),
+      C_BLOCK => (new S'("C_BLOCK"), new S'("beginning or end of block")),
+      C_FCN => (new S'("C_FCN"), new S'("beginning or end of function")),
+      C_EOS => (new S'("C_EOS"), new S'("end of structure")),
+      C_FILE => (new S'("C_FILE"), new S'("file name")),
+      C_LINE => (new S'("C_LINE"),
+                 new S'("line number, reformatted as symbol")),
+      C_ALIAS => (new S'("C_ALIAS"), new S'("duplicate tag")),
+      C_HIDDEN => (new S'("C_HIDDEN"),
+                   new S'("ext symbol in dmert public lib")),
+      C_EFCN => (new S'("C_EFCN"), new S'("physical end of function")),
+      others => (null, null));
+
+end Coff;
diff --git a/src/ortho/mcode/coffdump.adb b/src/ortho/mcode/coffdump.adb
new file mode 100644
index 000000000..6384b6c27
--- /dev/null
+++ b/src/ortho/mcode/coffdump.adb
@@ -0,0 +1,274 @@
+--  COFF dumper.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Coff; use Coff;
+with Interfaces; use Interfaces;
+with System;
+with Ada.Unchecked_Conversion;
+with Ada.Command_Line; use Ada.Command_Line;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ada.Text_IO; use Ada.Text_IO;
+with Hex_Images; use Hex_Images;
+
+procedure Coffdump is
+   type Cstring is array (Unsigned_32 range <>) of Character;
+   type Cstring_Acc is access Cstring;
+   type Section_Array is array (Unsigned_16 range <>) of Scnhdr;
+   type Section_Array_Acc is access Section_Array;
+   --  Array of sections.
+   Sections : Section_Array_Acc;
+
+   type External_Symbol is array (0 .. Symesz - 1) of Character;
+   type External_Symbol_Array is array (Unsigned_32 range <>)
+     of External_Symbol;
+   type Symbol_Array_Acc is access External_Symbol_Array;
+   --  Symbols table.
+   External_Symbols : Symbol_Array_Acc;
+
+   --  String table.
+   Str : Cstring_Acc;
+   Str_Size : Natural;
+
+   Hdr : Filehdr;
+   --Sym : Syment;
+   Fd : File_Descriptor;
+   Skip : Natural;
+   Skip_Kind : Unsigned_8;
+   Aux_File : Auxent_File;
+   Aux_Scn : Auxent_Scn;
+   Rel : Reloc;
+   Len : Natural;
+
+   Nul : constant Character := Character'Val (0);
+
+   function Find_Nul (S : String) return String is
+   begin
+      for I in S'Range loop
+         if S (I) = Nul then
+            return S (S'First .. I - 1);
+         end if;
+      end loop;
+      return S;
+   end Find_Nul;
+
+   function Get_String (N : Strent_Type; S : String) return String
+   is
+   begin
+      if N.E_Zeroes /= 0 then
+         return Find_Nul (S);
+      else
+         for I in N.E_Offset .. Str'Last loop
+            if Str (I) = Nul then
+               return String (Str (N.E_Offset .. I - 1));
+            end if;
+         end loop;
+         raise Program_Error;
+      end if;
+   end Get_String;
+
+   procedure Memcpy
+     (Dst : System.Address; Src : System.Address; Size : Natural);
+   pragma Import (C, Memcpy);
+
+   function Get_Section_Name (N : Unsigned_16) return String is
+   begin
+      if N = N_UNDEF then
+         return "UNDEF";
+      elsif N = N_ABS then
+         return "ABS";
+      elsif N = N_DEBUG then
+         return "DEBUG";
+      elsif N > Hdr.F_Nscns then
+         return "???";
+      else
+         return Find_Nul (Sections (N).S_Name);
+      end if;
+   end Get_Section_Name;
+
+   function Get_Symbol (N : Unsigned_32) return Syment is
+      function Unchecked_Conv is new Ada.Unchecked_Conversion
+        (Source => External_Symbol, Target => Syment);
+   begin
+      if N > Hdr.F_Nsyms then
+         raise Constraint_Error;
+      end if;
+      return Unchecked_Conv (External_Symbols (N));
+   end Get_Symbol;
+
+   function Get_Symbol_Name (N : Unsigned_32) return String
+   is
+      S : Syment := Get_Symbol (N);
+   begin
+      return Get_String (S.E.E, S.E.E_Name);
+   end Get_Symbol_Name;
+begin
+   for I in 1 .. Argument_Count loop
+      Fd := Open_Read (Argument (I), Binary);
+      if Fd = Invalid_FD then
+         Put_Line ("cannot open " & Argument (I));
+         return;
+      end if;
+      --  Read file header.
+      if Read (Fd, Hdr'Address, Filehdr_Size) /= Filehdr_Size then
+         Put_Line ("cannot read header");
+         return;
+      end if;
+      Put_Line ("File: " & Argument (I));
+      Put_Line ("magic:               " & Hex_Image (Hdr.F_Magic));
+      Put_Line ("number of sections:  " & Hex_Image (Hdr.F_Nscns));
+      Put_Line ("time and date stamp: " & Hex_Image (Hdr.F_Timdat));
+      Put_Line ("symtab file pointer: " & Hex_Image (Hdr.F_Symptr));
+      Put_Line ("nbr symtab entries:  " & Hex_Image (Hdr.F_Nsyms));
+      Put_Line ("opt header size:     " & Hex_Image (Hdr.F_Opthdr));
+      Put_Line ("flags:               " & Hex_Image (Hdr.F_Flags));
+
+      --  Read sections header.
+      Lseek (Fd, Long_Integer (Hdr.F_Opthdr), Seek_Cur);
+      Sections := new Section_Array (1 .. Hdr.F_Nscns);
+      Len := Scnhdr_Size * Natural (Hdr.F_Nscns);
+      if Read (Fd, Sections (1)'Address, Len) /= Len then
+         Put_Line ("cannot read section header");
+         return;
+      end if;
+      for I in 1 .. Hdr.F_Nscns loop
+         declare
+            S: Scnhdr renames Sections (I);
+         begin
+            Put_Line ("Section " & Find_Nul (S.S_Name));
+            Put_Line ("Physical address :     " & Hex_Image (S.S_Paddr));
+            Put_Line ("Virtual address :      " & Hex_Image (S.S_Vaddr));
+            Put_Line ("section size :         " & Hex_Image (S.S_Size));
+            Put_Line ("section pointer :      " & Hex_Image (S.S_Scnptr));
+            Put_Line ("relocation pointer :   " & Hex_Image (S.S_Relptr));
+            Put_Line ("line num pointer :     " & Hex_Image (S.S_Lnnoptr));
+            Put_Line ("Nbr reloc entries :    " & Hex_Image (S.S_Nreloc));
+            Put_Line ("Nbr line num entries : " & Hex_Image (S.S_Nlnno));
+            Put_Line ("Flags :                " & Hex_Image (S.S_Flags));
+         end;
+      end loop;
+
+      --  Read string table.
+      Lseek (Fd,
+             Long_Integer (Hdr.F_Symptr + Hdr.F_Nsyms * Unsigned_32 (Symesz)),
+             Seek_Set);
+      if Read (Fd, Str_Size'Address, 4) /= 4 then
+         Put_Line ("cannot read string table size");
+         return;
+      end if;
+      Str := new Cstring (0 .. Unsigned_32 (Str_Size));
+      if Read (Fd, Str (4)'Address, Str_Size - 4) /= Str_Size - 4 then
+         Put_Line ("cannot read string table");
+         return;
+      end if;
+
+      --  Read symbol table.
+      Lseek (Fd, Long_Integer (Hdr.F_Symptr), Seek_Set);
+      External_Symbols := new External_Symbol_Array (0 .. Hdr.F_Nsyms - 1);
+      Len := Natural (Hdr.F_Nsyms) * Symesz;
+      if Read (Fd, External_Symbols (0)'Address, Len) /= Len then
+            Put_Line ("cannot read symbol");
+            return;
+         end if;
+
+      Skip := 0;
+      Skip_Kind := C_NULL;
+      for I in External_Symbols'range loop
+         if Skip > 0 then
+            case Skip_Kind is
+               when C_FILE =>
+                  Memcpy (Aux_File'Address, External_Symbols (I)'Address,
+                          Aux_File'Size / 8);
+                  Put_Line ("aux file : " & Get_String (Aux_File.X_N,
+                                                        Aux_File.X_Fname));
+                  Skip_Kind := C_NULL;
+               when C_STAT =>
+                  Memcpy (Aux_Scn'Address, External_Symbols (I)'Address,
+                          Aux_Scn'Size / 8);
+                  Put_Line ("section len:   " & Hex_Image (Aux_Scn.X_Scnlen));
+                  Put_Line ("nbr reloc ent: " & Hex_Image (Aux_Scn.X_Nreloc));
+                  Put_Line ("nbr line num:  " & Hex_Image (Aux_Scn.X_Nlinno));
+               when others =>
+                  Put_Line ("skip");
+            end case;
+            Skip := Skip - 1;
+         else
+            declare
+               S : Syment := Get_Symbol (I);
+            begin
+               Put_Line ("Symbol #" & Hex_Image (I));
+               Put_Line ("symbol name : " & Get_Symbol_Name (I));
+               Put_Line ("symbol value: " & Hex_Image (S.E_Value));
+               Put_Line ("section num : " & Hex_Image (S.E_Scnum)
+                         & "  " & Get_Section_Name (S.E_Scnum));
+               Put_Line ("type        : " & Hex_Image (S.E_Type));
+               Put      ("sclass      : " & Hex_Image (S.E_Sclass));
+               if Sclass_Desc (S.E_Sclass).Name /= null then
+                  Put ("  (");
+                  Put (Sclass_Desc (S.E_Sclass).Name.all);
+                  Put (" - ");
+                  Put (Sclass_Desc (S.E_Sclass).Meaning.all);
+                  Put (")");
+               end if;
+               New_Line;
+               Put_Line ("numaux      : " & Hex_Image (S.E_Numaux));
+               if S.E_Numaux > 0 then
+                  case S.E_Sclass is
+                     when C_FILE =>
+                        Skip_Kind := C_FILE;
+                     when C_STAT =>
+                        Skip_Kind := C_STAT;
+                     when others =>
+                        Skip_Kind := C_NULL;
+                  end case;
+               end if;
+               Skip := Natural (S.E_Numaux);
+            end;
+         end if;
+      end loop;
+
+      --  Disp relocs.
+      for I in 1 .. Hdr.F_Nscns loop
+         if Sections (I).S_Nreloc > 0 then
+            --  Read relocations.
+            Put_Line ("Relocations for section " & Get_Section_Name (I));
+            Lseek (Fd, Long_Integer (Sections (I).S_Relptr), Seek_Set);
+            for J in 1 .. Sections (I).S_Nreloc loop
+               if Read (Fd, Rel'Address, Relsz) /= Relsz then
+                  Put_Line ("cannot read reloc");
+                  return;
+               end if;
+               Put_Line ("reloc virtual addr: " & Hex_Image (Rel.R_Vaddr));
+               Put_Line ("symbol index      : " & Hex_Image (Rel.R_Symndx)
+                         & "  " & Get_Symbol_Name (Rel.R_Symndx));
+               Put ("type of relocation: " & Hex_Image (Rel.R_Type));
+               case Rel.R_Type is
+                  when Reloc_Rel32 =>
+                     Put (" RELOC_REL32");
+                  when Reloc_Addr32 =>
+                     Put (" RELOC_ADDR32");
+                  when others =>
+                     null;
+               end case;
+               New_Line;
+            end loop;
+         end if;
+      end loop;
+
+      Close (Fd);
+   end loop;
+end Coffdump;
+
diff --git a/src/ortho/mcode/disa_sparc.adb b/src/ortho/mcode/disa_sparc.adb
new file mode 100644
index 000000000..8c9176ff8
--- /dev/null
+++ b/src/ortho/mcode/disa_sparc.adb
@@ -0,0 +1,274 @@
+with System; use System;
+with Interfaces; use Interfaces;
+with Ada.Unchecked_Conversion;
+with Hex_Images; use Hex_Images;
+
+package body Disa_Sparc is
+   subtype Reg_Type is Unsigned_32 range 0 .. 31;
+
+   type Hex_Map_Type is array (Unsigned_32 range 0 .. 15) of Character;
+   Hex_Digit : constant Hex_Map_Type := "0123456789abcdef";
+
+   type Cstring_Acc is access constant String;
+   type Cond_Map_Type is array (Unsigned_32 range 0 .. 15) of Cstring_Acc;
+   subtype S is String;
+   Bicc_Map : constant Cond_Map_Type :=
+     (0 => new S'("n"),
+      1 => new S'("e"),
+      2 => new S'("le"),
+      3 => new S'("l"),
+      4 => new S'("leu"),
+      5 => new S'("cs"),
+      6 => new S'("neg"),
+      7 => new S'("vs"),
+      8 => new S'("a"),
+      9 => new S'("ne"),
+      10 => new S'("g"),
+      11 => new S'("ge"),
+      12 => new S'("gu"),
+      13 => new S'("cc"),
+      14 => new S'("pos"),
+      15 => new S'("vc")
+      );
+
+
+   type Format_Type is
+      (
+       Format_Bad,
+       Format_Regimm, --  format 3, rd, rs1, rs2 or imm13
+       Format_Rd,     --  format 3, rd only.
+       Format_Copro,  --  format 3, fpu or coprocessor
+       Format_Asi     --  format 3, rd, rs1, asi and rs2.
+       );
+
+   type Insn_Desc_Type is record
+      Name : Cstring_Acc;
+      Format : Format_Type;
+   end record;
+
+   type Insn_Desc_Array is array (Unsigned_32 range 0 .. 63) of Insn_Desc_Type;
+   Insn_Desc_10 : constant Insn_Desc_Array :=
+     (
+      2#000_000# => (new S'("add"), Format_Regimm),
+      2#000_001# => (new S'("and"), Format_Regimm),
+      2#000_010# => (new S'("or"), Format_Regimm),
+      2#000_011# => (new S'("xor"), Format_Regimm),
+      2#000_100# => (new S'("sub"), Format_Regimm),
+      2#000_101# => (new S'("andn"), Format_Regimm),
+      2#000_110# => (new S'("orn"), Format_Regimm),
+      2#000_111# => (new S'("xnor"), Format_Regimm),
+      2#001_000# => (new S'("addx"), Format_Regimm),
+
+      2#001_100# => (new S'("subx"), Format_Regimm),
+
+      2#010_000# => (new S'("addcc"), Format_Regimm),
+      2#010_001# => (new S'("andcc"), Format_Regimm),
+      2#010_010# => (new S'("orcc"), Format_Regimm),
+      2#010_011# => (new S'("xorcc"), Format_Regimm),
+      2#010_100# => (new S'("subcc"), Format_Regimm),
+      2#010_101# => (new S'("andncc"), Format_Regimm),
+      2#010_110# => (new S'("orncc"), Format_Regimm),
+      2#010_111# => (new S'("xnorcc"), Format_Regimm),
+      2#011_000# => (new S'("addxcc"), Format_Regimm),
+
+      2#011_100# => (new S'("subxcc"), Format_Regimm),
+
+      2#111_000# => (new S'("jmpl"), Format_Regimm),
+
+      2#111_100# => (new S'("save"), Format_Regimm),
+      2#111_101# => (new S'("restore"), Format_Regimm),
+
+      others => (null, Format_Bad)
+      );
+
+   Insn_Desc_11 : constant Insn_Desc_Array :=
+     (
+      2#000_000# => (new S'("ld"), Format_Regimm),
+      2#000_001# => (new S'("ldub"), Format_Regimm),
+      2#000_010# => (new S'("lduh"), Format_Regimm),
+      2#000_011# => (new S'("ldd"), Format_Regimm),
+      2#000_100# => (new S'("st"), Format_Regimm),
+      2#000_101# => (new S'("stb"), Format_Regimm),
+
+      2#010_000# => (new S'("lda"), Format_Asi),
+      2#010_011# => (new S'("ldda"), Format_Asi),
+
+      2#110_000# => (new S'("ldc"), Format_Regimm),
+      2#110_001# => (new S'("ldcsr"), Format_Regimm),
+
+      others => (null, Format_Bad)
+      );
+
+   --  Disassemble instruction at ADDR, and put the result in LINE/LINE_LEN.
+   procedure Disassemble_Insn (Addr : Address;
+                               Line : in out String;
+                               Line_Len : out Natural;
+                               Insn_Len : out Natural;
+                               Proc_Cb : Symbol_Proc_Type)
+   is
+      type Unsigned_32_Acc is access Unsigned_32;
+      function To_Unsigned_32_Acc is new Ada.Unchecked_Conversion
+        (Source => Address, Target => Unsigned_32_Acc);
+
+      W : Unsigned_32;
+      Lo : Natural;
+
+      --  Add CHAR to the line.
+      procedure Add_Char (C : Character);
+      pragma Inline (Add_Char);
+
+      procedure Add_Char (C : Character) is
+      begin
+         Line (Lo) := C;
+         Lo := Lo + 1;
+      end Add_Char;
+
+      --  Add STR to the line.
+      procedure Add_String (Str : String) is
+      begin
+         Line (Lo .. Lo + Str'Length - 1) := Str;
+         Lo := Lo + Str'Length;
+      end Add_String;
+
+      --  Add BYTE to the line.
+--       procedure Add_Byte (V : Byte) is
+--          type My_Str is array (Natural range 0 .. 15) of Character;
+--          Hex_Digit : constant My_Str := "0123456789abcdef";
+--       begin
+--          Add_Char (Hex_Digit (Natural (Shift_Right (V, 4) and 16#0f#)));
+--          Add_Char (Hex_Digit (Natural (Shift_Right (V, 0) and 16#0f#)));
+--       end Add_Byte;
+
+      procedure Disp_Const (Mask : Unsigned_32)
+      is
+         L : Natural;
+         V : Unsigned_32;
+      begin
+         L := Lo;
+         Proc_Cb.all (Addr, Line (Lo .. Line'Last), Lo);
+         V := W and Mask;
+
+         -- Extend sign.
+         if (W and ((Mask + 1) / 2)) /= 0 then
+            V := V or not Mask;
+         end if;
+         if L /= Lo then
+            if V = 0 then
+               return;
+            end if;
+            Add_String (" + ");
+         end if;
+         Add_String ("0x");
+         Add_String (Hex_Image (V));
+      end Disp_Const;
+
+      procedure Add_Cond (Str : String)
+      is
+      begin
+         Add_String (Str);
+         Add_String (Bicc_Map (Shift_Right (W, 25) and 2#1111#).all);
+         if (W and 16#2000_0000#) /= 0 then
+            Add_String (",a");
+         end if;
+         Add_Char (' ');
+         Disp_Const (16#3f_Ffff#);
+      end Add_Cond;
+
+
+      procedure Add_Ireg (R : Reg_Type)
+      is
+      begin
+         Add_Char ('%');
+         if R <= 7 then
+            Add_Char ('g');
+         elsif R <= 15 then
+            if R = 14 then
+               Add_String ("sp");
+               return;
+            else
+               Add_Char ('o');
+            end if;
+         elsif R <= 23 then
+            Add_Char ('l');
+         else
+            if R = 30 then
+               Add_String ("fp");
+               return;
+            else
+               Add_Char ('i');
+            end if;
+         end if;
+         Add_Char (Hex_Digit (R and 7));
+      end Add_Ireg;
+
+      procedure Disp_Unknown is
+      begin
+         Add_String ("unknown ");
+         Add_String (Hex_Image (W));
+      end Disp_Unknown;
+
+      procedure Disp_Format3 (Map : Insn_Desc_Array)
+      is
+         Op2 : Unsigned_32 range 0 .. 63;
+      begin
+         Op2 := Shift_Right (W, 19) and 2#111_111#;
+
+         case Map (Op2).Format is
+            when Format_Regimm =>
+               Add_String (Map (Op2).Name.all);
+               Add_Char (' ');
+               Add_Ireg (Shift_Right (W, 25) and 31);
+               Add_Char (',');
+               Add_Ireg (Shift_Right (W, 14) and 31);
+               Add_Char (',');
+               if (W and 16#2000#) /= 0 then
+                  Disp_Const (16#1fff#);
+               else
+                  Add_Ireg (W and 31);
+               end if;
+            when others =>
+               Add_String ("unknown3, op2=");
+               Add_String (Hex_Image (Op2));
+         end case;
+      end Disp_Format3;
+
+
+   begin
+      W := To_Unsigned_32_Acc (Addr).all;
+      Insn_Len := 4;
+      Lo := Line'First;
+
+      case Shift_Right (W, 30) is
+         when 2#00# =>
+            --  BIcc, SETHI
+            case Shift_Right (W, 22) and 2#111# is
+               when 2#000# =>
+                  Add_String ("unimp ");
+                  Disp_Const (16#3f_Ffff#);
+               when 2#010# =>
+                  Add_Cond ("b");
+               when 2#100# =>
+                  Add_String ("sethi ");
+                  Add_Ireg (Shift_Right (W, 25));
+                  Add_String (", ");
+                  Disp_Const (16#3f_Ffff#);
+               when others =>
+                  Disp_Unknown;
+            end case;
+         when 2#01# =>
+            --  Call
+            Add_String ("call ");
+            Disp_Const (16#3fff_Ffff#);
+         when 2#10# =>
+            Disp_Format3 (Insn_Desc_10);
+         when 2#11# =>
+            Disp_Format3 (Insn_Desc_11);
+         when others =>
+            --  Misc.
+            Disp_Unknown;
+      end case;
+
+      Line_Len := Lo - Line'First;
+   end Disassemble_Insn;
+
+end Disa_Sparc;
diff --git a/src/ortho/mcode/disa_sparc.ads b/src/ortho/mcode/disa_sparc.ads
new file mode 100644
index 000000000..486dff977
--- /dev/null
+++ b/src/ortho/mcode/disa_sparc.ads
@@ -0,0 +1,15 @@
+with System;
+
+package Disa_Sparc is
+   --  Call-back used to find a relocation symbol.
+   type Symbol_Proc_Type is access procedure (Addr : System.Address;
+                                              Line : in out String;
+                                              Line_Len : in out Natural);
+
+   --  Disassemble instruction at ADDR, and put the result in LINE/LINE_LEN.
+   procedure Disassemble_Insn (Addr : System.Address;
+                               Line : in out String;
+                               Line_Len : out Natural;
+                               Insn_Len : out Natural;
+                               Proc_Cb : Symbol_Proc_Type);
+end Disa_Sparc;
diff --git a/src/ortho/mcode/disa_x86.adb b/src/ortho/mcode/disa_x86.adb
new file mode 100644
index 000000000..1d2d48565
--- /dev/null
+++ b/src/ortho/mcode/disa_x86.adb
@@ -0,0 +1,997 @@
+--  X86 disassembler.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System.Address_To_Access_Conversions;
+
+package body Disa_X86 is
+   type Byte is new Interfaces.Unsigned_8;
+   type Bf_2 is mod 2 ** 2;
+   type Bf_3 is mod 2 ** 3;
+   type Byte_Vector is array (Natural) of Byte;
+   package Bv_Addr2acc is new System.Address_To_Access_Conversions
+     (Object => Byte_Vector);
+   use Bv_Addr2acc;
+
+   type Cstring_Acc is access constant String;
+   type Index_Type is
+     (
+      N_None,
+      N_Push,
+      N_Pop,
+      N_Ret,
+      N_Mov,
+      N_Add,
+      N_Or,
+      N_Adc,
+      N_Sbb,
+      N_And,
+      N_Sub,
+      N_Xor,
+      N_Cmp,
+      N_Into,
+      N_Jmp,
+      N_Jcc,
+      N_Setcc,
+      N_Call,
+      N_Int,
+      N_Cdq,
+      N_Imul,
+      N_Mul,
+      N_Leave,
+      N_Test,
+      N_Lea,
+      N_O,
+      N_No,
+      N_B,
+      N_AE,
+      N_E,
+      N_Ne,
+      N_Be,
+      N_A,
+      N_S,
+      N_Ns,
+      N_P,
+      N_Np,
+      N_L,
+      N_Ge,
+      N_Le,
+      N_G,
+      N_Not,
+      N_Neg,
+      N_Cbw,
+      N_Div,
+      N_Idiv,
+      N_Movsx,
+      N_Movzx,
+      N_Nop,
+      N_Hlt,
+      N_Inc,
+      N_Dec,
+      N_Rol,
+      N_Ror,
+      N_Rcl,
+      N_Rcr,
+      N_Shl,
+      N_Shr,
+      N_Sar,
+      N_Fadd,
+      N_Fmul,
+      N_Fcom,
+      N_Fcomp,
+      N_Fsub,
+      N_Fsubr,
+      N_Fdiv,
+      N_Fdivr,
+
+      G_1,
+      G_2,
+      G_3,
+      G_5
+     );
+
+   type Names_Type is array (Index_Type range <>) of Cstring_Acc;
+   subtype S is String;
+   Names : constant Names_Type :=
+     (N_None => new S'("none"),
+      N_Push => new S'("push"),
+      N_Pop => new S'("pop"),
+      N_Ret => new S'("ret"),
+      N_Mov => new S'("mov"),
+      N_Add => new S'("add"),
+      N_Or => new S'("or"),
+      N_Adc => new S'("adc"),
+      N_Sbb => new S'("sbb"),
+      N_And => new S'("and"),
+      N_Sub => new S'("sub"),
+      N_Xor => new S'("xor"),
+      N_Cmp => new S'("cmp"),
+      N_Into => new S'("into"),
+      N_Jmp => new S'("jmp"),
+      N_Jcc => new S'("j"),
+      N_Int => new S'("int"),
+      N_Cdq => new S'("cdq"),
+      N_Call => new S'("call"),
+      N_Imul => new S'("imul"),
+      N_Mul => new S'("mul"),
+      N_Leave => new S'("leave"),
+      N_Test => new S'("test"),
+      N_Setcc => new S'("set"),
+      N_Lea => new S'("lea"),
+      N_O => new S'("o"),
+      N_No => new S'("no"),
+      N_B => new S'("b"),
+      N_AE => new S'("ae"),
+      N_E => new S'("e"),
+      N_Ne => new S'("ne"),
+      N_Be => new S'("be"),
+      N_A => new S'("a"),
+      N_S => new S'("s"),
+      N_Ns => new S'("ns"),
+      N_P => new S'("p"),
+      N_Np => new S'("np"),
+      N_L => new S'("l"),
+      N_Ge => new S'("ge"),
+      N_Le => new S'("le"),
+      N_G => new S'("g"),
+      N_Not => new S'("not"),
+      N_Neg => new S'("neg"),
+      N_Cbw => new S'("cbw"),
+      N_Div => new S'("div"),
+      N_Idiv => new S'("idiv"),
+      N_Movsx => new S'("movsx"),
+      N_Movzx => new S'("movzx"),
+      N_Nop => new S'("nop"),
+      N_Hlt => new S'("hlt"),
+      N_Inc => new S'("inc"),
+      N_Dec => new S'("dec"),
+      N_Rol => new S'("rol"),
+      N_Ror => new S'("ror"),
+      N_Rcl => new S'("rcl"),
+      N_Rcr => new S'("rcr"),
+      N_Shl => new S'("shl"),
+      N_Shr => new S'("shr"),
+      N_Sar => new S'("sar"),
+      N_Fadd => new S'("fadd"),
+      N_Fmul => new S'("fmul"),
+      N_Fcom => new S'("fcom"),
+      N_Fcomp => new S'("fcomp"),
+      N_Fsub => new S'("fsub"),
+      N_Fsubr => new S'("fsubr"),
+      N_Fdiv => new S'("fdiv"),
+      N_Fdivr => new S'("fdivr")
+     );
+
+
+
+   --  Format of an instruction.
+   --  MODRM_SRC_8 : modrm byte follow, and modrm is source, witdh = 8bits
+   --  MODRM_DST_8 : modrm byte follow, and modrm is dest, width = 8 bits.
+   --  MODRM_SRC_W : modrm byte follow, and modrm is source, width = 16/32 bits
+   --  MODRM_DST_W : modrm byte follow, and modrm is dest, width =16/32 bits.
+   --  MODRM_IMM_W : modrm byte follow, with an opcode in the reg field,
+   --                followed by an immediat, width = 16/32 bits.
+   --  MODRM_IMM_8 : modrm byte follow, with an opcode in the reg field,
+   --               followed by an immediat, width = 8 bits.
+   --  IMM : the opcode is followed by an immediate value.
+   --  PREFIX : the opcode is a prefix (1 byte).
+   --  OPCODE : inherent addressing.
+   --  OPCODE2 : a second byte specify the instruction.
+   --  REG_IMP : register is in the 3 LSB of the opcode.
+   --  REG_IMM_W : register is in the 3 LSB of the opcode, followed by an
+   --              immediat, width = 16/32 bits.
+   --  DISP_W : a wide displacement (16/32 bits).
+   --  DISP_8 : short displacement (8 bits).
+   --  INVALID : bad opcode.
+   type Format_Type is (Modrm_Src, Modrm_Dst,
+                        Modrm_Imm, Modrm_Imm_S,
+                        Modrm,
+                        Modrm_Ax,
+                        Modrm_Imm8,
+                        Imm, Imm_S, Imm_8,
+                        Eax_Imm,
+                        Prefix, Opcode, Opcode2, Reg_Imp,
+                        Reg_Imm,
+                        Imp,
+                        Disp_W, Disp_8,
+                        Cond_Disp_W, Cond_Disp_8,
+                        Cond_Modrm,
+                        Ax_Off_Src, Ax_Off_Dst,
+                        Invalid);
+
+   type Width_Type is (W_None, W_8, W_16, W_32, W_Data);
+
+   --  Description for one instruction.
+   type Insn_Desc_Type is record
+      --  Name of the operation.
+      Name : Index_Type;
+
+      --  Width of the instruction.
+      --  This is used to add a suffix (b,w,l) to the instruction.
+      --  This may also be the size of a data.
+      Width : Width_Type;
+
+      --  Format of the instruction.
+      Format : Format_Type;
+   end record;
+
+   Desc_Invalid : constant Insn_Desc_Type := (N_None, W_None, Invalid);
+
+   type Insn_Desc_Array_Type is array (Byte) of Insn_Desc_Type;
+   type Group_Desc_Array_Type is array (Bf_3) of Insn_Desc_Type;
+   Insn_Desc : constant Insn_Desc_Array_Type :=
+     (
+      2#00_000_000# => (N_Add, W_8, Modrm_Dst),
+      2#00_000_001# => (N_Add, W_Data, Modrm_Dst),
+      2#00_000_010# => (N_Add, W_8, Modrm_Src),
+      2#00_000_011# => (N_Add, W_Data, Modrm_Src),
+
+      2#00_001_000# => (N_Or, W_8, Modrm_Dst),
+      2#00_001_001# => (N_Or, W_Data, Modrm_Dst),
+      2#00_001_010# => (N_Or, W_8, Modrm_Src),
+      2#00_001_011# => (N_Or, W_Data, Modrm_Src),
+
+      2#00_011_000# => (N_Sbb, W_8, Modrm_Dst),
+      2#00_011_001# => (N_Sbb, W_Data, Modrm_Dst),
+      2#00_011_010# => (N_Sbb, W_8, Modrm_Src),
+      2#00_011_011# => (N_Sbb, W_Data, Modrm_Src),
+
+      2#00_100_000# => (N_And, W_8, Modrm_Dst),
+      2#00_100_001# => (N_And, W_Data, Modrm_Dst),
+      2#00_100_010# => (N_And, W_8, Modrm_Src),
+      2#00_100_011# => (N_And, W_Data, Modrm_Src),
+
+      2#00_101_000# => (N_Sub, W_8, Modrm_Dst),
+      2#00_101_001# => (N_Sub, W_Data, Modrm_Dst),
+      2#00_101_010# => (N_Sub, W_8, Modrm_Src),
+      2#00_101_011# => (N_Sub, W_Data, Modrm_Src),
+
+      2#00_110_000# => (N_Xor, W_8, Modrm_Dst),
+      2#00_110_001# => (N_Xor, W_Data, Modrm_Dst),
+      2#00_110_010# => (N_Xor, W_8, Modrm_Src),
+      2#00_110_011# => (N_Xor, W_Data, Modrm_Src),
+
+      2#00_111_000# => (N_Cmp, W_8, Modrm_Dst),
+      2#00_111_001# => (N_Cmp, W_Data, Modrm_Dst),
+      2#00_111_010# => (N_Cmp, W_8, Modrm_Src),
+      2#00_111_011# => (N_Cmp, W_Data, Modrm_Src),
+
+      2#00_111_100# => (N_Cmp, W_8, Eax_Imm),
+      2#00_111_101# => (N_Cmp, W_Data, Eax_Imm),
+
+      2#0101_0_000# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_001# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_010# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_011# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_100# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_101# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_110# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_111# => (N_Push, W_Data, Reg_Imp),
+
+      2#0101_1_000# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_001# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_010# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_011# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_100# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_101# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_110# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_111# => (N_Pop, W_Data, Reg_Imp),
+
+      2#0110_1000# => (N_Push, W_Data, Imm),
+      2#0110_1010# => (N_Push, W_Data, Imm_S),
+
+      2#0111_0000# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0001# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0010# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0011# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0100# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0101# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0110# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0111# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1000# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1001# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1010# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1011# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1100# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1101# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1110# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1111# => (N_Jcc, W_None, Cond_Disp_8),
+
+      2#1000_0000# => (G_1, W_8, Modrm_Imm),
+      2#1000_0001# => (G_1, W_Data, Modrm_Imm),
+      2#1000_0011# => (G_1, W_Data, Modrm_Imm_S),
+
+      2#1000_0101# => (N_Test, W_Data, Modrm_Src),
+      2#1000_1101# => (N_Lea, W_Data, Modrm_Src),
+
+      2#1000_1010# => (N_Mov, W_8, Modrm_Src),
+      2#1000_1011# => (N_Mov, W_Data, Modrm_Src),
+      2#1000_1000# => (N_Mov, W_8, Modrm_Dst),
+      2#1000_1001# => (N_Mov, W_Data, Modrm_Dst),
+
+      2#1001_0000# => (N_Nop, W_None, Opcode),
+      2#1001_1001# => (N_Cdq, W_Data, Imp),
+
+      2#1010_0000# => (N_Mov, W_8, Ax_Off_Src),
+      2#1010_0001# => (N_Mov, W_Data, Ax_Off_Src),
+      2#1010_0010# => (N_Mov, W_8, Ax_Off_Dst),
+      2#1010_0011# => (N_Mov, W_Data, Ax_Off_Dst),
+
+      2#1011_0000# => (N_Mov, W_8, Reg_Imm),
+
+      2#1011_1000# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1001# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1010# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1011# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1100# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1101# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1110# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1111# => (N_Mov, W_Data, Reg_Imm),
+
+      2#1100_0000# => (G_2, W_8, Modrm_Imm8),
+      2#1100_0001# => (G_2, W_Data, Modrm_Imm8),
+
+      2#1100_0011# => (N_Ret, W_None, Opcode),
+      2#1100_0110# => (N_Mov, W_8, Modrm_Imm),
+      2#1100_0111# => (N_Mov, W_Data, Modrm_Imm),
+      2#1100_1001# => (N_Leave, W_None, Opcode),
+      2#1100_1101# => (N_Int, W_None, Imm_8),
+      2#1100_1110# => (N_Into, W_None, Opcode),
+
+      2#1110_1000# => (N_Call, W_None, Disp_W),
+      2#1110_1001# => (N_Jmp, W_None, Disp_W),
+      2#1110_1011# => (N_Jmp, W_None, Disp_8),
+
+      2#1111_0100# => (N_Hlt, W_None, Opcode),
+
+      2#1111_0110# => (G_3, W_None, Invalid),
+      2#1111_0111# => (G_3, W_None, Invalid),
+
+      2#1111_1111# => (G_5, W_None, Invalid),
+      --2#1111_1111# => (N_Push, W_Data, Modrm),
+      others => (N_None, W_None, Invalid));
+
+   Insn_Desc_0F : constant Insn_Desc_Array_Type :=
+     (2#1000_0000# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0001# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0010# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0011# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0100# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0101# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0110# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0111# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1000# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1001# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1010# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1011# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1100# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1101# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1110# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1111# => (N_Jcc, W_None, Cond_Disp_W),
+
+      2#1001_0000# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0001# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0010# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0011# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0100# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0101# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0110# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0111# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1000# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1001# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1010# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1011# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1100# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1101# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1110# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1111# => (N_Setcc, W_8, Cond_Modrm),
+
+      2#1011_0110# => (N_Movzx, W_Data, Modrm_Dst),
+      2#1011_1110# => (N_Movsx, W_Data, Modrm_Dst),
+      others => (N_None, W_None, Invalid));
+
+   --  16#F7#
+   Insn_Desc_G3 : constant Group_Desc_Array_Type :=
+     (2#000# => (N_Test, W_Data, Reg_Imm),
+      2#010# => (N_Not, W_Data, Modrm_Dst),
+      2#011# => (N_Neg, W_Data, Modrm_Dst),
+      2#100# => (N_Mul, W_Data, Modrm_Ax),
+      2#101# => (N_Imul, W_Data, Modrm_Ax),
+      2#110# => (N_Div, W_Data, Modrm_Ax),
+      2#111# => (N_Idiv, W_Data, Modrm_Ax),
+      others => (N_None, W_None, Invalid));
+
+   Insn_Desc_G5 : constant Group_Desc_Array_Type :=
+     (2#000# => (N_Inc, W_Data, Modrm),
+      2#001# => (N_Dec, W_Data, Modrm),
+      2#010# => (N_Call, W_Data, Modrm),
+      --2#011# => (N_Call, W_Data, Modrm_Ax),
+      2#100# => (N_Jmp, W_Data, Modrm),
+      --2#101# => (N_Jmp, W_Data, Modrm_Ax),
+      2#110# => (N_Push, W_Data, Modrm_Ax),
+      others => (N_None, W_None, Invalid));
+
+   type Group_Name_Array_Type is array (Index_Type range G_1 .. G_2, Bf_3)
+     of Index_Type;
+   Group_Name : constant Group_Name_Array_Type :=
+     (
+      G_1 => (N_Add, N_Or, N_Adc, N_Sbb, N_And, N_Sub, N_Xor, N_Cmp),
+      G_2 => (N_Rol, N_Ror, N_Rcl, N_Rcr, N_Shl, N_Shr, N_None, N_Sar)
+     );
+
+   --  Standard widths of operations.
+   type Width_Array_Type is array (Width_Type) of Character;
+   Width_Char : constant Width_Array_Type :=
+     (W_None => '-', W_8 => 'b', W_16 => 'w', W_32 => 'l', W_Data => '?');
+   type Width_Len_Type is array (Width_Type) of Natural;
+   Width_Len : constant Width_Len_Type :=
+     (W_None => 0, W_8 => 1, W_16 => 2, W_32 => 4, W_Data => 0);
+
+   --  Registers.
+--    type Reg_Type is (Reg_Ax, Reg_Bx, Reg_Cx, Reg_Dx,
+--                      Reg_Bp, Reg_Sp, Reg_Si, Reg_Di,
+--                      Reg_Al, Reg_Ah, Reg_Bl, Reg_Bh,
+--                      Reg_Cl, Reg_Ch, Reg_Dl, Reg_Dh);
+
+   --  Bits extraction from byte functions.
+   --  For a byte, MSB (most significant bit) is bit 7 while
+   --  LSB (least significant bit) is bit 0.
+
+   --  Extract bits 2, 1 and 0.
+   function Ext_210 (B : Byte) return Bf_3;
+   pragma Inline (Ext_210);
+
+   --  Extract bits 5-3 of byte B.
+   function Ext_543 (B : Byte) return Bf_3;
+   pragma Inline (Ext_543);
+
+   --  Extract bits 7-6 of byte B.
+   function Ext_76 (B : Byte) return Bf_2;
+   pragma Inline (Ext_76);
+
+   function Ext_210 (B : Byte) return Bf_3 is
+   begin
+      return Bf_3 (B and 2#111#);
+   end Ext_210;
+
+   function Ext_543 (B : Byte) return Bf_3 is
+   begin
+      return Bf_3 (Shift_Right (B, 3) and 2#111#);
+   end Ext_543;
+
+   function Ext_76 (B : Byte) return Bf_2 is
+   begin
+      return Bf_2 (Shift_Right (B, 6) and 2#11#);
+   end Ext_76;
+
+   function Ext_Modrm_Mod (B : Byte) return Bf_2 renames Ext_76;
+   function Ext_Modrm_Rm (B : Byte) return Bf_3 renames Ext_210;
+   function Ext_Modrm_Reg (B : Byte) return Bf_3 renames Ext_543;
+   function Ext_Sib_Base (B : Byte) return Bf_3 renames Ext_210;
+   function Ext_Sib_Index (B : Byte) return Bf_3 renames Ext_543;
+   function Ext_Sib_Scale (B : Byte) return Bf_2 renames Ext_76;
+
+   procedure Disassemble_Insn (Addr : System.Address;
+                               Pc : Unsigned_32;
+                               Line : in out String;
+                               Line_Len : out Natural;
+                               Insn_Len : out Natural;
+                               Proc_Cb : Symbol_Proc_Type)
+   is
+      --  Index in LINE of the next character to be written.
+      Lo : Natural;
+
+      --  Default width.
+      W_Default : constant Width_Type := W_32;
+
+      --  The instruction memory, 0 based.
+      Mem : Bv_Addr2acc.Object_Pointer;
+
+      --  Add NAME to the line.
+      procedure Add_Name (Name : Index_Type);
+      pragma Inline (Add_Name);
+
+      --  Add CHAR to the line.
+      procedure Add_Char (C : Character);
+      pragma Inline (Add_Char);
+
+      --  Add STR to the line.
+      procedure Add_String (Str : String) is
+      begin
+         Line (Lo .. Lo + Str'Length - 1) := Str;
+         Lo := Lo + Str'Length;
+      end Add_String;
+
+      --  Add BYTE to the line.
+      procedure Add_Byte (V : Byte) is
+         type My_Str is array (Natural range 0 .. 15) of Character;
+         Hex_Digit : constant My_Str := "0123456789abcdef";
+      begin
+         Add_Char (Hex_Digit (Natural (Shift_Right (V, 4) and 16#0f#)));
+         Add_Char (Hex_Digit (Natural (Shift_Right (V, 0) and 16#0f#)));
+      end Add_Byte;
+
+      procedure Add_Name (Name : Index_Type) is
+      begin
+         Add_String (Names (Name).all);
+      end Add_Name;
+
+      procedure Add_Char (C : Character) is
+      begin
+         Line (Lo) := C;
+         Lo := Lo + 1;
+      end Add_Char;
+
+      procedure Add_Comma is
+      begin
+         Add_String (", ");
+      end Add_Comma;
+
+      procedure Name_Align (Orig : Natural) is
+      begin
+         Add_Char (' ');
+         while Lo - Orig < 8 loop
+            Add_Char (' ');
+         end loop;
+      end Name_Align;
+
+      procedure Add_Opcode (Name : Index_Type; Width : Width_Type)
+      is
+         L : constant Natural := Lo;
+      begin
+         Add_Name (Name);
+         if False and Width /= W_None then
+            Add_Char (Width_Char (Width));
+         end if;
+         Name_Align (L);
+      end Add_Opcode;
+
+      procedure Add_Cond_Opcode (Name : Index_Type; B : Byte)
+      is
+         L : constant Natural := Lo;
+      begin
+         Add_Name (Name);
+         Add_Name (Index_Type'Val (Index_Type'Pos (N_O)
+                                     + Byte'Pos (B and 16#0f#)));
+         Name_Align (L);
+      end Add_Cond_Opcode;
+
+      procedure Decode_Reg_Field (F : Bf_3; W : Width_Type) is
+         type Reg_Name2_Array is array (Bf_3) of String (1 .. 2);
+         type Reg_Name3_Array is array (Bf_3) of String (1 .. 3);
+         Regs_8 : constant Reg_Name2_Array :=
+           ("al", "cl", "dl", "bl", "ah", "ch", "dh", "bh");
+         Regs_16 : constant Reg_Name2_Array :=
+           ("ax", "cx", "dx", "bx", "sp", "bp", "si", "di");
+         Regs_32 : constant Reg_Name3_Array :=
+           ("eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi");
+      begin
+         Add_Char ('%');
+         case W is
+            when W_8 =>
+               Add_String (Regs_8 (F));
+            when W_16 =>
+               Add_String (Regs_16 (F));
+            when W_32 =>
+               Add_String (Regs_32 (F));
+            when W_None
+              | W_Data =>
+               raise Program_Error;
+         end case;
+      end Decode_Reg_Field;
+
+      procedure Decode_Val (Off : Natural; Width : Width_Type)
+      is
+      begin
+         case Width is
+            when W_8 =>
+               Add_Byte (Mem (Off));
+            when W_16 =>
+               Add_Byte (Mem (Off + 1));
+               Add_Byte (Mem (Off));
+            when W_32 =>
+               Add_Byte (Mem (Off + 3));
+               Add_Byte (Mem (Off + 2));
+               Add_Byte (Mem (Off + 1));
+               Add_Byte (Mem (Off + 0));
+            when W_None
+              | W_Data =>
+               raise Program_Error;
+         end case;
+      end Decode_Val;
+
+      function Decode_Val (Off : Natural; Width : Width_Type)
+                          return Unsigned_32
+      is
+         V : Unsigned_32;
+      begin
+         case Width is
+            when W_8 =>
+               V := Unsigned_32 (Mem (Off));
+               --  Sign extension.
+               if V >= 16#80# then
+                  V := 16#Ffff_Ff00# or V;
+               end if;
+               return V;
+            when W_16 =>
+               return Shift_Left (Unsigned_32 (Mem (Off + 1)), 8)
+                 or Unsigned_32 (Mem (Off));
+            when W_32 =>
+               return  Shift_Left (Unsigned_32 (Mem (Off + 3)), 24)
+                 or Shift_Left (Unsigned_32 (Mem (Off + 2)), 16)
+                 or Shift_Left (Unsigned_32 (Mem (Off + 1)), 8)
+                 or Shift_Left (Unsigned_32 (Mem (Off + 0)), 0);
+            when W_None
+              | W_Data =>
+               raise Program_Error;
+         end case;
+      end Decode_Val;
+
+      procedure Decode_Imm (Off : in out Natural; Width : Width_Type)
+      is
+      begin
+         Add_String ("$0x");
+         Decode_Val (Off, Width);
+         Off := Off + Width_Len (Width);
+      end Decode_Imm;
+
+      procedure Decode_Disp (Off : in out Natural;
+                             Width : Width_Type;
+                             Offset : Unsigned_32 := 0)
+      is
+         L : Natural;
+         V : Unsigned_32;
+         Off_Orig : constant Natural := Off;
+      begin
+         L := Lo;
+         V := Decode_Val (Off, Width) + Offset;
+         Off := Off + Width_Len (Width);
+         if Proc_Cb /= null then
+            Proc_Cb.all (Mem (Off)'Address,
+                         Line (Lo .. Line'Last), Lo);
+         end if;
+         if L /= Lo then
+            if V = 0 then
+               return;
+            end if;
+            Add_String (" + ");
+         end if;
+         Add_String ("0x");
+         if Offset = 0 then
+            Decode_Val (Off_Orig, Width);
+         else
+            Add_Byte (Byte (Shift_Right (V, 24) and 16#Ff#));
+            Add_Byte (Byte (Shift_Right (V, 16) and 16#Ff#));
+            Add_Byte (Byte (Shift_Right (V, 8) and 16#Ff#));
+            Add_Byte (Byte (Shift_Right (V, 0) and 16#Ff#));
+         end if;
+      end Decode_Disp;
+
+      procedure Decode_Modrm_Reg (B : Byte; Width : Width_Type) is
+      begin
+         Decode_Reg_Field (Ext_Modrm_Reg (B), Width);
+      end Decode_Modrm_Reg;
+
+      procedure Decode_Sib (Sib : Byte; B_Mod : Bf_2)
+      is
+         S : Bf_2;
+         I : Bf_3;
+         B : Bf_3;
+      begin
+         S := Ext_Sib_Scale (Sib);
+         B := Ext_Sib_Base (Sib);
+         I := Ext_Sib_Index (Sib);
+         Add_Char ('(');
+         if B = 2#101# and then B_Mod /= 0 then
+            Decode_Reg_Field (B, W_32);
+            Add_Char (',');
+         end if;
+         if I /= 2#100# then
+            Decode_Reg_Field (I, W_32);
+            case S is
+               when 2#00# =>
+                  null;
+               when 2#01# =>
+                  Add_String (",2");
+               when 2#10# =>
+                  Add_String (",4");
+               when 2#11# =>
+                  Add_String (",8");
+            end case;
+         end if;
+         Add_Char (')');
+      end Decode_Sib;
+
+      procedure Decode_Modrm_Mem (Off : in out Natural; Width : Width_Type)
+      is
+         B : Byte;
+         B_Mod : Bf_2;
+         B_Rm : Bf_3;
+         Off_Orig : Natural;
+      begin
+         B := Mem (Off);
+         B_Mod := Ext_Modrm_Mod (B);
+         B_Rm := Ext_Modrm_Rm (B);
+         Off_Orig := Off;
+         case B_Mod is
+            when 2#11# =>
+               Decode_Reg_Field (B_Rm, Width);
+               Off := Off + 1;
+            when 2#10# =>
+               if B_Rm = 2#100# then
+                  Off := Off + 2;
+                  Decode_Disp (Off, W_32);
+                  Decode_Sib (Mem (Off_Orig + 1), B_Mod);
+               else
+                  Off := Off + 1;
+                  Decode_Disp (Off, W_32);
+                  Add_Char ('(');
+                  Decode_Reg_Field (B_Rm, W_32);
+                  Add_Char (')');
+               end if;
+            when 2#01# =>
+               if B_Rm = 2#100# then
+                  Off := Off + 2;
+                  Decode_Disp (Off, W_8);
+                  Decode_Sib (Mem (Off_Orig + 1), B_Mod);
+               else
+                  Off := Off + 1;
+                  Decode_Disp (Off, W_8);
+                  Add_Char ('(');
+                  Decode_Reg_Field (B_Rm, W_32);
+                  Add_Char (')');
+               end if;
+            when 2#00# =>
+               if B_Rm = 2#100# then
+                  Off := Off + 2;
+                  Decode_Sib (Mem (Off_Orig + 1), B_Mod);
+               elsif B_Rm = 2#101# then
+                  Off := Off + 1;
+                  Decode_Disp (Off, W_32);
+               else
+                  Add_Char ('(');
+                  Decode_Reg_Field (B_Rm, W_32);
+                  Add_Char (')');
+                  Off := Off + 1;
+               end if;
+         end case;
+      end Decode_Modrm_Mem;
+
+      --  Return the length of the modrm bytes.
+      --  At least 1 (mod/rm), at most 6 (mod/rm + SUB + disp32).
+      function Decode_Modrm_Len (Off : Natural) return Natural
+      is
+         B : Byte;
+         M_Mod : Bf_2;
+         M_Rm : Bf_3;
+      begin
+         B := Mem (Off);
+         M_Mod := Ext_Modrm_Mod (B);
+         M_Rm := Ext_Modrm_Rm (B);
+         case M_Mod is
+            when 2#11# =>
+               return 1;
+            when 2#10# =>
+               if M_Rm = 2#100# then
+                  return 1 + 1 + 4;
+               else
+                  return 1 + 4;
+               end if;
+            when 2#01# =>
+               if M_Rm = 2#100# then
+                  return 1 + 1 + 1;
+               else
+                  return 1 + 1;
+               end if;
+            when 2#00# =>
+               if M_Rm = 2#101# then
+                  --  disp32.
+                  return 1 + 4;
+               elsif M_Rm = 2#100# then
+                  --  SIB
+                  return 1 + 1;
+               else
+                  return 1;
+               end if;
+         end case;
+      end Decode_Modrm_Len;
+
+
+      Off : Natural;
+      B : Byte;
+      B1 : Byte;
+      Desc : Insn_Desc_Type;
+      Name : Index_Type;
+      W : Width_Type;
+   begin
+      Mem := To_Pointer (Addr);
+      Off := 0;
+      Lo := Line'First;
+
+      B := Mem (0);
+      if B = 2#0000_1111# then
+         B := Mem (1);
+         Off := 2;
+         Insn_Len := 2;
+         Desc := Insn_Desc_0F (B);
+      else
+         Off := 1;
+         Insn_Len := 1;
+         Desc := Insn_Desc (B);
+      end if;
+
+      if Desc.Name >= G_1 then
+         B1 := Mem (Off);
+         case Desc.Name is
+            when G_1
+              | G_2 =>
+               Name := Group_Name (Desc.Name, Ext_543 (B1));
+            when G_3 =>
+               Desc := Insn_Desc_G3 (Ext_543 (B1));
+               Name := Desc.Name;
+            when G_5 =>
+               Desc := Insn_Desc_G5 (Ext_543 (B1));
+               Name := Desc.Name;
+            when others =>
+               Desc := Desc_Invalid;
+         end case;
+      else
+         Name := Desc.Name;
+      end if;
+
+      case Desc.Width is
+         when W_Data =>
+            W := W_Default;
+         when W_8
+           | W_16
+           | W_32 =>
+            W := Desc.Width;
+         when W_None =>
+            case Desc.Format is
+               when Disp_8
+                 | Cond_Disp_8
+                 | Imm_8 =>
+                  W := W_8;
+               when Disp_W
+                 | Cond_Disp_W =>
+                  W := W_Default;
+               when Invalid
+                 | Opcode =>
+                  W := W_None;
+               when others =>
+                  raise Program_Error;
+            end case;
+      end case;
+
+      case Desc.Format is
+         when Reg_Imp =>
+            Add_Opcode (Desc.Name, W_Default);
+            Decode_Reg_Field (Ext_210 (B), W_Default);
+         when Opcode =>
+            Add_Opcode (Desc.Name, W_None);
+         when Modrm =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Modrm_Mem (Insn_Len, W);
+         when Modrm_Src =>
+            Add_Opcode (Desc.Name, W);
+            --  Disp source first.
+            Decode_Modrm_Mem (Insn_Len, W);
+            Add_Comma;
+            B := Mem (Off);
+            Decode_Modrm_Reg (Mem (Off), W);
+         when Modrm_Dst =>
+            Add_Opcode (Desc.Name, W);
+            --  Disp source first.
+            B := Mem (Off);
+            Decode_Modrm_Reg (B, W);
+            Add_Comma;
+            Decode_Modrm_Mem (Insn_Len, W);
+         when Modrm_Imm =>
+            Add_Opcode (Name, W);
+            Insn_Len := Off + Decode_Modrm_Len (Off);
+            Decode_Imm (Insn_Len, W);
+            Add_Comma;
+            Decode_Modrm_Mem (Off, W);
+         when Modrm_Imm_S =>
+            Add_Opcode (Name, W);
+            Insn_Len := Off + Decode_Modrm_Len (Off);
+            Decode_Imm (Insn_Len, W_8);
+            Add_Comma;
+            Decode_Modrm_Mem (Off, W);
+         when Modrm_Imm8 =>
+            Add_Opcode (Name, W);
+            Decode_Modrm_Mem (Off, W);
+            Add_Comma;
+            Decode_Imm (Off, W_8);
+
+         when Reg_Imm =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Imm (Insn_Len, W);
+            Add_Comma;
+            Decode_Reg_Field (Ext_210 (B), W);
+         when Eax_Imm =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Imm (Insn_Len, W);
+            Add_Comma;
+            Decode_Reg_Field (2#000#, W);
+
+         when Disp_W
+           | Disp_8 =>
+            Add_Opcode (Desc.Name, W_None);
+            Decode_Disp (Insn_Len, W,
+                         Pc + Unsigned_32 (Insn_Len + Width_Len (W)));
+
+         when Cond_Disp_8
+           | Cond_Disp_W =>
+            Add_Cond_Opcode (Desc.Name, B);
+            Decode_Disp (Insn_Len, W,
+                         Pc + Unsigned_32 (Insn_Len + Width_Len (W)));
+
+         when Cond_Modrm =>
+            Add_Cond_Opcode (Desc.Name, B);
+            Decode_Modrm_Mem (Insn_Len, W);
+
+         when Imm =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Imm (Insn_Len, W);
+
+         when Imm_S
+           | Imm_8 =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Imm (Insn_Len, W_8);
+
+         when Modrm_Ax =>
+            if (B and 2#1#) = 2#0# then
+               W := W_8;
+            else
+               W := W_Default;
+            end if;
+            Add_Opcode (Desc.Name, W);
+            Decode_Reg_Field (0, W);
+            Add_Comma;
+            Decode_Modrm_Mem (Off, W);
+
+         when Ax_Off_Src =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Disp (Insn_Len, W);
+            Add_Comma;
+            Decode_Reg_Field (0, W);
+
+         when Ax_Off_Dst =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Reg_Field (0, W);
+            Add_Comma;
+            Decode_Disp (Insn_Len, W);
+
+         when Imp =>
+            Add_Opcode (Desc.Name, W_Default);
+
+         when Invalid
+           | Prefix
+           | Opcode2 =>
+            Add_String ("invalid ");
+            if Insn_Len = 2 then
+               Add_Byte (Mem (0));
+            end if;
+            Add_Byte (B);
+            Insn_Len := 1;
+      end case;
+
+      Line_Len := Lo - Line'First;
+   end Disassemble_Insn;
+end Disa_X86;
+
+
diff --git a/src/ortho/mcode/disa_x86.ads b/src/ortho/mcode/disa_x86.ads
new file mode 100644
index 000000000..c215cf0a3
--- /dev/null
+++ b/src/ortho/mcode/disa_x86.ads
@@ -0,0 +1,34 @@
+--  X86 disassembler.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Interfaces; use Interfaces;
+
+package Disa_X86 is
+   --  Call-back used to find a relocation symbol.
+   type Symbol_Proc_Type is access procedure (Addr : System.Address;
+                                              Line : in out String;
+                                              Line_Len : in out Natural);
+
+   --  Disassemble instruction at ADDR, and put the result in LINE/LINE_LEN.
+   procedure Disassemble_Insn (Addr : System.Address;
+                               Pc : Unsigned_32;
+                               Line : in out String;
+                               Line_Len : out Natural;
+                               Insn_Len : out Natural;
+                               Proc_Cb : Symbol_Proc_Type);
+end Disa_X86;
diff --git a/src/ortho/mcode/disassemble.ads b/src/ortho/mcode/disassemble.ads
new file mode 100644
index 000000000..5c9811fed
--- /dev/null
+++ b/src/ortho/mcode/disassemble.ads
@@ -0,0 +1,3 @@
+with Disa_X86;
+
+package Disassemble renames Disa_X86;
diff --git a/src/ortho/mcode/dwarf.ads b/src/ortho/mcode/dwarf.ads
new file mode 100644
index 000000000..40ee94f10
--- /dev/null
+++ b/src/ortho/mcode/dwarf.ads
@@ -0,0 +1,446 @@
+--  DWARF definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+
+package Dwarf is
+   DW_TAG_Array_Type               : constant := 16#01#;
+   DW_TAG_Class_Type               : constant := 16#02#;
+   DW_TAG_Entry_Point              : constant := 16#03#;
+   DW_TAG_Enumeration_Type         : constant := 16#04#;
+   DW_TAG_Formal_Parameter         : constant := 16#05#;
+   DW_TAG_Imported_Declaration     : constant := 16#08#;
+   DW_TAG_Label                    : constant := 16#0a#;
+   DW_TAG_Lexical_Block            : constant := 16#0b#;
+   DW_TAG_Member                   : constant := 16#0d#;
+   DW_TAG_Pointer_Type             : constant := 16#0f#;
+   DW_TAG_Reference_Type           : constant := 16#10#;
+   DW_TAG_Compile_Unit             : constant := 16#11#;
+   DW_TAG_String_Type              : constant := 16#12#;
+   DW_TAG_Structure_Type           : constant := 16#13#;
+   DW_TAG_Subroutine_Type          : constant := 16#15#;
+   DW_TAG_Typedef                  : constant := 16#16#;
+   DW_TAG_Union_Type               : constant := 16#17#;
+   DW_TAG_Unspecified_Parameters   : constant := 16#18#;
+   DW_TAG_Variant                  : constant := 16#19#;
+   DW_TAG_Common_Block             : constant := 16#1a#;
+   DW_TAG_Common_Inclusion         : constant := 16#1b#;
+   DW_TAG_Inheritance              : constant := 16#1c#;
+   DW_TAG_Inlined_Subroutine       : constant := 16#1d#;
+   DW_TAG_Module                   : constant := 16#1e#;
+   DW_TAG_Ptr_To_Member_Type       : constant := 16#1f#;
+   DW_TAG_Set_Type                 : constant := 16#20#;
+   DW_TAG_Subrange_Type            : constant := 16#21#;
+   DW_TAG_With_Stmt                : constant := 16#22#;
+   DW_TAG_Access_Declaration       : constant := 16#23#;
+   DW_TAG_Base_Type                : constant := 16#24#;
+   DW_TAG_Catch_Block              : constant := 16#25#;
+   DW_TAG_Const_Type               : constant := 16#26#;
+   DW_TAG_Constant                 : constant := 16#27#;
+   DW_TAG_Enumerator               : constant := 16#28#;
+   DW_TAG_File_Type                : constant := 16#29#;
+   DW_TAG_Friend                   : constant := 16#2a#;
+   DW_TAG_Namelist                 : constant := 16#2b#;
+   DW_TAG_Namelist_Item            : constant := 16#2c#;
+   DW_TAG_Packed_Type              : constant := 16#2d#;
+   DW_TAG_Subprogram               : constant := 16#2e#;
+   DW_TAG_Template_Type_Parameter  : constant := 16#2f#;
+   DW_TAG_Template_Value_Parameter : constant := 16#30#;
+   DW_TAG_Thrown_Type              : constant := 16#31#;
+   DW_TAG_Try_Block                : constant := 16#32#;
+   DW_TAG_Variant_Part             : constant := 16#33#;
+   DW_TAG_Variable                 : constant := 16#34#;
+   DW_TAG_Volatile_Type            : constant := 16#35#;
+   DW_TAG_Dwarf_Procedure          : constant := 16#36#;
+   DW_TAG_Restrict_Type            : constant := 16#37#;
+   DW_TAG_Interface_Type           : constant := 16#38#;
+   DW_TAG_Namespace                : constant := 16#39#;
+   DW_TAG_Imported_Module          : constant := 16#3a#;
+   DW_TAG_Unspecified_Type         : constant := 16#3b#;
+   DW_TAG_Partial_Unit             : constant := 16#3c#;
+   DW_TAG_Imported_Unit            : constant := 16#3d#;
+   DW_TAG_Mutable_Type             : constant := 16#3e#;
+   DW_TAG_Lo_User                  : constant := 16#4080#;
+   DW_TAG_Hi_User                  : constant := 16#Ffff#;
+
+   DW_CHILDREN_No      : constant := 16#0#;
+   DW_CHILDREN_Yes     : constant := 16#1#;
+
+   DW_AT_Sibling              : constant := 16#01#; -- reference
+   DW_AT_Location             : constant := 16#02#; -- block, loclistptr
+   DW_AT_Name                 : constant := 16#03#; -- string
+   DW_AT_Ordering             : constant := 16#09#; -- constant
+   DW_AT_Byte_Size            : constant := 16#0b#; -- block, constant, ref
+   DW_AT_Bit_Offset           : constant := 16#0c#; -- block, constant, ref
+   DW_AT_Bit_Size             : constant := 16#0d#; -- block, constant, ref
+   DW_AT_Stmt_List            : constant := 16#10#; -- lineptr
+   DW_AT_Low_Pc               : constant := 16#11#; -- address
+   DW_AT_High_Pc              : constant := 16#12#; -- address
+   DW_AT_Language             : constant := 16#13#; -- constant
+   DW_AT_Discr                : constant := 16#15#; -- reference
+   DW_AT_Discr_Value          : constant := 16#16#; -- constant
+   DW_AT_Visibility           : constant := 16#17#; -- constant
+   DW_AT_Import               : constant := 16#18#; -- reference
+   DW_AT_String_Length        : constant := 16#19#; -- block, loclistptr
+   DW_AT_Common_Reference     : constant := 16#1a#; -- reference
+   DW_AT_Comp_Dir             : constant := 16#1b#; -- string
+   DW_AT_Const_Value          : constant := 16#1c#; -- block, constant, string
+   DW_AT_Containing_Type      : constant := 16#1d#; -- reference
+   DW_AT_Default_Value        : constant := 16#1e#; -- reference
+   DW_AT_Inline               : constant := 16#20#; -- constant
+   DW_AT_Is_Optional          : constant := 16#21#; -- flag
+   DW_AT_Lower_Bound          : constant := 16#22#; -- block, constant, ref
+   DW_AT_Producer             : constant := 16#25#; -- string
+   DW_AT_Prototyped           : constant := 16#27#; -- flag
+   DW_AT_Return_Addr          : constant := 16#2a#; -- block, loclistptr
+   DW_AT_Start_Scope          : constant := 16#2c#; -- constant
+   DW_AT_Stride_Size          : constant := 16#2e#; -- constant
+   DW_AT_Upper_Bound          : constant := 16#2f#; -- block, constant, ref
+   DW_AT_Abstract_Origin      : constant := 16#31#; -- reference
+   DW_AT_Accessibility        : constant := 16#32#; -- constant
+   DW_AT_Address_Class        : constant := 16#33#; -- constant
+   DW_AT_Artificial           : constant := 16#34#; -- flag
+   DW_AT_Base_Types           : constant := 16#35#; -- reference
+   DW_AT_Calling_Convention   : constant := 16#36#; -- constant
+   DW_AT_Count                : constant := 16#37#; -- block, constant, ref
+   DW_AT_Data_Member_Location : constant := 16#38#; -- block, const, loclistptr
+   DW_AT_Decl_Column          : constant := 16#39#; -- constant
+   DW_AT_Decl_File            : constant := 16#3a#; -- constant
+   DW_AT_Decl_Line            : constant := 16#3b#; -- constant
+   DW_AT_Declaration          : constant := 16#3c#; -- flag
+   DW_AT_Discr_List           : constant := 16#3d#; -- block
+   DW_AT_Encoding             : constant := 16#3e#; -- constant
+   DW_AT_External             : constant := 16#3f#; -- flag
+   DW_AT_Frame_Base           : constant := 16#40#; -- block, loclistptr
+   DW_AT_Friend               : constant := 16#41#; -- reference
+   DW_AT_Identifier_Case      : constant := 16#42#; -- constant
+   DW_AT_Macro_Info           : constant := 16#43#; -- macptr
+   DW_AT_Namelist_Item        : constant := 16#44#; -- block
+   DW_AT_Priority             : constant := 16#45#; -- reference
+   DW_AT_Segment              : constant := 16#46#; -- block, constant
+   DW_AT_Specification        : constant := 16#47#; -- reference
+   DW_AT_Static_Link          : constant := 16#48#; -- block, loclistptr
+   DW_AT_Type                 : constant := 16#49#; -- reference
+   DW_AT_Use_Location         : constant := 16#4a#; -- block, loclistptr
+   DW_AT_Variable_Parameter   : constant := 16#4b#; -- flag
+   DW_AT_Virtuality           : constant := 16#4c#; -- constant
+   DW_AT_Vtable_Elem_Location : constant := 16#4d#; -- block, loclistptr
+   DW_AT_Allocated            : constant := 16#4e#; -- block, constant, ref
+   DW_AT_Associated           : constant := 16#4f#; -- block, constant, ref
+   DW_AT_Data_Location        : constant := 16#50#; -- x50block
+   DW_AT_Stride               : constant := 16#51#; -- block, constant, ref
+   DW_AT_Entry_Pc             : constant := 16#52#; -- address
+   DW_AT_Use_UTF8             : constant := 16#53#; -- flag
+   DW_AT_Extension            : constant := 16#04#; -- reference
+   DW_AT_Ranges               : constant := 16#55#; -- rangelistptr
+   DW_AT_Trampoline           : constant := 16#56#; -- address, flag, ref, str
+   DW_AT_Call_Column          : constant := 16#57#; -- constant
+   DW_AT_Call_File            : constant := 16#58#; -- constant
+   DW_AT_Call_Line            : constant := 16#59#; -- constant
+   DW_AT_Description          : constant := 16#5a#; -- string
+   DW_AT_Lo_User              : constant := 16#2000#; -- ---
+   DW_AT_Hi_User              : constant := 16#3fff#; -- ---
+
+   DW_FORM_Addr      : constant := 16#01#; -- address
+   DW_FORM_Block2    : constant := 16#03#; -- block
+   DW_FORM_Block4    : constant := 16#04#; -- block
+   DW_FORM_Data2     : constant := 16#05#; -- constant
+   DW_FORM_Data4     : constant := 16#06#; -- constant, lineptr, loclistptr...
+   DW_FORM_Data8     : constant := 16#07#; -- ...  macptr, rangelistptr
+   DW_FORM_String    : constant := 16#08#; -- string
+   DW_FORM_Block     : constant := 16#09#; -- block
+   DW_FORM_Block1    : constant := 16#0a#; -- block
+   DW_FORM_Data1     : constant := 16#0b#; -- constant
+   DW_FORM_Flag      : constant := 16#0c#; -- flag
+   DW_FORM_Sdata     : constant := 16#0d#; -- constant
+   DW_FORM_Strp      : constant := 16#0e#; -- string
+   DW_FORM_Udata     : constant := 16#0f#; -- constant
+   DW_FORM_Ref_Addr  : constant := 16#10#; -- reference
+   DW_FORM_Ref1      : constant := 16#11#; -- reference
+   DW_FORM_Ref2      : constant := 16#12#; -- reference
+   DW_FORM_Ref4      : constant := 16#13#; -- reference
+   DW_FORM_Ref8      : constant := 16#14#; -- reference
+   DW_FORM_Ref_Udata : constant := 16#15#; -- reference
+   DW_FORM_Indirect  : constant := 16#16#; -- (see Section 7.5.3)
+
+
+   DW_OP_Addr        : constant := 16#03#; -- 1 constant address (target spec)
+   DW_OP_Deref       : constant := 16#06#; -- 0
+   DW_OP_Const1u     : constant := 16#08#; -- 1 1-byte constant
+   DW_OP_Const1s     : constant := 16#09#; -- 1 1-byte constant
+   DW_OP_Const2u     : constant := 16#0a#; -- 1 2-byte constant
+   DW_OP_Const2s     : constant := 16#0b#; -- 1 2-byte constant
+   DW_OP_Const4u     : constant := 16#0c#; -- 1 4-byte constant
+   DW_OP_Const4s     : constant := 16#0d#; -- 1 4-byte constant
+   DW_OP_Const8u     : constant := 16#0e#; -- 1 8-byte constant
+   DW_OP_Const8s     : constant := 16#0f#; -- 1 8-byte constant
+   DW_OP_Constu      : constant := 16#10#; -- 1 ULEB128 constant
+   DW_OP_Consts      : constant := 16#11#; -- 1 SLEB128 constant
+   DW_OP_Dup         : constant := 16#12#; -- 0
+   DW_OP_Drop        : constant := 16#13#; -- 0
+   DW_OP_Over        : constant := 16#14#; -- 0
+   DW_OP_Pick        : constant := 16#15#; -- 1 1-byte stack index
+   DW_OP_Swap        : constant := 16#16#; -- 0
+   DW_OP_Rot         : constant := 16#17#; -- 0
+   DW_OP_Xderef      : constant := 16#18#; -- 0
+   DW_OP_Abs         : constant := 16#19#; -- 0
+   DW_OP_And         : constant := 16#1a#; -- 0
+   DW_OP_Div         : constant := 16#1b#; -- 0
+   DW_OP_Minus       : constant := 16#1c#; -- 0
+   DW_OP_Mod         : constant := 16#1d#; -- 0
+   DW_OP_Mul         : constant := 16#1e#; -- 0
+   DW_OP_Neg         : constant := 16#1f#; -- 0
+   DW_OP_Not         : constant := 16#20#; -- 0
+   DW_OP_Or          : constant := 16#21#; -- 0
+   DW_OP_Plus        : constant := 16#22#; -- 0
+   DW_OP_Plus_Uconst : constant := 16#23#; -- 1 ULEB128 addend
+   DW_OP_Shl         : constant := 16#24#; -- 0
+   DW_OP_Shr         : constant := 16#25#; -- 0
+   DW_OP_Shra        : constant := 16#26#; -- 0
+   DW_OP_Xor         : constant := 16#27#; -- 0
+   DW_OP_Skip        : constant := 16#2f#; -- 1 signed 2-byte constant
+   DW_OP_Bra         : constant := 16#28#; -- 1 signed 2-byte constant
+   DW_OP_Eq          : constant := 16#29#; -- 0
+   DW_OP_Ge          : constant := 16#2a#; -- 0
+   DW_OP_Gt          : constant := 16#2b#; -- 0
+   DW_OP_Le          : constant := 16#2c#; -- 0
+   DW_OP_Lt          : constant := 16#2d#; -- 0
+   DW_OP_Ne          : constant := 16#2e#; -- 0
+   DW_OP_Lit0        : constant := 16#30#; -- 0
+   DW_OP_Lit1        : constant := 16#31#; -- 0
+   DW_OP_Lit2        : constant := 16#32#; -- 0
+   DW_OP_Lit3        : constant := 16#33#; -- 0
+   DW_OP_Lit4        : constant := 16#34#; -- 0
+   DW_OP_Lit5        : constant := 16#35#; -- 0
+   DW_OP_Lit6        : constant := 16#36#; -- 0
+   DW_OP_Lit7        : constant := 16#37#; -- 0
+   DW_OP_Lit8        : constant := 16#38#; -- 0
+   DW_OP_Lit9        : constant := 16#39#; -- 0
+   DW_OP_Lit10       : constant := 16#3a#; -- 0
+   DW_OP_Lit11       : constant := 16#3b#; -- 0
+   DW_OP_Lit12       : constant := 16#3c#; -- 0
+   DW_OP_Lit13       : constant := 16#3d#; -- 0
+   DW_OP_Lit14       : constant := 16#3e#; -- 0
+   DW_OP_Lit15       : constant := 16#3f#; -- 0
+   DW_OP_Lit16       : constant := 16#40#; -- 0
+   DW_OP_Lit17       : constant := 16#41#; -- 0
+   DW_OP_Lit18       : constant := 16#42#; -- 0
+   DW_OP_Lit19       : constant := 16#43#; -- 0
+   DW_OP_Lit20       : constant := 16#44#; -- 0
+   DW_OP_Lit21       : constant := 16#45#; -- 0
+   DW_OP_Lit22       : constant := 16#46#; -- 0
+   DW_OP_Lit23       : constant := 16#47#; -- 0
+   DW_OP_Lit24       : constant := 16#48#; -- 0
+   DW_OP_Lit25       : constant := 16#49#; -- 0
+   DW_OP_Lit26       : constant := 16#4a#; -- 0
+   DW_OP_Lit27       : constant := 16#4b#; -- 0
+   DW_OP_Lit28       : constant := 16#4c#; -- 0
+   DW_OP_Lit29       : constant := 16#4d#; -- 0
+   DW_OP_Lit30       : constant := 16#4e#; -- 0
+   DW_OP_Lit31       : constant := 16#4f#; -- 0
+   DW_OP_Reg0        : constant := 16#50#; -- 0
+   DW_OP_Reg1        : constant := 16#51#; -- 0
+   DW_OP_Reg2        : constant := 16#52#; -- 0
+   DW_OP_Reg3        : constant := 16#53#; -- 0
+   DW_OP_Reg4        : constant := 16#54#; -- 0
+   DW_OP_Reg5        : constant := 16#55#; -- 0
+   DW_OP_Reg6        : constant := 16#56#; -- 0
+   DW_OP_Reg7        : constant := 16#57#; -- 0
+   DW_OP_Reg8        : constant := 16#58#; -- 0
+   DW_OP_Reg9        : constant := 16#59#; -- 0
+   DW_OP_Reg10       : constant := 16#5a#; -- 0
+   DW_OP_Reg11       : constant := 16#5b#; -- 0
+   DW_OP_Reg12       : constant := 16#5c#; -- 0
+   DW_OP_Reg13       : constant := 16#5d#; -- 0
+   DW_OP_Reg14       : constant := 16#5e#; -- 0
+   DW_OP_Reg15       : constant := 16#5f#; -- 0
+   DW_OP_Reg16       : constant := 16#60#; -- 0
+   DW_OP_Reg17       : constant := 16#61#; -- 0
+   DW_OP_Reg18       : constant := 16#62#; -- 0
+   DW_OP_Reg19       : constant := 16#63#; -- 0
+   DW_OP_Reg20       : constant := 16#64#; -- 0
+   DW_OP_Reg21       : constant := 16#65#; -- 0
+   DW_OP_Reg22       : constant := 16#66#; -- 0
+   DW_OP_Reg23       : constant := 16#67#; -- 0
+   DW_OP_Reg24       : constant := 16#68#; -- 0
+   DW_OP_Reg25       : constant := 16#69#; -- 0
+   DW_OP_Reg26       : constant := 16#6a#; -- 0
+   DW_OP_Reg27       : constant := 16#6b#; -- 0
+   DW_OP_Reg28       : constant := 16#6c#; -- 0
+   DW_OP_Reg29       : constant := 16#6d#; -- 0
+   DW_OP_Reg30       : constant := 16#6e#; -- 0
+   DW_OP_Reg31       : constant := 16#6f#; -- 0 reg 0..31
+   DW_OP_Breg0       : constant := 16#70#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg1       : constant := 16#71#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg2       : constant := 16#72#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg3       : constant := 16#73#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg4       : constant := 16#74#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg5       : constant := 16#75#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg6       : constant := 16#76#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg7       : constant := 16#77#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg8       : constant := 16#78#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg9       : constant := 16#79#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg10      : constant := 16#7a#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg11      : constant := 16#7b#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg12      : constant := 16#7c#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg13      : constant := 16#7d#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg14      : constant := 16#7e#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg15      : constant := 16#7f#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg16      : constant := 16#80#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg17      : constant := 16#81#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg18      : constant := 16#82#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg19      : constant := 16#83#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg20      : constant := 16#84#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg21      : constant := 16#85#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg22      : constant := 16#86#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg23      : constant := 16#87#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg24      : constant := 16#88#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg25      : constant := 16#89#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg26      : constant := 16#8a#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg27      : constant := 16#8b#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg28      : constant := 16#8c#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg29      : constant := 16#8d#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg30      : constant := 16#8e#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg31      : constant := 16#8f#; -- 1 SLEB128 offset base reg 0..31
+   DW_OP_Regx        : constant := 16#90#; -- 1 ULEB128 register
+   DW_OP_Fbreg       : constant := 16#91#; -- 1 SLEB128 offset
+   DW_OP_Bregx       : constant := 16#92#; -- 2 ULEB128 reg + SLEB128 offset
+   DW_OP_Piece       : constant := 16#93#; -- 1 ULEB128 size of piece addressed
+   DW_OP_Deref_Size  : constant := 16#94#; -- 1 1-byte size of data retrieved
+   DW_OP_Xderef_Size : constant := 16#95#; -- 1 1-byte size of data retrieved
+   DW_OP_Nop         : constant := 16#96#; -- 0
+   DW_OP_Push_Object_Address : constant := 16#97#; -- 0
+   DW_OP_Call2       : constant := 16#98#; -- 1 2-byte offset of DIE
+   DW_OP_Call4       : constant := 16#99#; -- 1 4-byte offset of DIE
+   DW_OP_Call_Ref    : constant := 16#9a#; -- 1 4- or 8-byte offset of DIE
+   DW_OP_Lo_User     : constant := 16#E0#; --
+   DW_OP_Hi_User     : constant := 16#ff#; --
+
+   DW_ATE_Address         : constant := 16#1#;
+   DW_ATE_Boolean         : constant := 16#2#;
+   DW_ATE_Complex_Float   : constant := 16#3#;
+   DW_ATE_Float           : constant := 16#4#;
+   DW_ATE_Signed          : constant := 16#5#;
+   DW_ATE_Signed_Char     : constant := 16#6#;
+   DW_ATE_Unsigned        : constant := 16#7#;
+   DW_ATE_Unsigned_Char   : constant := 16#8#;
+   DW_ATE_Imaginary_Float : constant := 16#9#;
+   DW_ATE_Lo_User         : constant := 16#80#;
+   DW_ATE_Hi_User         : constant := 16#ff#;
+
+   DW_ACCESS_Public       : constant := 1;
+   DW_ACCESS_Protected    : constant := 2;
+   DW_ACCESS_Private      : constant := 3;
+
+   DW_LANG_C89            : constant := 16#0001#;
+   DW_LANG_C              : constant := 16#0002#;
+   DW_LANG_Ada83          : constant := 16#0003#;
+   DW_LANG_C_Plus_Plus    : constant := 16#0004#;
+   DW_LANG_Cobol74        : constant := 16#0005#;
+   DW_LANG_Cobol85        : constant := 16#0006#;
+   DW_LANG_Fortran77      : constant := 16#0007#;
+   DW_LANG_Fortran90      : constant := 16#0008#;
+   DW_LANG_Pascal83       : constant := 16#0009#;
+   DW_LANG_Modula2        : constant := 16#000a#;
+   DW_LANG_Java           : constant := 16#000b#;
+   DW_LANG_C99            : constant := 16#000c#;
+   DW_LANG_Ada95          : constant := 16#000d#;
+   DW_LANG_Fortran95      : constant := 16#000e#;
+   DW_LANG_PLI            : constant := 16#000f#;
+   DW_LANG_Lo_User        : constant := 16#8000#;
+   DW_LANG_Hi_User        : constant := 16#ffff#;
+
+   DW_ID_Case_Sensitive   : constant := 0;
+   DW_ID_Up_Case          : constant := 1;
+   DW_ID_Down_Case        : constant := 2;
+   DW_ID_Case_Insensitive : constant := 3;
+
+   DW_CC_Normal           : constant := 16#1#;
+   DW_CC_Program          : constant := 16#2#;
+   DW_CC_Nocall           : constant := 16#3#;
+   DW_CC_Lo_User          : constant := 16#40#;
+   DW_CC_Hi_User          : constant := 16#Ff#;
+
+   DW_INL_Not_Inlined          : constant := 0;
+   DW_INL_Inlined              : constant := 1;
+   DW_INL_Declared_Not_Inlined : constant := 2;
+   DW_INL_Declared_Inlined     : constant := 3;
+
+   --  Line number information.
+   --  Line number standard opcode.
+   DW_LNS_Copy               : constant Unsigned_8 := 1;
+   DW_LNS_Advance_Pc         : constant Unsigned_8 := 2;
+   DW_LNS_Advance_Line       : constant Unsigned_8 := 3;
+   DW_LNS_Set_File           : constant Unsigned_8 := 4;
+   DW_LNS_Set_Column         : constant Unsigned_8 := 5;
+   DW_LNS_Negate_Stmt        : constant Unsigned_8 := 6;
+   DW_LNS_Set_Basic_Block    : constant Unsigned_8 := 7;
+   DW_LNS_Const_Add_Pc       : constant Unsigned_8 := 8;
+   DW_LNS_Fixed_Advance_Pc   : constant Unsigned_8 := 9;
+   DW_LNS_Set_Prologue_End   : constant Unsigned_8 := 10;
+   DW_LNS_Set_Epilogue_Begin : constant Unsigned_8 := 11;
+   DW_LNS_Set_Isa            : constant Unsigned_8 := 12;
+
+   --  Line number extended opcode.
+   DW_LNE_End_Sequence       : constant Unsigned_8 := 1;
+   DW_LNE_Set_Address        : constant Unsigned_8 := 2;
+   DW_LNE_Define_File        : constant Unsigned_8 := 3;
+   DW_LNE_Lo_User            : constant Unsigned_8 := 128;
+   DW_LNE_Hi_User            : constant Unsigned_8 := 255;
+
+   DW_CFA_Advance_Loc        : constant Unsigned_8 := 16#40#;
+   DW_CFA_Advance_Loc_Min    : constant Unsigned_8 := 16#40#;
+   DW_CFA_Advance_Loc_Max    : constant Unsigned_8 := 16#7f#;
+   DW_CFA_Offset             : constant Unsigned_8 := 16#80#;
+   DW_CFA_Offset_Min         : constant Unsigned_8 := 16#80#;
+   DW_CFA_Offset_Max         : constant Unsigned_8 := 16#Bf#;
+   DW_CFA_Restore            : constant Unsigned_8 := 16#C0#;
+   DW_CFA_Restore_Min        : constant Unsigned_8 := 16#C0#;
+   DW_CFA_Restore_Max        : constant Unsigned_8 := 16#FF#;
+   DW_CFA_Nop                : constant Unsigned_8 := 16#00#;
+   DW_CFA_Set_Loc            : constant Unsigned_8 := 16#01#;
+   DW_CFA_Advance_Loc1       : constant Unsigned_8 := 16#02#;
+   DW_CFA_Advance_Loc2       : constant Unsigned_8 := 16#03#;
+   DW_CFA_Advance_Loc4       : constant Unsigned_8 := 16#04#;
+   DW_CFA_Offset_Extended    : constant Unsigned_8 := 16#05#;
+   DW_CFA_Restore_Extended   : constant Unsigned_8 := 16#06#;
+   DW_CFA_Undefined          : constant Unsigned_8 := 16#07#;
+   DW_CFA_Same_Value         : constant Unsigned_8 := 16#08#;
+   DW_CFA_Register           : constant Unsigned_8 := 16#09#;
+   DW_CFA_Remember_State     : constant Unsigned_8 := 16#0a#;
+   DW_CFA_Restore_State      : constant Unsigned_8 := 16#0b#;
+   DW_CFA_Def_Cfa            : constant Unsigned_8 := 16#0c#;
+   DW_CFA_Def_Cfa_Register   : constant Unsigned_8 := 16#0d#;
+   DW_CFA_Def_Cfa_Offset     : constant Unsigned_8 := 16#0e#;
+   DW_CFA_Def_Cfa_Expression : constant Unsigned_8 := 16#0f#;
+
+   DW_EH_PE_Omit    : constant Unsigned_8 := 16#Ff#;
+   DW_EH_PE_Uleb128 : constant Unsigned_8 := 16#01#;
+   DW_EH_PE_Udata2  : constant Unsigned_8 := 16#02#;
+   DW_EH_PE_Udata4  : constant Unsigned_8 := 16#03#;
+   DW_EH_PE_Udata8  : constant Unsigned_8 := 16#04#;
+   DW_EH_PE_Sleb128 : constant Unsigned_8 := 16#09#;
+   DW_EH_PE_Sdata2  : constant Unsigned_8 := 16#0A#;
+   DW_EH_PE_Sdata4  : constant Unsigned_8 := 16#0B#;
+   DW_EH_PE_Sdata8  : constant Unsigned_8 := 16#0C#;
+   DW_EH_PE_Absptr  : constant Unsigned_8 := 16#00#;
+   DW_EH_PE_Pcrel   : constant Unsigned_8 := 16#10#;
+   DW_EH_PE_Datarel : constant Unsigned_8 := 16#30#;
+   DW_EH_PE_Format_Mask : constant Unsigned_8 := 16#0f#;
+end Dwarf;
+
+
diff --git a/src/ortho/mcode/elf32.adb b/src/ortho/mcode/elf32.adb
new file mode 100644
index 000000000..ef58fe64b
--- /dev/null
+++ b/src/ortho/mcode/elf32.adb
@@ -0,0 +1,48 @@
+--  ELF32 definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Elf32 is
+   function Elf32_St_Bind (Info : Elf32_Uchar) return Elf32_Uchar is
+   begin
+      return Shift_Right (Info, 4);
+   end Elf32_St_Bind;
+
+   function Elf32_St_Type (Info : Elf32_Uchar) return Elf32_Uchar is
+   begin
+      return Info and 16#0F#;
+   end Elf32_St_Type;
+
+   function Elf32_St_Info (B, T : Elf32_Uchar) return Elf32_Uchar is
+   begin
+      return Shift_Left (B, 4) or T;
+   end Elf32_St_Info;
+
+   function Elf32_R_Sym (I : Elf32_Word) return Elf32_Word is
+   begin
+      return Shift_Right (I, 8);
+   end Elf32_R_Sym;
+
+   function Elf32_R_Type (I : Elf32_Word) return Elf32_Word is
+   begin
+      return I and 16#Ff#;
+   end Elf32_R_Type;
+
+   function Elf32_R_Info (S, T : Elf32_Word) return Elf32_Word is
+   begin
+      return Shift_Left (S, 8) or T;
+   end Elf32_R_Info;
+end Elf32;
diff --git a/src/ortho/mcode/elf32.ads b/src/ortho/mcode/elf32.ads
new file mode 100644
index 000000000..5afd317f6
--- /dev/null
+++ b/src/ortho/mcode/elf32.ads
@@ -0,0 +1,124 @@
+--  ELF32 definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+with System;
+with Elf_Common; use Elf_Common;
+
+package Elf32 is
+   subtype Elf32_Addr  is Unsigned_32;
+   subtype Elf32_Half  is Unsigned_16;
+   subtype Elf32_Off   is Unsigned_32;
+   subtype Elf32_Sword is Integer_32;
+   subtype Elf32_Word  is Unsigned_32;
+   subtype Elf32_Uchar is Unsigned_8;
+
+   type Elf32_Ehdr is record
+      E_Ident     : E_Ident_Type;
+      E_Type      : Elf32_Half;
+      E_Machine   : Elf32_Half;
+      E_Version   : Elf32_Word;
+      E_Entry     : Elf32_Addr;
+      E_Phoff     : Elf32_Off;
+      E_Shoff     : Elf32_Off;
+      E_Flags     : Elf32_Word;
+      E_Ehsize    : Elf32_Half;
+      E_Phentsize : Elf32_Half;
+      E_Phnum     : Elf32_Half;
+      E_Shentsize : Elf32_Half;
+      E_Shnum     : Elf32_Half;
+      E_Shstrndx  : Elf32_Half;
+   end record;
+
+   Elf32_Ehdr_Size : constant Natural := Elf32_Ehdr'Size / System.Storage_Unit;
+
+   type Elf32_Shdr is record
+      Sh_Name      : Elf32_Word;
+      Sh_Type      : Elf32_Word;
+      Sh_Flags     : Elf32_Word;
+      Sh_Addr      : Elf32_Addr;
+      Sh_Offset    : Elf32_Off;
+      Sh_Size      : Elf32_Word;
+      Sh_Link      : Elf32_Word;
+      Sh_Info      : Elf32_Word;
+      Sh_Addralign : Elf32_Word;
+      Sh_Entsize   : Elf32_Word;
+   end record;
+   Elf32_Shdr_Size : constant Natural := Elf32_Shdr'Size / System.Storage_Unit;
+
+   --  Symbol table.
+   type Elf32_Sym is record
+      St_Name  : Elf32_Word;
+      St_Value : Elf32_Addr;
+      St_Size  : Elf32_Word;
+      St_Info  : Elf32_Uchar;
+      St_Other : Elf32_Uchar;
+      St_Shndx : Elf32_Half;
+   end record;
+   Elf32_Sym_Size : constant Natural := Elf32_Sym'Size / System.Storage_Unit;
+
+   function Elf32_St_Bind (Info : Elf32_Uchar) return Elf32_Uchar;
+   function Elf32_St_Type (Info : Elf32_Uchar) return Elf32_Uchar;
+   function Elf32_St_Info (B, T : Elf32_Uchar) return Elf32_Uchar;
+   pragma Inline (Elf32_St_Bind);
+   pragma Inline (Elf32_St_Type);
+   pragma Inline (Elf32_St_Info);
+
+   --  Relocation.
+   type Elf32_Rel is record
+      R_Offset : Elf32_Addr;
+      R_Info : Elf32_Word;
+   end record;
+   Elf32_Rel_Size : constant Natural := Elf32_Rel'Size / System.Storage_Unit;
+
+   type Elf32_Rela is record
+      R_Offset : Elf32_Addr;
+      R_Info : Elf32_Word;
+      R_Addend : Elf32_Sword;
+   end record;
+   Elf32_Rela_Size : constant Natural := Elf32_Rela'Size / System.Storage_Unit;
+
+   function Elf32_R_Sym (I : Elf32_Word) return Elf32_Word;
+   function Elf32_R_Type (I : Elf32_Word) return Elf32_Word;
+   function Elf32_R_Info (S, T : Elf32_Word) return Elf32_Word;
+
+   --  For i386
+   R_386_NONE : constant Elf32_Word := 0; -- none none
+   R_386_32   : constant Elf32_Word := 1; -- word32 S+A
+   R_386_PC32 : constant Elf32_Word := 2; -- word32 S+A-P
+
+   --  For sparc
+   R_SPARC_NONE    : constant Elf32_Word := 0; -- none
+   R_SPARC_32 :      constant Elf32_Word := 3; -- (S + A)
+   R_SPARC_WDISP30 : constant Elf32_Word := 7; -- (S + A - P) >> 2
+   R_SPARC_WDISP22 : constant Elf32_Word := 8; -- (S + A - P) >> 2
+   R_SPARC_HI22 :    constant Elf32_Word := 9; -- (S + A) >> 10
+   R_SPARC_LO10 :    constant Elf32_Word := 12; -- (S + A) & 0x3ff
+   R_SPARC_UA32 :    constant Elf32_Word := 23; -- (S + A)
+
+   type Elf32_Phdr is record
+      P_Type   : Elf32_Word;
+      P_Offset : Elf32_Off;
+      P_Vaddr  : Elf32_Addr;
+      P_Paddr  : Elf32_Addr;
+      P_Filesz : Elf32_Word;
+      P_Memsz  : Elf32_Word;
+      P_Flags  : Elf32_Word;
+      P_Align  : Elf32_Word;
+   end record;
+   Elf32_Phdr_Size : constant Natural := Elf32_Phdr'Size / System.Storage_Unit;
+end Elf32;
diff --git a/src/ortho/mcode/elf64.ads b/src/ortho/mcode/elf64.ads
new file mode 100644
index 000000000..217e5557a
--- /dev/null
+++ b/src/ortho/mcode/elf64.ads
@@ -0,0 +1,105 @@
+--  ELF64 definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+with System;
+with Elf_Common; use Elf_Common;
+
+package Elf64 is
+   subtype Elf64_Addr  is Unsigned_64;
+   subtype Elf64_Off   is Unsigned_64;
+   subtype Elf64_Uchar is Unsigned_8;
+   subtype Elf64_Half  is Unsigned_16;
+   subtype Elf64_Sword is Integer_32;
+   subtype Elf64_Word  is Unsigned_32;
+   subtype Elf64_Xword is Unsigned_64;
+   subtype Elf64_Sxword is Integer_64;
+
+   type Elf64_Ehdr is record
+      E_Ident     : E_Ident_Type;
+      E_Type      : Elf64_Half;
+      E_Machine   : Elf64_Half;
+      E_Version   : Elf64_Word;
+      E_Entry     : Elf64_Addr;
+      E_Phoff     : Elf64_Off;
+      E_Shoff     : Elf64_Off;
+      E_Flags     : Elf64_Word;
+      E_Ehsize    : Elf64_Half;
+      E_Phentsize : Elf64_Half;
+      E_Phnum     : Elf64_Half;
+      E_Shentsize : Elf64_Half;
+      E_Shnum     : Elf64_Half;
+      E_Shstrndx  : Elf64_Half;
+   end record;
+
+   Elf64_Ehdr_Size : constant Natural := Elf64_Ehdr'Size / System.Storage_Unit;
+
+   type Elf64_Shdr is record
+      Sh_Name      : Elf64_Word;
+      Sh_Type      : Elf64_Word;
+      Sh_Flags     : Elf64_Xword;
+      Sh_Addr      : Elf64_Addr;
+      Sh_Offset    : Elf64_Off;
+      Sh_Size      : Elf64_Xword;
+      Sh_Link      : Elf64_Word;
+      Sh_Info      : Elf64_Word;
+      Sh_Addralign : Elf64_Xword;
+      Sh_Entsize   : Elf64_Xword;
+   end record;
+   Elf64_Shdr_Size : constant Natural := Elf64_Shdr'Size / System.Storage_Unit;
+
+   --  Symbol table.
+   type Elf64_Sym is record
+      St_Name  : Elf64_Word;
+      St_Info  : Elf64_Uchar;
+      St_Other : Elf64_Uchar;
+      St_Shndx : Elf64_Half;
+      St_Value : Elf64_Addr;
+      St_Size  : Elf64_Xword;
+   end record;
+   Elf64_Sym_Size : constant Natural := Elf64_Sym'Size / System.Storage_Unit;
+
+   --  Relocation.
+   type Elf64_Rel is record
+      R_Offset : Elf64_Addr;
+      R_Info : Elf64_Xword;
+   end record;
+   Elf64_Rel_Size : constant Natural := Elf64_Rel'Size / System.Storage_Unit;
+
+   type Elf64_Rela is record
+      R_Offset : Elf64_Addr;
+      R_Info : Elf64_Xword;
+      R_Addend : Elf64_Sxword;
+   end record;
+   Elf64_Rela_Size : constant Natural := Elf64_Rela'Size / System.Storage_Unit;
+
+--     function Elf64_R_Sym (I : Elf64_Word) return Elf64_Word;
+--     function Elf64_R_Type (I : Elf64_Word) return Elf64_Word;
+--     function Elf64_R_Info (S, T : Elf64_Word) return Elf64_Word;
+
+   type Elf64_Phdr is record
+      P_Type   : Elf64_Word;
+      P_Flags  : Elf64_Word;
+      P_Offset : Elf64_Off;
+      P_Vaddr  : Elf64_Addr;
+      P_Paddr  : Elf64_Addr;
+      P_Filesz : Elf64_Xword;
+      P_Memsz  : Elf64_Xword;
+      P_Align  : Elf64_Xword;
+   end record;
+   Elf64_Phdr_Size : constant Natural := Elf64_Phdr'Size / System.Storage_Unit;
+end Elf64;
diff --git a/src/ortho/mcode/elf_arch.ads b/src/ortho/mcode/elf_arch.ads
new file mode 100644
index 000000000..325c4e5e3
--- /dev/null
+++ b/src/ortho/mcode/elf_arch.ads
@@ -0,0 +1,2 @@
+with Elf_Arch32;
+package Elf_Arch renames Elf_Arch32;
diff --git a/src/ortho/mcode/elf_arch32.ads b/src/ortho/mcode/elf_arch32.ads
new file mode 100644
index 000000000..5e987b1e6
--- /dev/null
+++ b/src/ortho/mcode/elf_arch32.ads
@@ -0,0 +1,37 @@
+--  ELF32 view of ELF.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Elf_Common; use Elf_Common;
+with Elf32; use Elf32;
+
+package Elf_Arch32 is
+   subtype Elf_Ehdr is Elf32_Ehdr;
+   subtype Elf_Shdr is Elf32_Shdr;
+   subtype Elf_Sym is Elf32_Sym;
+   subtype Elf_Rel is Elf32_Rel;
+   subtype Elf_Rela is Elf32_Rela;
+   subtype Elf_Phdr is Elf32_Phdr;
+
+   subtype Elf_Off is Elf32_Off;
+   subtype Elf_Size is Elf32_Word;
+   Elf_Ehdr_Size : constant Natural := Elf32_Ehdr_Size;
+   Elf_Shdr_Size : constant Natural := Elf32_Shdr_Size;
+   Elf_Phdr_Size : constant Natural := Elf32_Phdr_Size;
+   Elf_Sym_Size : constant Natural := Elf32_Sym_Size;
+
+   Elf_Arch_Class : constant Elf_Uchar := ELFCLASS32;
+end Elf_Arch32;
diff --git a/src/ortho/mcode/elf_arch64.ads b/src/ortho/mcode/elf_arch64.ads
new file mode 100644
index 000000000..504cd66b3
--- /dev/null
+++ b/src/ortho/mcode/elf_arch64.ads
@@ -0,0 +1,37 @@
+--  ELF64 view of ELF.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Elf_Common; use Elf_Common;
+with Elf64; use Elf64;
+
+package Elf_Arch64 is
+   subtype Elf_Ehdr is Elf64_Ehdr;
+   subtype Elf_Shdr is Elf64_Shdr;
+   subtype Elf_Sym is Elf64_Sym;
+   subtype Elf_Rel is Elf64_Rel;
+   subtype Elf_Rela is Elf64_Rela;
+   subtype Elf_Phdr is Elf64_Phdr;
+
+   subtype Elf_Off is Elf64_Off;
+   subtype Elf_Size is Elf64_Xword;
+   Elf_Ehdr_Size : constant Natural := Elf64_Ehdr_Size;
+   Elf_Shdr_Size : constant Natural := Elf64_Shdr_Size;
+   Elf_Phdr_Size : constant Natural := Elf64_Phdr_Size;
+   Elf_Sym_Size : constant Natural := Elf64_Sym_Size;
+
+   Elf_Arch_Class : constant Elf_Uchar := ELFCLASS64;
+end Elf_Arch64;
diff --git a/src/ortho/mcode/elf_common.adb b/src/ortho/mcode/elf_common.adb
new file mode 100644
index 000000000..5d05a2dc7
--- /dev/null
+++ b/src/ortho/mcode/elf_common.adb
@@ -0,0 +1,48 @@
+--  ELF definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Elf_Common is
+   function Elf_St_Bind (Info : Elf_Uchar) return Elf_Uchar is
+   begin
+      return Shift_Right (Info, 4);
+   end Elf_St_Bind;
+
+   function Elf_St_Type (Info : Elf_Uchar) return Elf_Uchar is
+   begin
+      return Info and 16#0F#;
+   end Elf_St_Type;
+
+   function Elf_St_Info (B, T : Elf_Uchar) return Elf_Uchar is
+   begin
+      return Shift_Left (B, 4) or T;
+   end Elf_St_Info;
+
+--     function Elf32_R_Sym (I : Elf32_Word) return Elf32_Word is
+--     begin
+--        return Shift_Right (I, 8);
+--     end Elf32_R_Sym;
+
+--     function Elf32_R_Type (I : Elf32_Word) return Elf32_Word is
+--     begin
+--        return I and 16#Ff#;
+--     end Elf32_R_Type;
+
+--     function Elf32_R_Info (S, T : Elf32_Word) return Elf32_Word is
+--     begin
+--        return Shift_Left (S, 8) or T;
+--     end Elf32_R_Info;
+end Elf_Common;
diff --git a/src/ortho/mcode/elf_common.ads b/src/ortho/mcode/elf_common.ads
new file mode 100644
index 000000000..28186d094
--- /dev/null
+++ b/src/ortho/mcode/elf_common.ads
@@ -0,0 +1,250 @@
+--  ELF definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+
+package Elf_Common is
+   subtype Elf_Half  is Unsigned_16;
+   subtype Elf_Sword is Integer_32;
+   subtype Elf_Word  is Unsigned_32;
+   subtype Elf_Uchar is Unsigned_8;
+
+   EI_NIDENT : constant Natural := 16;
+   type E_Ident_Type is array (Natural range 0 .. EI_NIDENT - 1)
+     of Elf_Uchar;
+
+   --  e_type values.
+   ET_NONE   : constant Elf_Half := 0;        --  No file type
+   ET_REL    : constant Elf_Half := 1;        --  Relocatable file
+   ET_EXEC   : constant Elf_Half := 2;        --  Executable file
+   ET_DYN    : constant Elf_Half := 3;        --  Shared object file
+   ET_CORE   : constant Elf_Half := 4;        --  Core file
+   ET_LOPROC : constant Elf_Half := 16#Ff00#; --  Processor-specific
+   ET_HIPROC : constant Elf_Half := 16#Ffff#; --  Processor-specific
+
+   --  e_machine values.
+   EM_NONE        : constant Elf_Half := 0;  --  No machine
+   EM_M32         : constant Elf_Half := 1;  --  AT&T WE 32100
+   EM_SPARC       : constant Elf_Half := 2;  --  SPARC
+   EM_386         : constant Elf_Half := 3;  --  Intel Architecture
+   EM_68K         : constant Elf_Half := 4;  --  Motorola 68000
+   EM_88K         : constant Elf_Half := 5;  --  Motorola 88000
+   EM_860         : constant Elf_Half := 7;  --  Intel 80860
+   EM_MIPS        : constant Elf_Half := 8;  --  MIPS RS3000 Big-Endian
+   EM_MIPS_RS4_BE : constant Elf_Half := 10; --  MIPS RS4000 Big-Endian
+   -- RESERVED : constant Elf_Half := 11; -- -16 Reserved for future use
+
+   --  e_version
+   EV_NONE    : constant Elf_Uchar := 0; --  Invalid versionn
+   EV_CURRENT : constant Elf_Uchar := 1; --  Current version
+
+   --  e_ident identification indexes.
+   EI_MAG0    : constant Natural := 0;  --  File identification
+   EI_MAG1    : constant Natural := 1;  --  File identification
+   EI_MAG2    : constant Natural := 2;  --  File identification
+   EI_MAG3    : constant Natural := 3;  --  File identification
+   EI_CLASS   : constant Natural := 4;  --  File class
+   EI_DATA    : constant Natural := 5;  --  Data encoding
+   EI_VERSION : constant Natural := 6;  --  File version
+   EI_PAD     : constant Natural := 7;  --  Start of padding bytes
+   --EI_NIDENT  : constant Natural := 16; --  Size of e_ident[]
+
+   --  Magic values.
+   ELFMAG0 : constant Elf_Uchar := 16#7f#; --  e_ident[EI_MAG0]
+   ELFMAG1 : constant Elf_Uchar := Character'Pos ('E'); --  e_ident[EI_MAG1]
+   ELFMAG2 : constant Elf_Uchar := Character'Pos ('L'); --  e_ident[EI_MAG2]
+   ELFMAG3 : constant Elf_Uchar := Character'Pos ('F'); --  e_ident[EI_MAG3]
+
+   ELFCLASSNONE : constant Elf_Uchar := 0; --  Invalid class
+   ELFCLASS32   : constant Elf_Uchar := 1; --  32-bit objects
+   ELFCLASS64   : constant Elf_Uchar := 2; --  64-bit objects
+
+   ELFDATANONE : constant Elf_Uchar := 0; --  Invalid data encoding
+   ELFDATA2LSB : constant Elf_Uchar := 1; --  See below
+   ELFDATA2MSB : constant Elf_Uchar := 2; --  See below
+
+   SHN_UNDEF     : constant Elf_Half := 0; --
+   SHN_LORESERVE : constant Elf_Half := 16#Ff00#; --
+   SHN_LOPROC    : constant Elf_Half := 16#ff00#; --
+   SHN_HIPROC    : constant Elf_Half := 16#ff1f#; --
+   SHN_ABS       : constant Elf_Half := 16#fff1#; --
+   SHN_COMMON    : constant Elf_Half := 16#fff2#; --
+   SHN_HIRESERVE : constant Elf_Half := 16#ffff#; --
+
+   -- Sh_type.
+   SHT_NULL          : constant Elf_Word := 0;
+   SHT_PROGBITS      : constant Elf_Word := 1;
+   SHT_SYMTAB        : constant Elf_Word := 2;
+   SHT_STRTAB        : constant Elf_Word := 3;
+   SHT_RELA          : constant Elf_Word := 4;
+   SHT_HASH          : constant Elf_Word := 5;
+   SHT_DYNAMIC       : constant Elf_Word := 6;
+   SHT_NOTE          : constant Elf_Word := 7;
+   SHT_NOBITS        : constant Elf_Word := 8;
+   SHT_REL           : constant Elf_Word := 9;
+   SHT_SHLIB         : constant Elf_Word := 10;
+   SHT_DYNSYM        : constant Elf_Word := 11;
+   SHT_INIT_ARRAY    : constant Elf_Word := 14;
+   SHT_FINI_ARRAY    : constant Elf_Word := 15;
+   SHT_PREINIT_ARRAY : constant Elf_Word := 16;
+   SHT_GROUP         : constant Elf_Word := 17;
+   SHT_SYMTAB_SHNDX  : constant Elf_Word := 18;
+   SHT_NUM           : constant Elf_Word := 19;
+   SHT_LOOS          : constant Elf_Word := 16#60000000#;
+   SHT_GNU_LIBLIST   : constant Elf_Word := 16#6ffffff7#;
+   SHT_CHECKSUM      : constant Elf_Word := 16#6ffffff8#;
+   SHT_LOSUNW        : constant Elf_Word := 16#6ffffffa#;
+   SHT_SUNW_Move     : constant Elf_Word := 16#6ffffffa#;
+   SHT_SUNW_COMDAT   : constant Elf_Word := 16#6ffffffb#;
+   SHT_SUNW_Syminfo  : constant Elf_Word := 16#6ffffffc#;
+   SHT_GNU_Verdef    : constant Elf_Word := 16#6ffffffd#;
+   SHT_GNU_Verneed   : constant Elf_Word := 16#6ffffffe#;
+   SHT_GNU_Versym    : constant Elf_Word := 16#6fffffff#;
+   SHT_HISUNW        : constant Elf_Word := 16#6fffffff#;
+   SHT_HIOS          : constant Elf_Word := 16#6fffffff#;
+   SHT_LOPROC        : constant Elf_Word := 16#70000000#;
+   SHT_HIPROC        : constant Elf_Word := 16#7fffffff#;
+   SHT_LOUSER        : constant Elf_Word := 16#80000000#;
+   SHT_HIUSER        : constant Elf_Word := 16#ffffffff#;
+
+
+   SHF_WRITE     : constant := 16#1#;
+   SHF_ALLOC     : constant := 16#2#;
+   SHF_EXECINSTR : constant := 16#4#;
+   SHF_MASKPROC  : constant := 16#F0000000#;
+
+   function Elf_St_Bind (Info : Elf_Uchar) return Elf_Uchar;
+   function Elf_St_Type (Info : Elf_Uchar) return Elf_Uchar;
+   function Elf_St_Info (B, T : Elf_Uchar) return Elf_Uchar;
+   pragma Inline (Elf_St_Bind);
+   pragma Inline (Elf_St_Type);
+   pragma Inline (Elf_St_Info);
+
+   --  Symbol binding.
+   STB_LOCAL  : constant Elf_Uchar := 0;
+   STB_GLOBAL : constant Elf_Uchar := 1;
+   STB_WEAK   : constant Elf_Uchar := 2;
+   STB_LOPROC : constant Elf_Uchar := 13;
+   STB_HIPROC : constant Elf_Uchar := 15;
+
+   --  Symbol types.
+   STT_NOTYPE  : constant Elf_Uchar := 0;
+   STT_OBJECT  : constant Elf_Uchar := 1;
+   STT_FUNC    : constant Elf_Uchar := 2;
+   STT_SECTION : constant Elf_Uchar := 3;
+   STT_FILE    : constant Elf_Uchar := 4;
+   STT_LOPROC  : constant Elf_Uchar := 13;
+   STT_HIPROC  : constant Elf_Uchar := 15;
+
+
+   PT_NULL         : constant Elf_Word := 0;
+   PT_LOAD         : constant Elf_Word := 1;
+   PT_DYNAMIC      : constant Elf_Word := 2;
+   PT_INTERP       : constant Elf_Word := 3;
+   PT_NOTE         : constant Elf_Word := 4;
+   PT_SHLIB        : constant Elf_Word := 5;
+   PT_PHDR         : constant Elf_Word := 6;
+   PT_TLS          : constant Elf_Word := 7;
+   PT_NUM          : constant Elf_Word := 8;
+   PT_LOOS         : constant Elf_Word := 16#60000000#;
+   PT_GNU_EH_FRAME : constant Elf_Word := 16#6474e550#;
+   PT_LOSUNW       : constant Elf_Word := 16#6ffffffa#;
+   PT_SUNWBSS      : constant Elf_Word := 16#6ffffffa#;
+   PT_SUNWSTACK    : constant Elf_Word := 16#6ffffffb#;
+   PT_HISUNW       : constant Elf_Word := 16#6fffffff#;
+   PT_HIOS         : constant Elf_Word := 16#6fffffff#;
+   PT_LOPROC       : constant Elf_Word := 16#70000000#;
+   PT_HIPROC       : constant Elf_Word := 16#7fffffff#;
+
+   PF_X : constant Elf_Word := 1;
+   PF_W : constant Elf_Word := 2;
+   PF_R : constant Elf_Word := 4;
+
+   DT_NULL            : constant Elf_Word := 0;
+   DT_NEEDED          : constant Elf_Word := 1;
+   DT_PLTRELSZ        : constant Elf_Word := 2;
+   DT_PLTGOT          : constant Elf_Word := 3;
+   DT_HASH            : constant Elf_Word := 4;
+   DT_STRTAB          : constant Elf_Word := 5;
+   DT_SYMTAB          : constant Elf_Word := 6;
+   DT_RELA            : constant Elf_Word := 7;
+   DT_RELASZ          : constant Elf_Word := 8;
+   DT_RELAENT         : constant Elf_Word := 9;
+   DT_STRSZ           : constant Elf_Word := 10;
+   DT_SYMENT          : constant Elf_Word := 11;
+   DT_INIT            : constant Elf_Word := 12;
+   DT_FINI            : constant Elf_Word := 13;
+   DT_SONAME          : constant Elf_Word := 14;
+   DT_RPATH           : constant Elf_Word := 15;
+   DT_SYMBOLIC        : constant Elf_Word := 16;
+   DT_REL             : constant Elf_Word := 17;
+   DT_RELSZ           : constant Elf_Word := 18;
+   DT_RELENT          : constant Elf_Word := 19;
+   DT_PLTREL          : constant Elf_Word := 20;
+   DT_DEBUG           : constant Elf_Word := 21;
+   DT_TEXTREL         : constant Elf_Word := 22;
+   DT_JMPREL          : constant Elf_Word := 23;
+   DT_BIND_NOW        : constant Elf_Word := 24;
+   DT_INIT_ARRAY      : constant Elf_Word := 25;
+   DT_FINI_ARRAY      : constant Elf_Word := 26;
+   DT_INIT_ARRAYSZ    : constant Elf_Word := 27;
+   DT_FINI_ARRAYSZ    : constant Elf_Word := 28;
+   DT_RUNPATH         : constant Elf_Word := 29;
+   DT_FLAGS           : constant Elf_Word := 30;
+   DT_ENCODING        : constant Elf_Word := 32;
+   DT_PREINIT_ARRAY   : constant Elf_Word := 32;
+   DT_PREINIT_ARRAYSZ : constant Elf_Word := 33;
+   DT_NUM             : constant Elf_Word := 34;
+   DT_LOOS            : constant Elf_Word := 16#60000000#;
+   DT_HIOS            : constant Elf_Word := 16#6fffffff#;
+   DT_LOPROC          : constant Elf_Word := 16#70000000#;
+   DT_HIPROC          : constant Elf_Word := 16#7fffffff#;
+   DT_VALRNGLO        : constant Elf_Word := 16#6ffffd00#;
+   DT_GNU_PRELINKED   : constant Elf_Word := 16#6ffffdf5#;
+   DT_GNU_CONFLICTSZ  : constant Elf_Word := 16#6ffffdf6#;
+   DT_GNU_LIBLISTSZ   : constant Elf_Word := 16#6ffffdf7#;
+   DT_CHECKSUM        : constant Elf_Word := 16#6ffffdf8#;
+   DT_PLTPADSZ        : constant Elf_Word := 16#6ffffdf9#;
+   DT_MOVEENT         : constant Elf_Word := 16#6ffffdfa#;
+   DT_MOVESZ          : constant Elf_Word := 16#6ffffdfb#;
+   DT_FEATURE_1       : constant Elf_Word := 16#6ffffdfc#;
+   DT_POSFLAG_1       : constant Elf_Word := 16#6ffffdfd#;
+   DT_SYMINSZ         : constant Elf_Word := 16#6ffffdfe#;
+   DT_SYMINENT        : constant Elf_Word := 16#6ffffdff#;
+   DT_VALRNGHI        : constant Elf_Word := 16#6ffffdff#;
+   DT_ADDRRNGLO       : constant Elf_Word := 16#6ffffe00#;
+   DT_GNU_CONFLICT    : constant Elf_Word := 16#6ffffef8#;
+   DT_GNU_LIBLIST     : constant Elf_Word := 16#6ffffef9#;
+   DT_CONFIG          : constant Elf_Word := 16#6ffffefa#;
+   DT_DEPAUDIT        : constant Elf_Word := 16#6ffffefb#;
+   DT_AUDIT           : constant Elf_Word := 16#6ffffefc#;
+   DT_PLTPAD          : constant Elf_Word := 16#6ffffefd#;
+   DT_MOVETAB         : constant Elf_Word := 16#6ffffefe#;
+   DT_SYMINFO         : constant Elf_Word := 16#6ffffeff#;
+   DT_ADDRRNGHI       : constant Elf_Word := 16#6ffffeff#;
+   DT_VERSYM          : constant Elf_Word := 16#6ffffff0#;
+   DT_RELACOUNT       : constant Elf_Word := 16#6ffffff9#;
+   DT_RELCOUNT        : constant Elf_Word := 16#6ffffffa#;
+   DT_FLAGS_1         : constant Elf_Word := 16#6ffffffb#;
+   DT_VERDEF          : constant Elf_Word := 16#6ffffffc#;
+   DT_VERDEFNUM       : constant Elf_Word := 16#6ffffffd#;
+   DT_VERNEED         : constant Elf_Word := 16#6ffffffe#;
+   DT_VERNEEDNUM      : constant Elf_Word := 16#6fffffff#;
+   DT_AUXILIARY       : constant Elf_Word := 16#7ffffffd#;
+   DT_FILTER          : constant Elf_Word := 16#7fffffff#;
+
+end Elf_Common;
diff --git a/src/ortho/mcode/elfdump.adb b/src/ortho/mcode/elfdump.adb
new file mode 100644
index 000000000..d49275912
--- /dev/null
+++ b/src/ortho/mcode/elfdump.adb
@@ -0,0 +1,267 @@
+--  ELF dumper (main program).
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with Elf_Common; use Elf_Common;
+with Ada.Command_Line; use Ada.Command_Line;
+with Hex_Images; use Hex_Images;
+with Interfaces; use Interfaces;
+with Elfdumper; use Elfdumper;
+
+procedure Elfdump is
+   Flag_Ehdr : Boolean := False;
+   Flag_Shdr : Boolean := False;
+   Flag_Strtab : Boolean := False;
+   Flag_Symtab : Boolean := False;
+   Flag_Dwarf_Info : Boolean := False;
+   Flag_Dwarf_Abbrev : Boolean := False;
+   Flag_Dwarf_Pubnames : Boolean := False;
+   Flag_Dwarf_Aranges : Boolean := False;
+   Flag_Dwarf_Line : Boolean := False;
+   Flag_Dwarf_Frame : Boolean := False;
+   Flag_Eh_Frame_Hdr : Boolean := False;
+   Flag_Long_Shdr : Boolean := False;
+   Flag_Phdr : Boolean := False;
+   Flag_Note : Boolean := False;
+   Flag_Dynamic : Boolean := False;
+
+   procedure Disp_Max_Len (Str : String; Len : Natural)
+   is
+   begin
+      if Str'Length > Len then
+         Put (Str (Str'First .. Str'First + Len - 1));
+      else
+         Put (Str);
+         Put ((Str'Length + 1 .. Len => ' '));
+      end if;
+   end Disp_Max_Len;
+
+   procedure Disp_Section_Header (File : Elf_File; Index : Elf_Half) is
+   begin
+      Put ("Section " & Hex_Image (Index));
+      Put (" ");
+      Put (Get_Section_Name (File, Index));
+      New_Line;
+   end Disp_Section_Header;
+
+   procedure Disp_Elf_File (Filename : String)
+   is
+      File : Elf_File;
+      Ehdr : Elf_Ehdr_Acc;
+      Shdr : Elf_Shdr_Acc;
+      Phdr : Elf_Phdr_Acc;
+      Sh_Strtab : Strtab_Type;
+   begin
+      Open_File (File, Filename);
+      if Get_Status (File) /= Status_Ok then
+         Put_Line ("cannot open elf file '" & Filename & "': " &
+                   Elf_File_Status'Image (Get_Status (File)));
+         return;
+      end if;
+
+      Ehdr := Get_Ehdr (File);
+
+      if Flag_Ehdr then
+         Disp_Ehdr (Ehdr.all);
+      end if;
+
+      Load_Shdr (File);
+      Sh_Strtab := Get_Sh_Strtab (File);
+
+      if Flag_Long_Shdr then
+         if Ehdr.E_Shnum = 0 then
+            Put ("no section");
+         else
+            for I in 0 .. Ehdr.E_Shnum - 1 loop
+               Put ("Section " & Hex_Image (I));
+               New_Line;
+               Disp_Shdr (Get_Shdr (File, I).all, Sh_Strtab);
+            end loop;
+         end if;
+      end if;
+      if Flag_Shdr then
+         if Ehdr.E_Shnum = 0 then
+            Put ("no section");
+         else
+            Put ("Num   Name                Type       ");
+            Put ("Offset   Size     Link Info Al Es");
+            New_Line;
+            for I in 0 .. Ehdr.E_Shnum - 1 loop
+               declare
+                  Shdr : Elf_Shdr_Acc := Get_Shdr (File, I);
+               begin
+                  Put (Hex_Image (I));
+                  Put (" ");
+                  Disp_Max_Len (Get_Section_Name (File, I), 20);
+                  Put (" ");
+                  Disp_Max_Len (Get_Shdr_Type_Name (Shdr.Sh_Type), 10);
+                  Put (" ");
+                  Put (Hex_Image (Shdr.Sh_Offset));
+                  Put (" ");
+                  Put (Hex_Image (Shdr.Sh_Size));
+                  Put (" ");
+                  Put (Hex_Image (Unsigned_16 (Shdr.Sh_Link and 16#Ffff#)));
+                  Put (" ");
+                  Put (Hex_Image (Unsigned_16 (Shdr.Sh_Info and 16#Ffff#)));
+                  Put (" ");
+                  Put (Hex_Image (Unsigned_8 (Shdr.Sh_Addralign and 16#ff#)));
+                  Put (" ");
+                  Put (Hex_Image (Unsigned_8 (Shdr.Sh_Entsize and 16#ff#)));
+                  New_Line;
+               end;
+            end loop;
+         end if;
+      end if;
+
+      if Flag_Phdr then
+         Load_Phdr (File);
+         if Ehdr.E_Phnum = 0 then
+            Put ("no program segment");
+         else
+            for I in 0 .. Ehdr.E_Phnum - 1 loop
+               Put ("segment " & Hex_Image (I));
+               New_Line;
+               Disp_Phdr (Get_Phdr (File, I).all);
+            end loop;
+         end if;
+      end if;
+
+      --  Dump each section.
+      if Ehdr.E_Shnum > 0 then
+         for I in 0 .. Ehdr.E_Shnum - 1 loop
+            Shdr := Get_Shdr (File, I);
+            case Shdr.Sh_Type is
+               when SHT_SYMTAB =>
+                  if Flag_Symtab then
+                     Disp_Section_Header (File, I);
+                     Disp_Symtab (File, I);
+                  end if;
+               when SHT_STRTAB =>
+                  if Flag_Strtab then
+                     Disp_Section_Header (File, I);
+                     Disp_Strtab (File, I);
+                  end if;
+               when SHT_PROGBITS =>
+                  declare
+                     Name : String := Get_Section_Name (File, I);
+                  begin
+                     if Flag_Dwarf_Abbrev and then Name = ".debug_abbrev" then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Abbrev (File, I);
+                     elsif Flag_Dwarf_Info and then Name = ".debug_info" then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Info (File, I);
+                     elsif Flag_Dwarf_Line and then Name = ".debug_line" then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Line (File, I);
+                     elsif Flag_Dwarf_Frame and then Name = ".debug_frame" then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Frame (File, I);
+                     elsif Flag_Dwarf_Pubnames
+                       and then Name = ".debug_pubnames"
+                     then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Pubnames (File, I);
+                     elsif Flag_Eh_Frame_Hdr and then Name = ".eh_frame_hdr"
+                     then
+                        Disp_Section_Header (File, I);
+                        Disp_Eh_Frame_Hdr (File, I);
+                     elsif Flag_Dwarf_Aranges
+                       and then Name = ".debug_aranges"
+                     then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Aranges (File, I);
+                     end if;
+                  end;
+               when SHT_NOTE =>
+                  if Flag_Note then
+                     Disp_Section_Header (File, I);
+                     Disp_Section_Note (File, I);
+                  end if;
+               when SHT_DYNAMIC =>
+                  if Flag_Dynamic then
+                     Disp_Section_Header (File, I);
+                     Disp_Dynamic (File, I);
+                  end if;
+               when others =>
+                  null;
+            end case;
+         end loop;
+      elsif Ehdr.E_Phnum > 0 then
+         Load_Phdr (File);
+         for I in 0 .. Ehdr.E_Phnum - 1 loop
+            Phdr := Get_Phdr (File, I);
+            case Phdr.P_Type is
+               when PT_NOTE =>
+                  if Flag_Note then
+                     Disp_Segment_Note (File, I);
+                  end if;
+               when others =>
+                  null;
+            end case;
+         end loop;
+      end if;
+   end Disp_Elf_File;
+
+begin
+   for I in 1 .. Argument_Count loop
+      declare
+         Arg : String := Argument (I);
+      begin
+         if Arg (1) = '-' then
+            --  An option.
+            if Arg = "-e" then
+               Flag_Ehdr := True;
+            elsif Arg = "-t" then
+               Flag_Strtab := True;
+            elsif Arg = "-S" then
+               Flag_Symtab := True;
+            elsif Arg = "-s" then
+               Flag_Shdr := True;
+            elsif Arg = "-p" then
+               Flag_Phdr := True;
+            elsif Arg = "-n" then
+               Flag_Note := True;
+            elsif Arg = "-d" then
+               Flag_Dynamic := True;
+            elsif Arg = "--dwarf-info" then
+               Flag_Dwarf_Info := True;
+            elsif Arg = "--dwarf-abbrev" then
+               Flag_Dwarf_Abbrev := True;
+            elsif Arg = "--dwarf-line" then
+               Flag_Dwarf_Line := True;
+            elsif Arg = "--dwarf-frame" then
+               Flag_Dwarf_Frame := True;
+            elsif Arg = "--dwarf-pubnames" then
+               Flag_Dwarf_Pubnames := True;
+            elsif Arg = "--dwarf-aranges" then
+               Flag_Dwarf_Aranges := True;
+            elsif Arg = "--eh-frame-hdr" then
+               Flag_Eh_Frame_Hdr := True;
+            elsif Arg = "--long-shdr" then
+               Flag_Long_Shdr := True;
+            else
+               Put_Line ("unknown option '" & Arg & "'");
+               return;
+            end if;
+         else
+            Disp_Elf_File (Arg);
+         end if;
+      end;
+   end loop;
+end Elfdump;
+
diff --git a/src/ortho/mcode/elfdumper.adb b/src/ortho/mcode/elfdumper.adb
new file mode 100644
index 000000000..b3a3b70f2
--- /dev/null
+++ b/src/ortho/mcode/elfdumper.adb
@@ -0,0 +1,2818 @@
+--  ELF dumper (library).
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System.Storage_Elements; use System.Storage_Elements;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with GNAT.OS_Lib;
+with Interfaces; use Interfaces;
+with Hex_Images; use Hex_Images;
+with Elf_Common; use Elf_Common;
+with Dwarf;
+
+package body Elfdumper is
+   function Get_String (Strtab : Strtab_Type; N : Elf_Size) return String
+   is
+      E : Elf_Size;
+   begin
+      E := N;
+      while Strtab.Base (E) /= Nul loop
+         E := E + 1;
+      end loop;
+      if E = N then
+         return "";
+      else
+         return String (Strtab.Base (N .. E - 1));
+      end if;
+   end Get_String;
+
+   procedure Disp_Ehdr (Ehdr : Elf_Ehdr) is
+   begin
+      Put ("File class: ");
+      case Ehdr.E_Ident (EI_CLASS) is
+         when ELFCLASSNONE =>
+            Put ("none");
+         when ELFCLASS32 =>
+            Put ("class_32");
+         when ELFCLASS64 =>
+            Put ("class_64");
+         when others =>
+            Put ("others");
+      end case;
+      New_Line;
+
+      Put ("encoding  : ");
+      case Ehdr.E_Ident (EI_DATA) is
+         when ELFDATANONE =>
+            Put ("none");
+         when ELFDATA2LSB =>
+            Put ("LSB byte order");
+         when ELFDATA2MSB =>
+            Put ("MSB byte order");
+         when others =>
+            Put ("unknown");
+      end case;
+      New_Line;
+
+      Put ("version   : ");
+      case Ehdr.E_Ident (EI_VERSION) is
+         when EV_NONE =>
+            Put ("none");
+         when EV_CURRENT =>
+            Put ("current (1)");
+         when others =>
+            Put ("future");
+      end case;
+      New_Line;
+
+      if Ehdr.E_Ident (EI_CLASS) /= Elf_Arch_Class
+--        or Ehdr.E_Ident (EI_DATA) /= ELFDATA2LSB
+        or Ehdr.E_Ident (EI_VERSION) /= EV_CURRENT
+      then
+         Put_Line ("bad class/data encoding/version");
+         return;
+      end if;
+
+      Put ("File type : ");
+      case Ehdr.E_Type is
+         when ET_NONE =>
+            Put ("no file type");
+         when ET_REL =>
+            Put ("relocatable file");
+         when ET_EXEC =>
+            Put ("executable file");
+         when ET_CORE =>
+            Put ("core file");
+         when ET_LOPROC .. ET_HIPROC =>
+            Put ("processor-specific");
+         when others =>
+            Put ("unknown");
+      end case;
+      New_Line;
+
+      Put ("machine   : ");
+      case Ehdr.E_Machine is
+         when EM_NONE =>
+            Put ("no machine");
+         when EM_M32 =>
+            Put ("AT&T WE 32100");
+         when EM_SPARC =>
+            Put ("SPARC");
+         when EM_386 =>
+            Put ("Intel architecture");
+         when EM_68K =>
+            Put ("Motorola 68000");
+         when EM_88K =>
+            Put ("Motorola 88000");
+         when EM_860 =>
+            Put ("Intel 80860");
+         when EM_MIPS =>
+            Put ("MIPS RS3000 Big-Endian");
+         when EM_MIPS_RS4_BE =>
+            Put ("MIPS RS4000 Big-Endian");
+         when others =>
+            Put ("unknown");
+      end case;
+      New_Line;
+
+      Put_Line ("Version   : " & Hex_Image (Ehdr.E_Version));
+      Put_Line ("Phoff     : " & Hex_Image (Ehdr.E_Phoff));
+      Put_Line ("Shoff     : " & Hex_Image (Ehdr.E_Shoff));
+      Put_Line ("flags     : " & Hex_Image (Ehdr.E_Flags));
+      Put_Line ("phentsize : " & Hex_Image (Ehdr.E_Ehsize));
+      Put_Line ("phnum     : " & Hex_Image (Ehdr.E_Phentsize));
+      Put_Line ("shentsize : " & Hex_Image (Ehdr.E_Shentsize));
+      Put_Line ("shnum     : " & Hex_Image (Ehdr.E_Shnum));
+      Put_Line ("shstrndx  : " & Hex_Image (Ehdr.E_Shstrndx));
+   end Disp_Ehdr;
+
+   function Get_Shdr_Type_Name (Stype : Elf_Word) return String is
+   begin
+      case Stype is
+         when SHT_NULL =>
+            return "NULL";
+         when SHT_PROGBITS =>
+            return "PROGBITS";
+         when SHT_SYMTAB =>
+            return "SYMTAB";
+         when SHT_STRTAB =>
+            return "STRTAB";
+         when SHT_RELA =>
+            return "RELA";
+         when SHT_HASH =>
+            return "HASH";
+         when SHT_DYNAMIC =>
+            return "DYNAMIC";
+         when SHT_NOTE =>
+            return "NOTE";
+         when SHT_NOBITS =>
+            return "NOBITS";
+         when SHT_REL =>
+            return "REL";
+         when SHT_SHLIB =>
+            return "SHLIB";
+         when SHT_DYNSYM =>
+            return "DYNSYM";
+         when SHT_INIT_ARRAY =>
+            return "INIT_ARRAY";
+         when SHT_FINI_ARRAY =>
+            return "FINI_ARRAY";
+         when SHT_PREINIT_ARRAY =>
+            return "PREINIT_ARRAY";
+         when SHT_GROUP =>
+            return "GROUP";
+         when SHT_SYMTAB_SHNDX =>
+            return "SYMTAB_SHNDX";
+         when SHT_NUM =>
+            return "NUM";
+         when SHT_LOOS =>
+            return "LOOS";
+         when SHT_GNU_LIBLIST =>
+            return "GNU_LIBLIST";
+         when SHT_CHECKSUM =>
+            return "CHECKSUM";
+         when SHT_SUNW_Move =>
+            return "SUNW_move";
+         when SHT_SUNW_COMDAT =>
+            return "SUNW_COMDAT";
+         when SHT_SUNW_Syminfo =>
+            return "SUNW_syminfo";
+         when SHT_GNU_Verdef =>
+            return "GNU_verdef";
+         when SHT_GNU_Verneed =>
+            return "GNU_verneed";
+         when SHT_GNU_Versym =>
+            return "GNU_versym";
+         when SHT_LOPROC .. SHT_HIPROC =>
+            return "Processor dependant";
+         when SHT_LOUSER .. SHT_HIUSER =>
+            return "User dependant";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Shdr_Type_Name;
+
+   procedure Disp_Shdr (Shdr : Elf_Shdr; Sh_Strtab : Strtab_Type)
+   is
+   begin
+      Put_Line ("name  : " & Hex_Image (Shdr.Sh_Name) & " """
+                & Get_String (Sh_Strtab, Elf_Size (Shdr.Sh_Name)) & """");
+      Put ("type  : " & Hex_Image (Shdr.Sh_Type) & " ");
+      Put (Get_Shdr_Type_Name (Shdr.Sh_Type));
+      New_Line;
+      Put ("flags : " & Hex_Image (Shdr.Sh_Flags));
+      if (Shdr.Sh_Flags and SHF_WRITE) /= 0 then
+         Put (" WRITE");
+      end if;
+      if (Shdr.Sh_Flags and SHF_ALLOC) /= 0 then
+         Put (" ALLOC");
+      end if;
+      if (Shdr.Sh_Flags and SHF_EXECINSTR) /= 0 then
+         Put (" EXEC");
+      end if;
+      New_Line;
+      Put ("addr  : " & Hex_Image (Shdr.Sh_Addr));
+      Put ("  offset : " & Hex_Image (Shdr.Sh_Offset));
+      Put ("       size : " & Hex_Image (Shdr.Sh_Size));
+      New_Line;
+      Put ("link  : " & Hex_Image (Shdr.Sh_Link));
+      Put ("    info : " & Hex_Image (Shdr.Sh_Info));
+      Put ("  addralign : " & Hex_Image (Shdr.Sh_Addralign));
+      Put ("  entsize : " & Hex_Image (Shdr.Sh_Entsize));
+      New_Line;
+   end Disp_Shdr;
+
+   procedure Disp_Sym (File : Elf_File;
+                       Sym : Elf_Sym;
+                       Strtab : Strtab_Type)
+   is
+   begin
+      Put (Hex_Image (Sym.St_Value));
+      Put (" " & Hex_Image (Sym.St_Size));
+      Put (' ');
+      --Put ("  info:" & Hex_Image (Sym.St_Info) & " ");
+      case Elf_St_Bind (Sym.St_Info) is
+         when STB_LOCAL =>
+            Put ("loc ");
+         when STB_GLOBAL =>
+            Put ("glob");
+         when STB_WEAK =>
+            Put ("weak");
+         when others =>
+            Put ("?   ");
+      end case;
+      Put (' ');
+      case Elf_St_Type (Sym.St_Info) is
+         when STT_NOTYPE =>
+            Put ("none");
+         when STT_OBJECT =>
+            Put ("obj ");
+         when STT_FUNC =>
+            Put ("func");
+         when STT_SECTION =>
+            Put ("sect");
+         when STT_FILE =>
+            Put ("file");
+         when others =>
+            Put ("?   ");
+      end case;
+      --Put ("  other:" & Hex_Image (Sym.St_Other));
+      Put (' ');
+      case Sym.St_Shndx is
+         when SHN_UNDEF =>
+            Put ("UNDEF   ");
+         when 1 .. SHN_LORESERVE - 1 =>
+            declare
+               S : String := Get_Section_Name (File, Sym.St_Shndx);
+               Max : constant Natural := 8;
+            begin
+               if S'Length <= Max then
+                  Put (S);
+                  for I in S'Length + 1 .. Max loop
+                     Put (' ');
+                  end loop;
+               else
+                  Put (S (S'First .. S'First + Max - 1));
+               end if;
+            end;
+         when SHN_LOPROC .. SHN_HIPROC =>
+            Put ("*proc*  ");
+         when SHN_ABS =>
+            Put ("*ABS*   ");
+         when SHN_COMMON =>
+            Put ("*COMMON*");
+         when others =>
+            Put ("??      ");
+      end case;
+      --Put (" sect:" & Hex_Image (Sym.St_Shndx));
+      Put (' ');
+      Put_Line (Get_String (Strtab, Elf_Size (Sym.St_Name)));
+   end Disp_Sym;
+
+   function Get_Offset (File : Elf_File; Off : Elf_Off; Size : Elf_Size)
+                       return Address
+   is
+   begin
+      if Off > File.Length or Off + Size > File.Length then
+         return Null_Address;
+      end if;
+      return File.Base + Storage_Offset (Off);
+   end Get_Offset;
+
+   function Get_Section_Base (File : Elf_File; Shdr : Elf_Shdr)
+                             return Address
+   is
+   begin
+      return Get_Offset (File, Shdr.Sh_Offset, Shdr.Sh_Size);
+   end Get_Section_Base;
+
+   function Get_Section_Base (File : Elf_File; Index : Elf_Half)
+                             return Address
+   is
+      Shdr : Elf_Shdr_Acc;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      return Get_Section_Base (File, Shdr.all);
+   end Get_Section_Base;
+
+   function Get_Segment_Base (File : Elf_File; Phdr : Elf_Phdr)
+                             return Address
+   is
+   begin
+      return Get_Offset (File, Phdr.P_Offset, Phdr.P_Filesz);
+   end Get_Segment_Base;
+
+   function Get_Segment_Base (File : Elf_File; Index : Elf_Half)
+                             return Address
+   is
+      Phdr : Elf_Phdr_Acc;
+   begin
+      Phdr := Get_Phdr (File, Index);
+      return Get_Segment_Base (File, Phdr.all);
+   end Get_Segment_Base;
+
+   procedure Open_File (File : out Elf_File; Filename : String)
+   is
+      function Malloc (Size : Integer) return Address;
+      pragma Import (C, Malloc);
+
+      use GNAT.OS_Lib;
+      Length : Long_Integer;
+      Len : Integer;
+      Fd : File_Descriptor;
+   begin
+      File := (Filename => new String'(Filename),
+               Status => Status_Ok,
+               Length => 0,
+               Base => Null_Address,
+               Ehdr => null,
+               Shdr_Base => Null_Address,
+               Sh_Strtab => (null, 0),
+               Phdr_Base => Null_Address);
+
+      --  Open the file.
+      Fd := Open_Read (Filename, Binary);
+      if Fd = Invalid_FD then
+         File.Status := Status_Open_Failure;
+         return;
+      end if;
+
+      --  Get length.
+      Length := File_Length (Fd);
+      Len := Integer (Length);
+      if Len < Elf_Ehdr_Size then
+         File.Status := Status_Bad_File;
+         Close (Fd);
+         return;
+      end if;
+
+      File.Length := Elf_Off (Len);
+
+      --  Allocate memory for the file.
+      File.Base := Malloc (Len);
+      if File.Base = Null_Address then
+         File.Status := Status_Memory;
+         Close (Fd);
+         return;
+      end if;
+
+      --  Read the whole file.
+      if Read (Fd, File.Base, Integer (Length)) /= Integer (Length) then
+         File.Status := Status_Read_Error;
+         Close (Fd);
+         return;
+      end if;
+
+      Close (Fd);
+
+      File.Ehdr := To_Elf_Ehdr_Acc (File.Base);
+
+      if File.Ehdr.E_Ident (EI_MAG0) /= ELFMAG0
+        or File.Ehdr.E_Ident (EI_MAG1) /= ELFMAG1
+        or File.Ehdr.E_Ident (EI_MAG2) /= ELFMAG2
+        or File.Ehdr.E_Ident (EI_MAG3) /= ELFMAG3
+      then
+         File.Status := Status_Bad_Magic;
+         return;
+      end if;
+
+      if File.Ehdr.E_Ident (EI_CLASS) /= Elf_Arch_Class
+--        or Ehdr.E_Ident (EI_DATA) /= ELFDATA2LSB
+        or File.Ehdr.E_Ident (EI_VERSION) /= EV_CURRENT
+      then
+         File.Status := Status_Bad_Class;
+         return;
+      end if;
+   end Open_File;
+
+   function Get_Status (File : Elf_File) return Elf_File_Status is
+   begin
+      return File.Status;
+   end Get_Status;
+
+   function Get_Ehdr (File : Elf_File) return Elf_Ehdr_Acc is
+   begin
+      return File.Ehdr;
+   end Get_Ehdr;
+
+   function Get_Shdr (File : Elf_File; Index : Elf_Half)
+                     return Elf_Shdr_Acc
+   is
+   begin
+      if Index >= File.Ehdr.E_Shnum then
+         raise Constraint_Error;
+      end if;
+      return To_Elf_Shdr_Acc
+        (File.Shdr_Base
+         + Storage_Offset (Index * Elf_Half (Elf_Shdr_Size)));
+   end Get_Shdr;
+
+   procedure Load_Phdr (File : in out Elf_File)
+   is
+   begin
+      if Get_Ehdr (File).E_Phentsize /= Elf_Half (Elf_Phdr_Size) then
+         return;
+      end if;
+
+      File.Phdr_Base :=
+        Get_Offset (File, Get_Ehdr (File).E_Phoff,
+                    Elf_Size (Get_Ehdr (File).E_Phnum
+                              * Elf_Half (Elf_Phdr_Size)));
+   end Load_Phdr;
+
+   function Get_Phdr (File : Elf_File; Index : Elf_Half)
+                     return Elf_Phdr_Acc
+   is
+   begin
+      if Index >= File.Ehdr.E_Phnum then
+         raise Constraint_Error;
+      end if;
+      return To_Elf_Phdr_Acc
+        (File.Phdr_Base
+         + Storage_Offset (Index * Elf_Half (Elf_Phdr_Size)));
+   end Get_Phdr;
+
+   function Get_Strtab (File : Elf_File; Index : Elf_Half)
+                       return Strtab_Type
+   is
+      Shdr : Elf_Shdr_Acc;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      if Shdr = null or Shdr.Sh_Type /= SHT_STRTAB then
+         return Null_Strtab;
+      end if;
+      return (Base => To_Strtab_Fat_Acc (Get_Section_Base (File, Shdr.all)),
+              Length => Shdr.Sh_Size);
+   end Get_Strtab;
+
+   procedure Load_Shdr (File : in out Elf_File)
+   is
+   begin
+      if Get_Ehdr (File).E_Shentsize /= Elf_Half (Elf_Shdr_Size) then
+         return;
+      end if;
+
+      File.Shdr_Base :=
+        Get_Offset (File, Get_Ehdr (File).E_Shoff,
+                    Elf_Size (Get_Ehdr (File).E_Shnum
+                              * Elf_Half (Elf_Shdr_Size)));
+      File.Sh_Strtab := Get_Strtab (File, Get_Ehdr (File).E_Shstrndx);
+   end Load_Shdr;
+
+   function Get_Sh_Strtab (File : Elf_File) return Strtab_Type is
+   begin
+      return File.Sh_Strtab;
+   end Get_Sh_Strtab;
+
+   function Get_Section_Name (File : Elf_File; Index : Elf_Half)
+                             return String
+   is
+   begin
+      return Get_String (Get_Sh_Strtab (File),
+                         Elf_Size (Get_Shdr (File, Index).Sh_Name));
+   end Get_Section_Name;
+
+   function Get_Section_By_Name (File : Elf_File; Name : String)
+                                return Elf_Half
+   is
+      Ehdr : Elf_Ehdr_Acc;
+      Shdr : Elf_Shdr_Acc;
+      Sh_Strtab : Strtab_Type;
+   begin
+      Ehdr := Get_Ehdr (File);
+      Sh_Strtab := Get_Sh_Strtab (File);
+      for I in 1 .. Ehdr.E_Shnum - 1 loop
+         Shdr := Get_Shdr (File, I);
+         if Get_String (Sh_Strtab, Elf_Size (Shdr.Sh_Name)) = Name then
+            return I;
+         end if;
+      end loop;
+      return 0;
+   end Get_Section_By_Name;
+
+   procedure Disp_Symtab (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      S_Strtab : Strtab_Type;
+      Base : Address;
+      Off : Storage_Offset;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      if Shdr.Sh_Entsize /= Elf_Size (Elf_Sym_Size) then
+         return;
+      end if;
+      S_Strtab := Get_Strtab (File, Elf_Half (Shdr.Sh_Link));
+      Base := Get_Section_Base (File, Shdr.all);
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Disp_Sym (File, To_Elf_Sym_Acc (Base + Off).all, S_Strtab);
+         Off := Off + Storage_Offset (Elf_Sym_Size);
+      end loop;
+   end Disp_Symtab;
+
+   procedure Disp_Strtab (File : Elf_File; Index : Elf_Half)
+   is
+      Strtab : Strtab_Type;
+      S, E : Elf_Size;
+   begin
+      Strtab := Get_Strtab (File, Index);
+      S := 1;
+      while S < Strtab.Length loop
+         E := S;
+         while Strtab.Base (E) /= Nul loop
+            E := E + 1;
+         end loop;
+         Put_Line (Hex_Image (S) & ": "
+                   & String (Strtab.Base (S .. E - 1)));
+         S := E + 1;
+      end loop;
+   end Disp_Strtab;
+
+   function Read_Byte (Addr : Address) return Unsigned_8
+   is
+      type Unsigned_8_Acc is access all Unsigned_8;
+      function To_Unsigned_8_Acc is new Ada.Unchecked_Conversion
+        (Address, Unsigned_8_Acc);
+   begin
+      return To_Unsigned_8_Acc (Addr).all;
+   end Read_Byte;
+
+   procedure Read_ULEB128 (Base : Address;
+                           Off : in out Storage_Offset;
+                           Res : out Unsigned_32)
+   is
+      B : Unsigned_8;
+      Shift : Integer;
+   begin
+      Res := 0;
+      Shift := 0;
+      loop
+         B := Read_Byte (Base + Off);
+         Off := Off + 1;
+         Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift);
+         exit when (B and 16#80#) = 0;
+         Shift := Shift + 7;
+      end loop;
+   end Read_ULEB128;
+
+   procedure Read_SLEB128 (Base : Address;
+                           Off : in out Storage_Offset;
+                           Res : out Unsigned_32)
+   is
+      B : Unsigned_8;
+      Shift : Integer;
+   begin
+      Res := 0;
+      Shift := 0;
+      loop
+         B := Read_Byte (Base + Off);
+         Off := Off + 1;
+         Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift);
+         Shift := Shift + 7;
+         exit when (B and 16#80#) = 0;
+      end loop;
+      if Shift < 32 and (Res and Shift_Left (1, Shift - 1)) /= 0 then
+         Res := Res or Shift_Left (-1, Shift);
+      end if;
+   end Read_SLEB128;
+
+   procedure Read_Word4 (Base : Address;
+                         Off : in out Storage_Offset;
+                         Res : out Unsigned_32)
+   is
+      B0, B1, B2, B3 : Unsigned_8;
+   begin
+      B0 := Read_Byte (Base + Off + 0);
+      B1 := Read_Byte (Base + Off + 1);
+      B2 := Read_Byte (Base + Off + 2);
+      B3 := Read_Byte (Base + Off + 3);
+      Res := Shift_Left (Unsigned_32 (B3), 24)
+        or Shift_Left (Unsigned_32 (B2), 16)
+        or Shift_Left (Unsigned_32 (B1), 8)
+        or Shift_Left (Unsigned_32 (B0), 0);
+      Off := Off + 4;
+   end Read_Word4;
+
+   procedure Read_Word2 (Base : Address;
+                         Off : in out Storage_Offset;
+                         Res : out Unsigned_16)
+   is
+      B0, B1 : Unsigned_8;
+   begin
+      B0 := Read_Byte (Base + Off + 0);
+      B1 := Read_Byte (Base + Off + 1);
+      Res := Shift_Left (Unsigned_16 (B1), 8)
+        or Shift_Left (Unsigned_16 (B0), 0);
+      Off := Off + 2;
+   end Read_Word2;
+
+   procedure Read_Byte (Base : Address;
+                        Off : in out Storage_Offset;
+                        Res : out Unsigned_8)
+   is
+   begin
+      Res := Read_Byte (Base + Off);
+      Off := Off + 1;
+   end Read_Byte;
+
+   procedure Disp_Note (Base : Address; Size : Storage_Offset)
+   is
+      Off : Storage_Offset;
+      Namesz : Unsigned_32;
+      Descsz : Unsigned_32;
+      Ntype : Unsigned_32;
+      B : Unsigned_8;
+      Is_Full : Boolean;
+   begin
+      Off := 0;
+      while Off < Size loop
+         Read_Word4 (Base, Off, Namesz);
+         Read_Word4 (Base, Off, Descsz);
+         Read_Word4 (Base, Off, Ntype);
+         Put ("type : ");
+         Put (Hex_Image (Ntype));
+         New_Line;
+         Put ("name : ");
+         Put (Hex_Image (Namesz));
+         Put ("  ");
+         for I in 1 .. Namesz loop
+            Read_Byte (Base, Off, B);
+            if B /= 0 then
+               Put (Character'Val (B));
+            end if;
+         end loop;
+         if Namesz mod 4 /= 0 then
+            for I in (Namesz mod 4) .. 3 loop
+               Read_Byte (Base, Off, B);
+            end loop;
+         end if;
+         New_Line;
+         Put ("desc : ");
+         Put (Hex_Image (Descsz));
+         Put (" ");
+         Is_Full := Descsz >= 20;
+         for I in 1 .. Descsz loop
+            if Is_Full and (I mod 16) = 1 then
+               New_Line;
+            end if;
+            Read_Byte (Base, Off, B);
+            Put (' ');
+            Put (Hex_Image (B));
+         end loop;
+         if Descsz mod 4 /= 0 then
+            for I in (Descsz mod 4) .. 3 loop
+               Read_Byte (Base, Off, B);
+            end loop;
+         end if;
+         New_Line;
+      end loop;
+   end Disp_Note;
+
+   procedure Disp_Section_Note (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+      Disp_Note (Base, Storage_Offset (Shdr.Sh_Size));
+   end Disp_Section_Note;
+
+   procedure Disp_Segment_Note (File : Elf_File; Index : Elf_Half)
+   is
+      Phdr : Elf_Phdr_Acc;
+      Base : Address;
+   begin
+      Phdr := Get_Phdr (File, Index);
+      Base := Get_Segment_Base (File, Phdr.all);
+      Disp_Note (Base, Storage_Offset (Phdr.P_Filesz));
+   end Disp_Segment_Note;
+
+
+   function Get_Dt_Name (Name : Elf_Word) return String is
+   begin
+      case Name is
+         when DT_NULL =>
+            return "NULL";
+         when DT_NEEDED =>
+            return "NEEDED";
+         when DT_PLTRELSZ =>
+            return "PLTRELSZ";
+         when DT_PLTGOT =>
+            return "PLTGOT";
+         when DT_HASH =>
+            return "HASH";
+         when DT_STRTAB =>
+            return "STRTAB";
+         when DT_SYMTAB =>
+            return "SYMTAB";
+         when DT_RELA =>
+            return "RELA";
+         when DT_RELASZ =>
+            return "RELASZ";
+         when DT_RELAENT =>
+            return "RELAENT";
+         when DT_STRSZ =>
+            return "STRSZ";
+         when DT_SYMENT =>
+            return "SYMENT";
+         when DT_INIT =>
+            return "INIT";
+         when DT_FINI =>
+            return "FINI";
+         when DT_SONAME =>
+            return "SONAME";
+         when DT_RPATH =>
+            return "RPATH";
+         when DT_SYMBOLIC =>
+            return "SYMBOLIC";
+         when DT_REL =>
+            return "REL";
+         when DT_RELSZ =>
+            return "RELSZ";
+         when DT_RELENT =>
+            return "RELENT";
+         when DT_PLTREL =>
+            return "PLTREL";
+         when DT_DEBUG =>
+            return "DEBUG";
+         when DT_TEXTREL =>
+            return "TEXTREL";
+         when DT_JMPREL =>
+            return "JMPREL";
+         when DT_BIND_NOW =>
+            return "BIND_NOW";
+         when DT_INIT_ARRAY =>
+            return "INIT_ARRAY";
+         when DT_FINI_ARRAY =>
+            return "FINI_ARRAY";
+         when DT_INIT_ARRAYSZ =>
+            return "INIT_ARRAYSZ";
+         when DT_FINI_ARRAYSZ =>
+            return "FINI_ARRAYSZ";
+         when DT_RUNPATH =>
+            return "RUNPATH";
+         when DT_FLAGS =>
+            return "FLAGS";
+--           when DT_ENCODING =>
+--              return "ENCODING";
+         when DT_PREINIT_ARRAY =>
+            return "PREINIT_ARRAY";
+         when DT_PREINIT_ARRAYSZ =>
+            return "PREINIT_ARRAYSZ";
+         when DT_NUM =>
+            return "NUM";
+         when DT_LOOS =>
+            return "LOOS";
+--           when DT_HIOS =>
+--              return "HIOS";
+         when DT_LOPROC =>
+            return "LOPROC";
+--           when DT_HIPROC =>
+--              return "HIPROC";
+         when DT_VALRNGLO =>
+            return "VALRNGLO";
+         when DT_GNU_PRELINKED =>
+            return "GNU_PRELINKED";
+         when DT_GNU_CONFLICTSZ =>
+            return "GNU_CONFLICTSZ";
+         when DT_GNU_LIBLISTSZ =>
+            return "GNU_LIBLISTSZ";
+         when DT_CHECKSUM =>
+            return "CHECKSUM";
+         when DT_PLTPADSZ =>
+            return "PLTPADSZ";
+         when DT_MOVEENT =>
+            return "MOVEENT";
+         when DT_MOVESZ =>
+            return "MOVESZ";
+         when DT_FEATURE_1 =>
+            return "FEATURE_1";
+         when DT_POSFLAG_1 =>
+            return "POSFLAG_1";
+         when DT_SYMINSZ =>
+            return "SYMINSZ";
+         when DT_SYMINENT =>
+            return "SYMINENT";
+--           when DT_VALRNGHI =>
+--              return "VALRNGHI";
+         when DT_ADDRRNGLO =>
+            return "ADDRRNGLO";
+         when DT_GNU_CONFLICT =>
+            return "GNU_CONFLICT";
+         when DT_GNU_LIBLIST =>
+            return "GNU_LIBLIST";
+         when DT_CONFIG =>
+            return "CONFIG";
+         when DT_DEPAUDIT =>
+            return "DEPAUDIT";
+         when DT_AUDIT =>
+            return "AUDIT";
+         when DT_PLTPAD =>
+            return "PLTPAD";
+         when DT_MOVETAB =>
+            return "MOVETAB";
+         when DT_SYMINFO =>
+            return "SYMINFO";
+--           when DT_ADDRRNGHI =>
+--              return "ADDRRNGHI";
+         when DT_VERSYM =>
+            return "VERSYM";
+         when DT_RELACOUNT =>
+            return "RELACOUNT";
+         when DT_RELCOUNT =>
+            return "RELCOUNT";
+         when DT_FLAGS_1 =>
+            return "FLAGS_1";
+         when DT_VERDEF =>
+            return "VERDEF";
+         when DT_VERDEFNUM =>
+            return "VERDEFNUM";
+         when DT_VERNEED =>
+            return "VERNEED";
+         when DT_VERNEEDNUM =>
+            return "VERNEEDNUM";
+         when DT_AUXILIARY =>
+            return "AUXILIARY";
+         when DT_FILTER =>
+            return "FILTER";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Dt_Name;
+
+   procedure Disp_Dynamic (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+      Tag : Unsigned_32;
+      Val : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Tag);
+         Read_Word4 (Base, Off, Val);
+         Put ("tag : ");
+         Put (Hex_Image (Tag));
+         Put ("  (");
+         Put (Get_Dt_Name (Tag));
+         Put (")");
+         Set_Col (34);
+         Put ("val : ");
+         Put (Hex_Image (Val));
+         New_Line;
+      end loop;
+   end Disp_Dynamic;
+
+   function Get_Dwarf_Form_Name (Name : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Name is
+         when DW_FORM_Addr =>
+            return "addr";
+         when DW_FORM_Block2 =>
+            return "block2";
+         when DW_FORM_Block4 =>
+            return "block4";
+         when DW_FORM_Data2 =>
+            return "data2";
+         when DW_FORM_Data4 =>
+            return "data4";
+         when DW_FORM_Data8 =>
+            return "data8";
+         when DW_FORM_String =>
+            return "string";
+         when DW_FORM_Block =>
+            return "block";
+         when DW_FORM_Block1 =>
+            return "block1";
+         when DW_FORM_Data1 =>
+            return "data1";
+         when DW_FORM_Flag =>
+            return "flag";
+         when DW_FORM_Sdata =>
+            return "sdata";
+         when DW_FORM_Strp =>
+            return "strp";
+         when DW_FORM_Udata =>
+            return "udata";
+         when DW_FORM_Ref_Addr =>
+            return "ref_addr";
+         when DW_FORM_Ref1 =>
+            return "ref1";
+         when DW_FORM_Ref2 =>
+            return "ref2";
+         when DW_FORM_Ref4 =>
+            return "ref4";
+         when DW_FORM_Ref8 =>
+            return "ref8";
+         when DW_FORM_Ref_Udata =>
+            return "ref_udata";
+         when DW_FORM_Indirect =>
+            return "indirect";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_Form_Name;
+
+   function Get_Dwarf_Tag_Name (Tag : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Tag is
+         when DW_TAG_Array_Type =>
+            return "array_type";
+         when DW_TAG_Class_Type =>
+            return "class_type";
+         when DW_TAG_Entry_Point =>
+            return "entry_point";
+         when DW_TAG_Enumeration_Type =>
+            return "enumeration_type";
+         when DW_TAG_Formal_Parameter =>
+            return "formal_parameter";
+         when DW_TAG_Imported_Declaration =>
+            return "imported_declaration";
+         when DW_TAG_Label =>
+            return "label";
+         when DW_TAG_Lexical_Block =>
+            return "lexical_block";
+         when DW_TAG_Member =>
+            return "member";
+         when DW_TAG_Pointer_Type =>
+            return "pointer_type";
+         when DW_TAG_Reference_Type =>
+            return "reference_type";
+         when DW_TAG_Compile_Unit =>
+            return "compile_unit";
+         when DW_TAG_String_Type =>
+            return "string_type";
+         when DW_TAG_Structure_Type =>
+            return "structure_type";
+         when DW_TAG_Subroutine_Type =>
+            return "subroutine_type";
+         when DW_TAG_Typedef =>
+            return "typedef";
+         when DW_TAG_Union_Type =>
+            return "union_type";
+         when DW_TAG_Unspecified_Parameters =>
+            return "unspecified_parameters";
+         when DW_TAG_Variant =>
+            return "variant";
+         when DW_TAG_Common_Block =>
+            return "common_block";
+         when DW_TAG_Common_Inclusion =>
+            return "common_inclusion";
+         when DW_TAG_Inheritance =>
+            return "inheritance";
+         when DW_TAG_Inlined_Subroutine =>
+            return "inlined_subroutine";
+         when DW_TAG_Module =>
+            return "module";
+         when DW_TAG_Ptr_To_Member_Type =>
+            return "ptr_to_member_type";
+         when DW_TAG_Set_Type =>
+            return "set_type";
+         when DW_TAG_Subrange_Type =>
+            return "subrange_type";
+         when DW_TAG_With_Stmt =>
+            return "with_stmt";
+         when DW_TAG_Access_Declaration =>
+            return "access_declaration";
+         when DW_TAG_Base_Type =>
+            return "base_type";
+         when DW_TAG_Catch_Block =>
+            return "catch_block";
+         when DW_TAG_Const_Type =>
+            return "const_type";
+         when DW_TAG_Constant =>
+            return "constant";
+         when DW_TAG_Enumerator =>
+            return "enumerator";
+         when DW_TAG_File_Type =>
+            return "file_type";
+         when DW_TAG_Friend =>
+            return "friend";
+         when DW_TAG_Namelist =>
+            return "namelist";
+         when DW_TAG_Namelist_Item =>
+            return "namelist_item";
+         when DW_TAG_Packed_Type =>
+            return "packed_type";
+         when DW_TAG_Subprogram =>
+            return "subprogram";
+         when DW_TAG_Template_Type_Parameter =>
+            return "template_type_parameter";
+         when DW_TAG_Template_Value_Parameter =>
+            return "template_value_parameter";
+         when DW_TAG_Thrown_Type =>
+            return "thrown_type";
+         when DW_TAG_Try_Block =>
+            return "try_block";
+         when DW_TAG_Variant_Part =>
+            return "variant_part";
+         when DW_TAG_Variable =>
+            return "variable";
+         when DW_TAG_Volatile_Type =>
+            return "volatile_type";
+         when DW_TAG_Dwarf_Procedure =>
+            return "dwarf_procedure";
+         when DW_TAG_Restrict_Type =>
+            return "restrict_type";
+         when DW_TAG_Interface_Type =>
+            return "interface_type";
+         when DW_TAG_Namespace =>
+            return "namespace";
+         when DW_TAG_Imported_Module =>
+            return "imported_module";
+         when DW_TAG_Unspecified_Type =>
+            return "unspecified_type";
+         when DW_TAG_Partial_Unit =>
+            return "partial_unit";
+         when DW_TAG_Imported_Unit =>
+            return "imported_unit";
+         when DW_TAG_Mutable_Type =>
+            return "mutable_type";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_Tag_Name;
+
+   function Get_Dwarf_At_Name (Attr : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Attr is
+         when DW_AT_Sibling =>
+            return "sibling";
+         when DW_AT_Location =>
+            return "location";
+         when DW_AT_Name =>
+            return "name";
+         when DW_AT_Ordering =>
+            return "ordering";
+         when DW_AT_Byte_Size =>
+            return "byte_size";
+         when DW_AT_Bit_Offset =>
+            return "bit_offset";
+         when DW_AT_Bit_Size =>
+            return "bit_size";
+         when DW_AT_Stmt_List =>
+            return "stmt_list";
+         when DW_AT_Low_Pc =>
+            return "low_pc";
+         when DW_AT_High_Pc =>
+            return "high_pc";
+         when DW_AT_Language =>
+            return "language";
+         when DW_AT_Discr =>
+            return "discr";
+         when DW_AT_Discr_Value =>
+            return "discr_value";
+         when DW_AT_Visibility =>
+            return "visibility";
+         when DW_AT_Import =>
+            return "import";
+         when DW_AT_String_Length =>
+            return "string_length";
+         when DW_AT_Common_Reference =>
+            return "common_reference";
+         when DW_AT_Comp_Dir =>
+            return "comp_dir";
+         when DW_AT_Const_Value =>
+            return "const_value";
+         when DW_AT_Containing_Type =>
+            return "containing_type";
+         when DW_AT_Default_Value =>
+            return "default_value";
+         when DW_AT_Inline =>
+            return "inline";
+         when DW_AT_Is_Optional =>
+            return "is_optional";
+         when DW_AT_Lower_Bound =>
+            return "lower_bound";
+         when DW_AT_Producer =>
+            return "producer";
+         when DW_AT_Prototyped =>
+            return "prototyped";
+         when DW_AT_Return_Addr =>
+            return "return_addr";
+         when DW_AT_Start_Scope =>
+            return "start_scope";
+         when DW_AT_Stride_Size =>
+            return "stride_size";
+         when DW_AT_Upper_Bound =>
+            return "upper_bound";
+         when DW_AT_Abstract_Origin =>
+            return "abstract_origin";
+         when DW_AT_Accessibility =>
+            return "accessibility";
+         when DW_AT_Address_Class =>
+            return "address_class";
+         when DW_AT_Artificial =>
+            return "artificial";
+         when DW_AT_Base_Types =>
+            return "base_types";
+         when DW_AT_Calling_Convention =>
+            return "calling_convention";
+         when DW_AT_Count =>
+            return "count";
+         when DW_AT_Data_Member_Location =>
+            return "data_member_location";
+         when DW_AT_Decl_Column =>
+            return "decl_column";
+         when DW_AT_Decl_File =>
+            return "decl_file";
+         when DW_AT_Decl_Line =>
+            return "decl_line";
+         when DW_AT_Declaration =>
+            return "declaration";
+         when DW_AT_Discr_List =>
+            return "discr_list";
+         when DW_AT_Encoding =>
+            return "encoding";
+         when DW_AT_External =>
+            return "external";
+         when DW_AT_Frame_Base =>
+            return "frame_base";
+         when DW_AT_Friend =>
+            return "friend";
+         when DW_AT_Identifier_Case =>
+            return "identifier_case";
+         when DW_AT_Macro_Info =>
+            return "macro_info";
+         when DW_AT_Namelist_Item =>
+            return "namelist_item";
+         when DW_AT_Priority =>
+            return "priority";
+         when DW_AT_Segment =>
+            return "segment";
+         when DW_AT_Specification =>
+            return "specification";
+         when DW_AT_Static_Link =>
+            return "static_link";
+         when DW_AT_Type =>
+            return "type";
+         when DW_AT_Use_Location =>
+            return "use_location";
+         when DW_AT_Variable_Parameter =>
+            return "variable_parameter";
+         when DW_AT_Virtuality =>
+            return "virtuality";
+         when DW_AT_Vtable_Elem_Location =>
+            return "vtable_elem_location";
+         when DW_AT_Allocated =>
+            return "allocated";
+         when DW_AT_Associated =>
+            return "associated";
+         when DW_AT_Data_Location =>
+            return "data_location";
+         when DW_AT_Stride =>
+            return "stride";
+         when DW_AT_Entry_Pc =>
+            return "entry_pc";
+         when DW_AT_Use_UTF8 =>
+            return "use_utf8";
+         when DW_AT_Extension =>
+            return "extension";
+         when DW_AT_Ranges =>
+            return "ranges";
+         when DW_AT_Trampoline =>
+            return "trampoline";
+         when DW_AT_Call_Column =>
+            return "call_column";
+         when DW_AT_Call_File =>
+            return "call_file";
+         when DW_AT_Call_Line =>
+            return "call_line";
+         when DW_AT_Description =>
+            return "description";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_At_Name;
+
+   procedure Disp_Debug_Abbrev (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Old_Off : Storage_Offset;
+      Off : Storage_Offset;
+      V : Unsigned_32;
+      Tag : Unsigned_32;
+      Name : Unsigned_32;
+      Form : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Old_Off := Off;
+         Read_ULEB128 (Base, Off, V);
+         Put_Line ("abbrev #" & Hex_Image (V) & " at "
+                   & Hex_Image (Unsigned_32 (Old_Off)) & ':');
+         if V = 0 then
+            Put_Line ("pad");
+            goto Again;
+         end if;
+         Read_ULEB128 (Base, Off, Tag);
+         Put (" tag: " & Hex_Image (Tag));
+         Put (" (");
+         Put (Get_Dwarf_Tag_Name (Tag));
+         Put ("),  children: " & Hex_Image (Read_Byte (Base + Off)));
+         New_Line;
+         Off := Off + 1;
+         loop
+            Read_ULEB128 (Base, Off, Name);
+            Read_ULEB128 (Base, Off, Form);
+            Put ("   name: " & Hex_Image (Name));
+            Put (" (");
+            Put (Get_Dwarf_At_Name (Name));
+            Put (")");
+            Set_Col (42);
+            Put ("form: " & Hex_Image (Form));
+            Put (" (");
+            Put (Get_Dwarf_Form_Name (Form));
+            Put (")");
+            New_Line;
+            exit when Name = 0 and Form = 0;
+         end loop;
+         << Again >> null;
+      end loop;
+   end Disp_Debug_Abbrev;
+
+   type Abbrev_Map_Type is array (Unsigned_32 range <>) of Address;
+   type Abbrev_Map_Acc is access Abbrev_Map_Type;
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Abbrev_Map_Type, Abbrev_Map_Acc);
+
+   procedure Build_Abbrev_Map (Base : Address; Res : out Abbrev_Map_Acc)
+   is
+      Max : Unsigned_32;
+      Off : Storage_Offset;
+      V : Unsigned_32;
+      V1 : Unsigned_32;
+      N_Res : Abbrev_Map_Acc;
+   begin
+      Off := 0;
+      Max := 0;
+      Res := new Abbrev_Map_Type (0 .. 128);
+      Res.all := (others => Null_Address);
+      loop
+         Read_ULEB128 (Base, Off, V);
+         if V > Max then
+            Max := V;
+         end if;
+         exit when V = 0;
+         if Max > Res.all'Last then
+            N_Res := new Abbrev_Map_Type (0 .. 2 * Max);
+            N_Res (Res'Range) := Res.all;
+            N_Res (Res'Last + 1 .. N_Res'Last) := (others => Null_Address);
+            Unchecked_Deallocation (Res);
+            Res := N_Res;
+         end if;
+         if Res (V) /= Null_Address then
+            Put_Line ("!! abbrev override !!");
+            return;
+         end if;
+         Res (V) := Base + Off;
+         Read_ULEB128 (Base, Off, V);
+         --  Skip child flag.
+         Off := Off + 1;
+         loop
+            Read_ULEB128 (Base, Off, V);
+            Read_ULEB128 (Base, Off, V1);
+            exit when V = 0 and V1 = 0;
+         end loop;
+      end loop;
+   end Build_Abbrev_Map;
+
+   procedure Disp_Block (Base : Address;
+                         Off : in out Storage_Offset;
+                         Cnt : Unsigned_32)
+   is
+   begin
+      for I in 1 .. Cnt loop
+         Put (" ");
+         Put (Hex_Image (Read_Byte (Base + Off + Storage_Offset (I - 1))));
+      end loop;
+      Off := Off + Storage_Offset (Cnt);
+   end Disp_Block;
+
+   procedure Disp_Dwarf_Form (Base : Address;
+                              Off : in out Storage_Offset;
+                              Form : Unsigned_32)
+   is
+      use Dwarf;
+   begin
+      case Form is
+         when DW_FORM_Addr =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Put ("address: " & Hex_Image (V));
+            end;
+         when DW_FORM_Flag =>
+            declare
+               V : Unsigned_8;
+            begin
+               Read_Byte (Base, Off, V);
+               Put ("flag: " & Hex_Image (V));
+            end;
+         when DW_FORM_Block1 =>
+            declare
+               V : Unsigned_8;
+            begin
+               Read_Byte (Base, Off, V);
+               Put ("block1: " & Hex_Image (V));
+               Disp_Block (Base, Off, Unsigned_32 (V));
+            end;
+         when DW_FORM_Data1 =>
+            declare
+               V : Unsigned_8;
+            begin
+               Read_Byte (Base, Off, V);
+               Put ("data1: " & Hex_Image (V));
+            end;
+         when DW_FORM_Data2 =>
+            declare
+               V : Unsigned_16;
+            begin
+               Read_Word2 (Base, Off, V);
+               Put ("data2: " & Hex_Image (V));
+            end;
+         when DW_FORM_Data4 =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Put ("data4: " & Hex_Image (V));
+            end;
+         when DW_FORM_Sdata =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_SLEB128 (Base, Off, V);
+               Put ("sdata: " & Hex_Image (V));
+            end;
+         when DW_FORM_Udata =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_ULEB128 (Base, Off, V);
+               Put ("udata: " & Hex_Image (V));
+            end;
+         when DW_FORM_Ref4 =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Put ("ref4: " & Hex_Image (V));
+            end;
+         when DW_FORM_Strp =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Put ("strp: " & Hex_Image (V));
+            end;
+         when DW_FORM_String =>
+            declare
+               C : Unsigned_8;
+            begin
+               Put ("string: ");
+               loop
+                  Read_Byte (Base, Off, C);
+                  exit when C = 0;
+                  Put (Character'Val (C));
+               end loop;
+            end;
+         when others =>
+            Put ("???");
+            raise Program_Error;
+      end case;
+   end Disp_Dwarf_Form;
+
+   function Get_Dwarf_ATE_Name (Val : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Val is
+         when DW_ATE_Address =>
+            return "address";
+         when DW_ATE_Boolean =>
+            return "boolean";
+         when DW_ATE_Complex_Float =>
+            return "complex_float";
+         when DW_ATE_Float =>
+            return "float";
+         when DW_ATE_Signed =>
+            return "signed";
+         when DW_ATE_Signed_Char =>
+            return "signed_char";
+         when DW_ATE_Unsigned =>
+            return "unsigned";
+         when DW_ATE_Unsigned_Char =>
+            return "unsigned_char";
+         when DW_ATE_Imaginary_Float =>
+            return "imaginary_float";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_ATE_Name;
+
+   procedure Read_Dwarf_Constant (Base : Address;
+                                  Off : in out Storage_Offset;
+                                  Form : Unsigned_32;
+                                  Res : out Unsigned_32)
+   is
+      use Dwarf;
+   begin
+      case Form is
+         when DW_FORM_Data1 =>
+            declare
+               V : Unsigned_8;
+            begin
+               Read_Byte (Base, Off, V);
+               Res := Unsigned_32 (V);
+            end;
+         when DW_FORM_Data2 =>
+            declare
+               V : Unsigned_16;
+            begin
+               Read_Word2 (Base, Off, V);
+               Res := Unsigned_32 (V);
+            end;
+         when DW_FORM_Data4 =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Res := V;
+            end;
+         when DW_FORM_Sdata =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_SLEB128 (Base, Off, V);
+               Res := V;
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Read_Dwarf_Constant;
+
+   procedure Disp_Dwarf_Encoding
+     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
+   is
+      Val : Unsigned_32;
+   begin
+      Read_Dwarf_Constant (Base, Off, Form, Val);
+      Put (Get_Dwarf_ATE_Name (Val));
+   end Disp_Dwarf_Encoding;
+
+   function Get_Dwarf_Lang_Name (Lang : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Lang is
+         when DW_LANG_C89 =>
+            return "C89";
+         when DW_LANG_C =>
+            return "C";
+         when DW_LANG_Ada83 =>
+            return "Ada83";
+         when DW_LANG_C_Plus_Plus =>
+            return "C_Plus_Plus";
+         when DW_LANG_Cobol74 =>
+            return "Cobol74";
+         when DW_LANG_Cobol85 =>
+            return "Cobol85";
+         when DW_LANG_Fortran77 =>
+            return "Fortran77";
+         when DW_LANG_Fortran90 =>
+            return "Fortran90";
+         when DW_LANG_Pascal83 =>
+            return "Pascal83";
+         when DW_LANG_Modula2 =>
+            return "Modula2";
+         when DW_LANG_Java =>
+            return "Java";
+         when DW_LANG_C99 =>
+            return "C99";
+         when DW_LANG_Ada95 =>
+            return "Ada95";
+         when DW_LANG_Fortran95 =>
+            return "Fortran95";
+         when DW_LANG_PLI =>
+            return "PLI";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Dwarf_Lang_Name;
+
+   procedure Disp_Dwarf_Language
+     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
+   is
+      Val : Unsigned_32;
+   begin
+      Read_Dwarf_Constant (Base, Off, Form, Val);
+      Put (Get_Dwarf_Lang_Name (Val));
+   end Disp_Dwarf_Language;
+
+   function Get_Dwarf_Op_Name (Op : Unsigned_8) return String
+   is
+      use Dwarf;
+   begin
+      case Op is
+         when DW_OP_Addr =>
+            return "addr";
+         when DW_OP_Deref =>
+            return "deref";
+         when DW_OP_Const1u =>
+            return "const1u";
+         when DW_OP_Const1s =>
+            return "const1s";
+         when DW_OP_Const2u =>
+            return "const2u";
+         when DW_OP_Const2s =>
+            return "const2s";
+         when DW_OP_Const4u =>
+            return "const4u";
+         when DW_OP_Const4s =>
+            return "const4s";
+         when DW_OP_Const8u =>
+            return "const8u";
+         when DW_OP_Const8s =>
+            return "const8s";
+         when DW_OP_Constu =>
+            return "constu";
+         when DW_OP_Consts =>
+            return "consts";
+         when DW_OP_Dup =>
+            return "dup";
+         when DW_OP_Drop =>
+            return "drop";
+         when DW_OP_Over =>
+            return "over";
+         when DW_OP_Pick =>
+            return "pick";
+         when DW_OP_Swap =>
+            return "swap";
+         when DW_OP_Rot =>
+            return "rot";
+         when DW_OP_Xderef =>
+            return "xderef";
+         when DW_OP_Abs =>
+            return "abs";
+         when DW_OP_And =>
+            return "and";
+         when DW_OP_Div =>
+            return "div";
+         when DW_OP_Minus =>
+            return "minus";
+         when DW_OP_Mod =>
+            return "mod";
+         when DW_OP_Mul =>
+            return "mul";
+         when DW_OP_Neg =>
+            return "neg";
+         when DW_OP_Not =>
+            return "not";
+         when DW_OP_Or =>
+            return "or";
+         when DW_OP_Plus =>
+            return "plus";
+         when DW_OP_Plus_Uconst =>
+            return "plus_uconst";
+         when DW_OP_Shl =>
+            return "shl";
+         when DW_OP_Shr =>
+            return "shr";
+         when DW_OP_Shra =>
+            return "shra";
+         when DW_OP_Xor =>
+            return "xor";
+         when DW_OP_Skip =>
+            return "skip";
+         when DW_OP_Bra =>
+            return "bra";
+         when DW_OP_Eq =>
+            return "eq";
+         when DW_OP_Ge =>
+            return "ge";
+         when DW_OP_Gt =>
+            return "gt";
+         when DW_OP_Le =>
+            return "le";
+         when DW_OP_Lt =>
+            return "lt";
+         when DW_OP_Ne =>
+            return "ne";
+         when DW_OP_Lit0 =>
+            return "lit0";
+         when DW_OP_Lit1 =>
+            return "lit1";
+         when DW_OP_Lit2 =>
+            return "lit2";
+         when DW_OP_Lit3 =>
+            return "lit3";
+         when DW_OP_Lit4 =>
+            return "lit4";
+         when DW_OP_Lit5 =>
+            return "lit5";
+         when DW_OP_Lit6 =>
+            return "lit6";
+         when DW_OP_Lit7 =>
+            return "lit7";
+         when DW_OP_Lit8 =>
+            return "lit8";
+         when DW_OP_Lit9 =>
+            return "lit9";
+         when DW_OP_Lit10 =>
+            return "lit10";
+         when DW_OP_Lit11 =>
+            return "lit11";
+         when DW_OP_Lit12 =>
+            return "lit12";
+         when DW_OP_Lit13 =>
+            return "lit13";
+         when DW_OP_Lit14 =>
+            return "lit14";
+         when DW_OP_Lit15 =>
+            return "lit15";
+         when DW_OP_Lit16 =>
+            return "lit16";
+         when DW_OP_Lit17 =>
+            return "lit17";
+         when DW_OP_Lit18 =>
+            return "lit18";
+         when DW_OP_Lit19 =>
+            return "lit19";
+         when DW_OP_Lit20 =>
+            return "lit20";
+         when DW_OP_Lit21 =>
+            return "lit21";
+         when DW_OP_Lit22 =>
+            return "lit22";
+         when DW_OP_Lit23 =>
+            return "lit23";
+         when DW_OP_Lit24 =>
+            return "lit24";
+         when DW_OP_Lit25 =>
+            return "lit25";
+         when DW_OP_Lit26 =>
+            return "lit26";
+         when DW_OP_Lit27 =>
+            return "lit27";
+         when DW_OP_Lit28 =>
+            return "lit28";
+         when DW_OP_Lit29 =>
+            return "lit29";
+         when DW_OP_Lit30 =>
+            return "lit30";
+         when DW_OP_Lit31 =>
+            return "lit31";
+         when DW_OP_Reg0 =>
+            return "reg0";
+         when DW_OP_Reg1 =>
+            return "reg1";
+         when DW_OP_Reg2 =>
+            return "reg2";
+         when DW_OP_Reg3 =>
+            return "reg3";
+         when DW_OP_Reg4 =>
+            return "reg4";
+         when DW_OP_Reg5 =>
+            return "reg5";
+         when DW_OP_Reg6 =>
+            return "reg6";
+         when DW_OP_Reg7 =>
+            return "reg7";
+         when DW_OP_Reg8 =>
+            return "reg8";
+         when DW_OP_Reg9 =>
+            return "reg9";
+         when DW_OP_Reg10 =>
+            return "reg10";
+         when DW_OP_Reg11 =>
+            return "reg11";
+         when DW_OP_Reg12 =>
+            return "reg12";
+         when DW_OP_Reg13 =>
+            return "reg13";
+         when DW_OP_Reg14 =>
+            return "reg14";
+         when DW_OP_Reg15 =>
+            return "reg15";
+         when DW_OP_Reg16 =>
+            return "reg16";
+         when DW_OP_Reg17 =>
+            return "reg17";
+         when DW_OP_Reg18 =>
+            return "reg18";
+         when DW_OP_Reg19 =>
+            return "reg19";
+         when DW_OP_Reg20 =>
+            return "reg20";
+         when DW_OP_Reg21 =>
+            return "reg21";
+         when DW_OP_Reg22 =>
+            return "reg22";
+         when DW_OP_Reg23 =>
+            return "reg23";
+         when DW_OP_Reg24 =>
+            return "reg24";
+         when DW_OP_Reg25 =>
+            return "reg25";
+         when DW_OP_Reg26 =>
+            return "reg26";
+         when DW_OP_Reg27 =>
+            return "reg27";
+         when DW_OP_Reg28 =>
+            return "reg28";
+         when DW_OP_Reg29 =>
+            return "reg29";
+         when DW_OP_Reg30 =>
+            return "reg30";
+         when DW_OP_Reg31 =>
+            return "reg31";
+         when DW_OP_Breg0 =>
+            return "breg0";
+         when DW_OP_Breg1 =>
+            return "breg1";
+         when DW_OP_Breg2 =>
+            return "breg2";
+         when DW_OP_Breg3 =>
+            return "breg3";
+         when DW_OP_Breg4 =>
+            return "breg4";
+         when DW_OP_Breg5 =>
+            return "breg5";
+         when DW_OP_Breg6 =>
+            return "breg6";
+         when DW_OP_Breg7 =>
+            return "breg7";
+         when DW_OP_Breg8 =>
+            return "breg8";
+         when DW_OP_Breg9 =>
+            return "breg9";
+         when DW_OP_Breg10 =>
+            return "breg10";
+         when DW_OP_Breg11 =>
+            return "breg11";
+         when DW_OP_Breg12 =>
+            return "breg12";
+         when DW_OP_Breg13 =>
+            return "breg13";
+         when DW_OP_Breg14 =>
+            return "breg14";
+         when DW_OP_Breg15 =>
+            return "breg15";
+         when DW_OP_Breg16 =>
+            return "breg16";
+         when DW_OP_Breg17 =>
+            return "breg17";
+         when DW_OP_Breg18 =>
+            return "breg18";
+         when DW_OP_Breg19 =>
+            return "breg19";
+         when DW_OP_Breg20 =>
+            return "breg20";
+         when DW_OP_Breg21 =>
+            return "breg21";
+         when DW_OP_Breg22 =>
+            return "breg22";
+         when DW_OP_Breg23 =>
+            return "breg23";
+         when DW_OP_Breg24 =>
+            return "breg24";
+         when DW_OP_Breg25 =>
+            return "breg25";
+         when DW_OP_Breg26 =>
+            return "breg26";
+         when DW_OP_Breg27 =>
+            return "breg27";
+         when DW_OP_Breg28 =>
+            return "breg28";
+         when DW_OP_Breg29 =>
+            return "breg29";
+         when DW_OP_Breg30 =>
+            return "breg30";
+         when DW_OP_Breg31 =>
+            return "breg31";
+         when DW_OP_Regx =>
+            return "regx";
+         when DW_OP_Fbreg =>
+            return "fbreg";
+         when DW_OP_Bregx =>
+            return "bregx";
+         when DW_OP_Piece =>
+            return "piece";
+         when DW_OP_Deref_Size =>
+            return "deref_size";
+         when DW_OP_Xderef_Size =>
+            return "xderef_size";
+         when DW_OP_Nop =>
+            return "nop";
+         when DW_OP_Push_Object_Address =>
+            return "push_object_address";
+         when DW_OP_Call2 =>
+            return "call2";
+         when DW_OP_Call4 =>
+            return "call4";
+         when DW_OP_Call_Ref =>
+            return "call_ref";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_Op_Name;
+
+   procedure Read_Dwarf_Block (Base : Address;
+                               Off : in out Storage_Offset;
+                               Form : Unsigned_32;
+                               B : out Address;
+                               L : out Unsigned_32)
+   is
+      use Dwarf;
+   begin
+      case Form is
+         when DW_FORM_Block1 =>
+            B := Base + Off + 1;
+            L := Unsigned_32 (Read_Byte (Base + Off));
+            Off := Off + 1;
+         when others =>
+            raise Program_Error;
+      end case;
+      Off := Off + Storage_Offset (L);
+   end Read_Dwarf_Block;
+
+   procedure Disp_Dwarf_Location
+     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
+   is
+      use Dwarf;
+      B : Address;
+      L : Unsigned_32;
+      Op : Unsigned_8;
+      Boff : Storage_Offset;
+      Is_Full : Boolean;
+   begin
+      Read_Dwarf_Block (Base, Off, Form, B, L);
+      if L = 0 then
+         return;
+      end if;
+      Is_Full := L > 6;
+      Boff := 0;
+      while Boff < Storage_Offset (L) loop
+         if Is_Full then
+            New_Line;
+            Put ("   ");
+            Put (Hex_Image (Unsigned_32 (Boff)));
+            Put (": ");
+         end if;
+         Op := Read_Byte (B + Boff);
+         Put (' ');
+         Put (Get_Dwarf_Op_Name (Op));
+         Boff := Boff + 1;
+         case Op is
+            when DW_OP_Addr =>
+               declare
+                  V : Unsigned_32;
+               begin
+                  Read_Word4 (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+               end;
+            when DW_OP_Deref =>
+               null;
+            when DW_OP_Const1u
+              | DW_OP_Const1s =>
+               declare
+                  V : Unsigned_8;
+               begin
+                  Read_Byte (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+               end;
+--     DW_OP_Const2u     : constant := 16#0a#; -- 1 2-byte constant
+--     DW_OP_Const2s     : constant := 16#0b#; -- 1 2-byte constant
+--     DW_OP_Const4u     : constant := 16#0c#; -- 1 4-byte constant
+--     DW_OP_Const4s     : constant := 16#0d#; -- 1 4-byte constant
+--     DW_OP_Const8u     : constant := 16#0e#; -- 1 8-byte constant
+--     DW_OP_Const8s     : constant := 16#0f#; -- 1 8-byte constant
+--     DW_OP_Constu      : constant := 16#10#; -- 1 ULEB128 constant
+--     DW_OP_Consts      : constant := 16#11#; -- 1 SLEB128 constant
+--     DW_OP_Dup         : constant := 16#12#; -- 0
+--     DW_OP_Drop        : constant := 16#13#; -- 0
+--     DW_OP_Over        : constant := 16#14#; -- 0
+--     DW_OP_Pick        : constant := 16#15#; -- 1 1-byte stack index
+
+            when DW_OP_Swap
+              | DW_OP_Rot
+              | DW_OP_Xderef
+              | DW_OP_Abs
+              | DW_OP_And
+              | DW_OP_Div
+              | DW_OP_Minus
+              | DW_OP_Mod
+              | DW_OP_Mul
+              | DW_OP_Neg
+              | DW_OP_Not
+              | DW_OP_Or
+              | DW_OP_Plus =>
+               null;
+            when DW_OP_Plus_Uconst
+              | DW_OP_Piece
+              | DW_OP_Regx =>
+               declare
+                  V : Unsigned_32;
+               begin
+                  Read_ULEB128 (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+               end;
+            when DW_OP_Shl
+              | DW_OP_Shr
+              | DW_OP_Shra
+              | DW_OP_Xor =>
+               null;
+            when DW_OP_Skip
+              | DW_OP_Bra =>
+               declare
+                  V : Unsigned_16;
+               begin
+                  Read_Word2 (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+                  Put (" (@");
+                  --  FIXME: signed
+                  Put (Hex_Image (Unsigned_32 (Boff) + Unsigned_32 (V)));
+                  Put (")");
+               end;
+            when DW_OP_Eq
+              | DW_OP_Ge
+              | DW_OP_Gt
+              | DW_OP_Le
+              | DW_OP_Lt
+              | DW_OP_Ne =>
+               null;
+            when DW_OP_Lit0 .. DW_OP_Lit31 =>
+               null;
+            when DW_OP_Reg0 .. DW_OP_Reg31 =>
+               null;
+            when DW_OP_Breg0 .. DW_OP_Breg31
+              | DW_OP_Fbreg =>
+               declare
+                  V : Unsigned_32;
+               begin
+                  Read_SLEB128 (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+               end;
+
+--   DW_OP_Regx        : constant := 16#90#; -- 1 ULEB128 register
+--   DW_OP_Bregx       : constant := 16#92#; -- 2 ULEB128 reg + SLEB128 offset
+--   DW_OP_Deref_Size  : constant := 16#94#; -- 1 1-byte size of data retrieved
+--   DW_OP_Xderef_Size : constant := 16#95#; -- 1 1-byte size of data retrieved
+            when DW_OP_Nop =>
+               null;
+--     DW_OP_Push_Object_Address : constant := 16#97#; -- 0
+--     DW_OP_Call2       : constant := 16#98#; -- 1 2-byte offset of DIE
+--     DW_OP_Call4       : constant := 16#99#; -- 1 4-byte offset of DIE
+--     DW_OP_Call_Ref    : constant := 16#9a#; -- 1 4- or 8-byte offset of DIE
+            when others =>
+               raise Program_Error;
+         end case;
+      end loop;
+   end Disp_Dwarf_Location;
+
+   procedure Disp_Debug_Info (File : Elf_File; Index : Elf_Half)
+   is
+      use Dwarf;
+
+      Abbrev_Index : Elf_Half;
+      Abbrev_Base : Address;
+      Map : Abbrev_Map_Acc;
+      Abbrev : Address;
+
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+      Aoff : Storage_Offset;
+      Old_Off : Storage_Offset;
+
+      Len : Unsigned_32;
+      Ver : Unsigned_16;
+      Abbrev_Off : Unsigned_32;
+      Ptr_Sz : Unsigned_8;
+      Last : Storage_Offset;
+      Num : Unsigned_32;
+
+      Tag : Unsigned_32;
+      Name : Unsigned_32;
+      Form : Unsigned_32;
+
+      Level : Unsigned_8;
+   begin
+      Abbrev_Index := Get_Section_By_Name (File, ".debug_abbrev");
+      Abbrev_Base := Get_Section_Base (File, Abbrev_Index);
+      Map := null;
+
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Put_Line ("Compilation unit at #"
+                   & Hex_Image (Unsigned_32 (Off)) & ":");
+         Read_Word4 (Base, Off, Len);
+         Last := Off + Storage_Offset (Len);
+         Read_Word2 (Base, Off, Ver);
+         Read_Word4 (Base, Off, Abbrev_Off);
+         Read_Byte (Base, Off, Ptr_Sz);
+         Put (' ');
+         Put ("length: " & Hex_Image (Len));
+         Put (", version: " & Hex_Image (Ver));
+         Put (", abbrev offset: " & Hex_Image (Abbrev_Off));
+         Put (", ptr_sz: " & Hex_Image (Ptr_Sz));
+         New_Line;
+         Level := 0;
+
+         Build_Abbrev_Map (Abbrev_Base + Storage_Offset (Abbrev_Off), Map);
+         loop
+            << Again >> null;
+            exit when Off >= Last;
+            Old_Off := Off;
+            Read_ULEB128 (Base, Off, Num);
+            Put ("<" & Hex_Image (Unsigned_32 (Old_Off)) & ">");
+            Put ("<" & Hex_Image (Level) & ">");
+            Put (" with abbrev #" & Hex_Image (Num));
+            if Num = 0 then
+               Level := Level - 1;
+               New_Line;
+               goto Again;
+            end if;
+            if Num <= Map.all'Last then
+               Abbrev := Map (Num);
+            else
+               Abbrev := Null_Address;
+            end if;
+            if Abbrev = Null_Address then
+               New_Line;
+               Put ("!! abbrev #" & Hex_Image (Num) & " does not exist !!");
+               New_Line;
+               return;
+            end if;
+            Aoff := 0;
+            Read_ULEB128 (Abbrev, Aoff, Tag);
+            if Read_Byte (Abbrev + Aoff) /= 0 then
+               Put (" [has_child]");
+               Level := Level + 1;
+            end if;
+            New_Line;
+
+            --  skip child.
+            Aoff := Aoff + 1;
+            Put (" tag: " & Hex_Image (Tag));
+            Put (" (");
+            Put (Get_Dwarf_Tag_Name (Tag));
+            Put (")");
+            New_Line;
+
+            loop
+               Read_ULEB128 (Abbrev, Aoff, Name);
+               Read_ULEB128 (Abbrev, Aoff, Form);
+               exit when Name = 0 and Form = 0;
+               Put ("  ");
+               Put (Get_Dwarf_At_Name (Name));
+               Set_Col (24);
+               Put (": ");
+               Old_Off := Off;
+               Disp_Dwarf_Form (Base, Off, Form);
+               case Name is
+                  when DW_AT_Encoding =>
+                     Put (": ");
+                     Disp_Dwarf_Encoding (Base, Old_Off, Form);
+                  when DW_AT_Location
+                    | DW_AT_Frame_Base
+                    | DW_AT_Data_Member_Location =>
+                     Put (":");
+                     Disp_Dwarf_Location (Base, Old_Off, Form);
+                  when DW_AT_Language =>
+                     Put (": ");
+                     Disp_Dwarf_Language (Base, Old_Off, Form);
+                  when others =>
+                     null;
+               end case;
+               New_Line;
+            end loop;
+         end loop;
+         Unchecked_Deallocation (Map);
+         New_Line;
+      end loop;
+   end Disp_Debug_Info;
+
+   function Get_Phdr_Type_Name (Ptype : Elf_Word) return String is
+   begin
+      case Ptype is
+         when PT_NULL =>
+            return "NULL";
+         when PT_LOAD =>
+            return "LOAD";
+         when PT_DYNAMIC =>
+            return "DYNAMIC";
+         when PT_INTERP =>
+            return "INTERP";
+         when PT_NOTE =>
+            return "NOTE";
+         when PT_SHLIB =>
+            return "SHLIB";
+         when PT_PHDR =>
+            return "PHDR";
+         when PT_TLS =>
+            return "TLS";
+         when PT_NUM =>
+            return "NUM";
+         when PT_GNU_EH_FRAME =>
+            return "GNU_EH_FRAME";
+         when PT_SUNWBSS =>
+            return "SUNWBSS";
+         when PT_SUNWSTACK =>
+            return "SUNWSTACK";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Phdr_Type_Name;
+
+   procedure Disp_Phdr (Phdr : Elf_Phdr)
+   is
+   begin
+      Put ("type  : " & Hex_Image (Phdr.P_Type));
+      Put ("  ");
+      Put (Get_Phdr_Type_Name (Phdr.P_Type));
+      New_Line;
+      Put ("offset: " & Hex_Image (Phdr.P_Offset));
+      Put ("  vaddr: " & Hex_Image (Phdr.P_Vaddr));
+      Put ("  paddr: " & Hex_Image (Phdr.P_Paddr));
+      New_Line;
+      Put ("filesz: " & Hex_Image (Phdr.P_Filesz));
+      Put ("  memsz: " & Hex_Image (Phdr.P_Memsz));
+      Put ("  align: " & Hex_Image (Phdr.P_Align));
+      --New_Line;
+      Put ("  flags: " & Hex_Image (Phdr.P_Flags));
+      Put (" (");
+      if (Phdr.P_Flags and PF_X) /= 0 then
+         Put ('X');
+      end if;
+      if (Phdr.P_Flags and PF_W) /= 0 then
+         Put ('W');
+      end if;
+      if (Phdr.P_Flags and PF_R) /= 0 then
+         Put ('R');
+      end if;
+      Put (")");
+      New_Line;
+   end Disp_Phdr;
+
+   procedure Disp_Debug_Pubnames (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+      B : Unsigned_8;
+
+      Len : Unsigned_32;
+      Ver : Unsigned_16;
+      Info_Off : Unsigned_32;
+      Info_Length : Unsigned_32;
+      Last : Storage_Offset;
+      Ioff : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Len);
+         Last := Off + Storage_Offset (Len);
+         Read_Word2 (Base, Off, Ver);
+         Read_Word4 (Base, Off, Info_Off);
+         Read_Word4 (Base, Off, Info_Length);
+         Put ("length: " & Hex_Image (Len));
+         Put (", version: " & Hex_Image (Ver));
+         Put (", offset: " & Hex_Image (Info_Off));
+         Put (", length: " & Hex_Image (Info_Length));
+         New_Line;
+
+         loop
+            Read_Word4 (Base, Off, Ioff);
+            Put ("  ");
+            Put (Hex_Image (Ioff));
+            if Ioff /= 0 then
+               Put (": ");
+               loop
+                  Read_Byte (Base, Off, B);
+                  exit when B = 0;
+                  Put (Character'Val (B));
+               end loop;
+            end if;
+            New_Line;
+            exit when Ioff = 0;
+         end loop;
+      end loop;
+   end Disp_Debug_Pubnames;
+
+   procedure Disp_Debug_Aranges (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+
+      Set_Len : Unsigned_32;
+      Ver : Unsigned_16;
+      Info_Off : Unsigned_32;
+      Last : Storage_Offset;
+      Addr_Sz : Unsigned_8;
+      Seg_Sz : Unsigned_8;
+      Pad : Unsigned_32;
+
+      Addr : Unsigned_32;
+      Len : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Set_Len);
+         Last := Off + Storage_Offset (Set_Len);
+         Read_Word2 (Base, Off, Ver);
+         Read_Word4 (Base, Off, Info_Off);
+         Read_Byte (Base, Off, Addr_Sz);
+         Read_Byte (Base, Off, Seg_Sz);
+         Read_Word4 (Base, Off, Pad);
+         Put ("length: " & Hex_Image (Set_Len));
+         Put (", version: " & Hex_Image (Ver));
+         Put (", offset: " & Hex_Image (Info_Off));
+         Put (", ptr_sz: " & Hex_Image (Addr_Sz));
+         Put (", seg_sz: " & Hex_Image (Seg_Sz));
+         New_Line;
+
+         loop
+            Read_Word4 (Base, Off, Addr);
+            Read_Word4 (Base, Off, Len);
+            Put ("  ");
+            Put (Hex_Image (Addr));
+            Put ('+');
+            Put (Hex_Image (Len));
+            New_Line;
+            exit when Addr = 0 and Len = 0;
+         end loop;
+      end loop;
+   end Disp_Debug_Aranges;
+
+   procedure Disp_String (Base : Address; Off : in out Storage_Offset)
+   is
+      B : Unsigned_8;
+   begin
+      loop
+         B := Read_Byte (Base + Off);
+         Off := Off + 1;
+         exit when B = 0;
+         Put (Character'Val (B));
+      end loop;
+   end Disp_String;
+
+   procedure Read_String (Base : Address; Off : in out Storage_Offset)
+   is
+      B : Unsigned_8;
+   begin
+      loop
+         Read_Byte (Base, Off, B);
+         exit when B = 0;
+      end loop;
+   end Read_String;
+
+   function Get_Dwarf_LNS_Name (Lns : Unsigned_8) return String
+   is
+      use Dwarf;
+   begin
+      case Lns is
+         when DW_LNS_Copy =>
+            return "copy";
+         when DW_LNS_Advance_Pc =>
+            return "advance_pc";
+         when DW_LNS_Advance_Line =>
+            return "advance_line";
+         when DW_LNS_Set_File =>
+            return "set_file";
+         when DW_LNS_Set_Column =>
+            return "set_column";
+         when DW_LNS_Negate_Stmt =>
+            return "negate_stmt";
+         when DW_LNS_Set_Basic_Block =>
+            return "set_basic_block";
+         when DW_LNS_Const_Add_Pc =>
+            return "const_add_pc";
+         when DW_LNS_Fixed_Advance_Pc =>
+            return "fixed_advance_pc";
+         when DW_LNS_Set_Prologue_End =>
+            return "set_prologue_end";
+         when DW_LNS_Set_Epilogue_Begin =>
+            return "set_epilogue_begin";
+         when DW_LNS_Set_Isa =>
+            return "set_isa";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Dwarf_LNS_Name;
+
+   procedure Disp_Debug_Line (File : Elf_File; Index : Elf_Half)
+   is
+      use Dwarf;
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+
+      type Opc_Length_Type is array (Unsigned_8 range <>) of Unsigned_8;
+      type Opc_Length_Acc is access Opc_Length_Type;
+      Opc_Length : Opc_Length_Acc;
+
+      Total_Len : Unsigned_32;
+      Version : Unsigned_16;
+      Prolog_Len : Unsigned_32;
+      Min_Insn_Len : Unsigned_8;
+      Dflt_Is_Stmt : Unsigned_8;
+      Line_Base : Unsigned_8;
+      Line_Range : Unsigned_8;
+      Opc_Base : Unsigned_8;
+
+      B : Unsigned_8;
+      Arg : Unsigned_32;
+
+      Old_Off : Storage_Offset;
+      File_Dir : Unsigned_32;
+      File_Time : Unsigned_32;
+      File_Len : Unsigned_32;
+
+      Ext_Len : Unsigned_32;
+      Ext_Opc : Unsigned_8;
+
+      Last : Storage_Offset;
+
+      Pc : Unsigned_32;
+      Line : Unsigned_32;
+      Line_Base2 : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Total_Len);
+         Last := Off + Storage_Offset (Total_Len);
+         Read_Word2 (Base, Off, Version);
+         Read_Word4 (Base, Off, Prolog_Len);
+         Read_Byte (Base, Off, Min_Insn_Len);
+         Read_Byte (Base, Off, Dflt_Is_Stmt);
+         Read_Byte (Base, Off, Line_Base);
+         Read_Byte (Base, Off, Line_Range);
+         Read_Byte (Base, Off, Opc_Base);
+
+         Pc := 0;
+         Line := 1;
+
+         Put ("length: " & Hex_Image (Total_Len));
+         Put (", version: " & Hex_Image (Version));
+         Put (", prolog_len: " & Hex_Image (Prolog_Len));
+         New_Line;
+         Put (" minimum_instruction_len: " & Hex_Image (Min_Insn_Len));
+         Put (", default_is_stmt: " & Hex_Image (Dflt_Is_Stmt));
+         New_Line;
+         Put (" line_base: " & Hex_Image (Line_Base));
+         Put (", line_range: " & Hex_Image (Line_Range));
+         Put (", opc_base: " & Hex_Image (Opc_Base));
+         New_Line;
+         Line_Base2 := Unsigned_32 (Line_Base);
+         if (Line_Base and 16#80#) /= 0 then
+            Line_Base2 := Line_Base2 or 16#Ff_Ff_Ff_00#;
+         end if;
+         Put_Line ("standard_opcode_length:");
+         Opc_Length := new Opc_Length_Type (1 .. Opc_Base - 1);
+         for I in 1 .. Opc_Base - 1 loop
+            Read_Byte (Base, Off, B);
+            Put (' ');
+            Put (Hex_Image (I));
+            Put (" => ");
+            Put (Hex_Image (B));
+            Opc_Length (I) := B;
+            New_Line;
+         end loop;
+         Put_Line ("include_directories:");
+         loop
+            B := Read_Byte (Base + Off);
+            exit when B = 0;
+            Put (' ');
+            Disp_String (Base, Off);
+            New_Line;
+         end loop;
+         Off := Off + 1;
+         Put_Line ("file_names:");
+         loop
+            B := Read_Byte (Base + Off);
+            exit when B = 0;
+            Old_Off := Off;
+            Read_String (Base, Off);
+            Read_ULEB128 (Base, Off, File_Dir);
+            Read_ULEB128 (Base, Off, File_Time);
+            Read_ULEB128 (Base, Off, File_Len);
+            Put (' ');
+            Put (Hex_Image (File_Dir));
+            Put (' ');
+            Put (Hex_Image (File_Time));
+            Put (' ');
+            Put (Hex_Image (File_Len));
+            Put (' ');
+            Disp_String (Base, Old_Off);
+            New_Line;
+         end loop;
+         Off := Off + 1;
+
+         while Off < Last loop
+            Put ("  ");
+            Read_Byte (Base, Off, B);
+            Put (Hex_Image (B));
+            Old_Off := Off;
+            if B < Opc_Base then
+               case B is
+                  when 0 =>
+                     Put (" (extended)");
+                     Read_ULEB128 (Base, Off, Ext_Len);
+                     Put (", len: ");
+                     Put (Hex_Image (Ext_Len));
+                     Old_Off := Off;
+                     Read_Byte (Base, Off, Ext_Opc);
+                     Put (" opc:");
+                     Put (Hex_Image (Ext_Opc));
+                     Off := Old_Off + Storage_Offset (Ext_Len);
+                  when others =>
+                     Put (" (");
+                     Put (Get_Dwarf_LNS_Name (B));
+                     Put (")");
+                     Set_Col (20);
+                     for J in 1 .. Opc_Length (B) loop
+                        Read_ULEB128 (Base, Off, Arg);
+                        Put (" ");
+                        Put (Hex_Image (Arg));
+                     end loop;
+               end case;
+               case B is
+                  when DW_LNS_Copy =>
+                     Put (" pc=");
+                     Put (Hex_Image (Pc));
+                     Put (", line=");
+                     Put (Unsigned_32'Image (Line));
+                  when DW_LNS_Advance_Pc =>
+                     Read_ULEB128 (Base, Old_Off, Arg);
+                     Pc := Pc + Arg * Unsigned_32 (Min_Insn_Len);
+                     Put ("  pc=");
+                     Put (Hex_Image (Pc));
+                  when DW_LNS_Advance_Line =>
+                     Read_SLEB128 (Base, Old_Off, Arg);
+                     Line := Line + Arg;
+                     Put ("  line=");
+                     Put (Unsigned_32'Image (Line));
+                  when DW_LNS_Set_File =>
+                     null;
+                  when DW_LNS_Set_Column =>
+                     null;
+                  when DW_LNS_Negate_Stmt =>
+                     null;
+                  when DW_LNS_Set_Basic_Block =>
+                     null;
+                  when DW_LNS_Const_Add_Pc =>
+                     Pc := Pc + Unsigned_32 ((255 - Opc_Base) / Line_Range)
+                       * Unsigned_32 (Min_Insn_Len);
+                     Put ("  pc=");
+                     Put (Hex_Image (Pc));
+                  when others =>
+                     null;
+               end case;
+               New_Line;
+            else
+               B := B - Opc_Base;
+               Pc := Pc + Unsigned_32 (B / Line_Range)
+                 * Unsigned_32 (Min_Insn_Len);
+               Line := Line + Line_Base2 + Unsigned_32 (B mod Line_Range);
+               Put (" pc=");
+               Put (Hex_Image (Pc));
+               Put (", line=");
+               Put (Unsigned_32'Image (Line));
+               New_Line;
+            end if;
+         end loop;
+      end loop;
+   end Disp_Debug_Line;
+
+   function Get_Dwarf_Cfi_Name (Cfi : Unsigned_8) return String
+   is
+      use Dwarf;
+   begin
+      case Cfi is
+         when DW_CFA_Advance_Loc_Min .. DW_CFA_Advance_Loc_Max =>
+            return "advance_loc";
+         when DW_CFA_Offset_Min .. DW_CFA_Offset_Max =>
+            return "offset";
+         when DW_CFA_Restore_Min .. DW_CFA_Restore_Max =>
+            return "restore";
+         when DW_CFA_Nop =>
+            return "nop";
+         when DW_CFA_Set_Loc =>
+            return "set_loc";
+         when DW_CFA_Advance_Loc1 =>
+            return "advance_loc1";
+         when DW_CFA_Advance_Loc2 =>
+            return "advance_loc2";
+         when DW_CFA_Advance_Loc4 =>
+            return "advance_loc4";
+         when DW_CFA_Offset_Extended =>
+            return "offset_extended";
+         when DW_CFA_Restore_Extended =>
+            return "restore_extended";
+         when DW_CFA_Undefined =>
+            return "undefined";
+         when DW_CFA_Same_Value =>
+            return "same_value";
+         when DW_CFA_Register =>
+            return "register";
+         when DW_CFA_Remember_State =>
+            return "remember_state";
+         when DW_CFA_Restore_State =>
+            return "restore_state";
+         when DW_CFA_Def_Cfa =>
+            return "def_cfa";
+         when DW_CFA_Def_Cfa_Register =>
+            return "def_cfa_register";
+         when DW_CFA_Def_Cfa_Offset =>
+            return "def_cfa_offset";
+         when DW_CFA_Def_Cfa_Expression =>
+            return "def_cfa_expression";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Dwarf_Cfi_Name;
+
+   procedure Disp_Cfi (Base : Address; Length : Storage_Count)
+   is
+      use Dwarf;
+      L : Storage_Offset;
+      Op : Unsigned_8;
+      Off : Unsigned_32;
+      Reg : Unsigned_32;
+   begin
+      L := 0;
+      while L < Length loop
+         Op := Read_Byte (Base + L);
+         Put (" ");
+         Put (Hex_Image (Op));
+         Put (" ");
+         Put (Get_Dwarf_Cfi_Name (Op));
+         Put (" ");
+         L := L + 1;
+         case Op is
+            when DW_CFA_Nop =>
+               null;
+            when DW_CFA_Advance_Loc_Min .. DW_CFA_Advance_Loc_Max =>
+               Put (Hex_Image (Op and 16#3f#));
+            when DW_CFA_Offset_Min .. DW_CFA_Offset_Max =>
+               Read_ULEB128 (Base, L, Off);
+               Put ("reg:");
+               Put (Hex_Image (Op and 16#3f#));
+               Put (", offset:");
+               Put (Hex_Image (Off));
+            when DW_CFA_Def_Cfa =>
+               Read_ULEB128 (Base, L, Reg);
+               Read_ULEB128 (Base, L, Off);
+               Put ("reg:");
+               Put (Hex_Image (Reg));
+               Put (", offset:");
+               Put (Hex_Image (Off));
+            when DW_CFA_Def_Cfa_Offset =>
+               Read_ULEB128 (Base, L, Off);
+               Put (Hex_Image (Off));
+            when DW_CFA_Def_Cfa_Register =>
+               Read_ULEB128 (Base, L, Reg);
+               Put ("reg:");
+               Put (Hex_Image (Reg));
+            when others =>
+               Put ("?unknown?");
+               New_Line;
+               exit;
+         end case;
+         New_Line;
+      end loop;
+   end Disp_Cfi;
+
+   procedure Disp_Debug_Frame (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+      Old_Off : Storage_Offset;
+
+      Length : Unsigned_32;
+      Cie_Id : Unsigned_32;
+      Version : Unsigned_8;
+      Augmentation : Unsigned_8;
+      Code_Align : Unsigned_32;
+      Data_Align : Unsigned_32;
+      Ret_Addr_Reg : Unsigned_8;
+
+      Init_Loc : Unsigned_32;
+      Addr_Rng : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Length);
+         Old_Off := Off;
+
+         Read_Word4 (Base, Off, Cie_Id);
+         if Cie_Id = 16#Ff_Ff_Ff_Ff# then
+            Read_Byte (Base, Off, Version);
+            Read_Byte (Base, Off, Augmentation);
+            Put ("length: ");
+            Put (Hex_Image (Length));
+            Put (", CIE_id: ");
+            Put (Hex_Image (Cie_Id));
+            Put (", version: ");
+            Put (Hex_Image (Version));
+            if Augmentation /= 0 then
+               Put (" +augmentation");
+               New_Line;
+            else
+               New_Line;
+               Read_ULEB128 (Base, Off, Code_Align);
+               Read_SLEB128 (Base, Off, Data_Align);
+               Read_Byte (Base, Off, Ret_Addr_Reg);
+               Put ("code_align: ");
+               Put (Hex_Image (Code_Align));
+               Put (", data_align: ");
+               Put (Hex_Image (Data_Align));
+               Put (", ret_addr_reg: ");
+               Put (Hex_Image (Ret_Addr_Reg));
+               New_Line;
+               Put ("initial instructions:");
+               New_Line;
+               Disp_Cfi (Base + Off, Old_Off + Storage_Offset (Length) - Off);
+            end if;
+         else
+            Read_Word4 (Base, Off, Init_Loc);
+            Read_Word4 (Base, Off, Addr_Rng);
+            Put ("length: ");
+            Put (Hex_Image (Length));
+            Put (", CIE_pointer: ");
+            Put (Hex_Image (Cie_Id));
+            Put (", address_range: ");
+            Put (Hex_Image (Init_Loc));
+            Put ("-");
+            Put (Hex_Image (Init_Loc + Addr_Rng));
+            New_Line;
+            Put ("instructions:");
+            New_Line;
+            Disp_Cfi (Base + Off, Old_Off + Storage_Offset (Length) - Off);
+         end if;
+         Off := Old_Off + Storage_Offset (Length);
+      end loop;
+   end Disp_Debug_Frame;
+
+   procedure Read_Coded (Base : Address;
+                         Offset : in out Storage_Offset;
+                         Code : Unsigned_8;
+                         Val : out Unsigned_32)
+   is
+      use Dwarf;
+
+      V2 : Unsigned_16;
+   begin
+      if Code = DW_EH_PE_Omit then
+         return;
+      end if;
+      case Code and DW_EH_PE_Format_Mask is
+         when DW_EH_PE_Uleb128 =>
+            Read_ULEB128 (Base, Offset, Val);
+         when DW_EH_PE_Udata2 =>
+            Read_Word2 (Base, Offset, V2);
+            Val := Unsigned_32 (V2);
+         when DW_EH_PE_Udata4 =>
+            Read_Word4 (Base, Offset, Val);
+         when DW_EH_PE_Sleb128 =>
+            Read_SLEB128 (Base, Offset, Val);
+         when DW_EH_PE_Sdata2 =>
+            Read_Word2 (Base, Offset, V2);
+            Val := Unsigned_32 (V2);
+            if (V2 and 16#80_00#) /= 0 then
+               Val := Val or 16#Ff_Ff_00_00#;
+            end if;
+         when DW_EH_PE_Sdata4 =>
+            Read_Word4 (Base, Offset, Val);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Read_Coded;
+
+   procedure Disp_Eh_Frame_Hdr (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+
+      Version : Unsigned_8;
+      Eh_Frame_Ptr_Enc : Unsigned_8;
+      Fde_Count_Enc : Unsigned_8;
+      Table_Enc : Unsigned_8;
+
+      Eh_Frame_Ptr : Unsigned_32;
+      Fde_Count : Unsigned_32;
+
+      Loc : Unsigned_32;
+      Addr : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Byte (Base, Off, Version);
+         Read_Byte (Base, Off, Eh_Frame_Ptr_Enc);
+         Read_Byte (Base, Off, Fde_Count_Enc);
+         Read_Byte (Base, Off, Table_Enc);
+         Put ("version: ");
+         Put (Hex_Image (Version));
+         Put (", encodings: ptr:");
+         Put (Hex_Image (Eh_Frame_Ptr_Enc));
+         Put (" count:");
+         Put (Hex_Image (Fde_Count_Enc));
+         Put (" table:");
+         Put (Hex_Image (Table_Enc));
+         New_Line;
+         Read_Coded (Base, Off, Eh_Frame_Ptr_Enc, Eh_Frame_Ptr);
+         Read_Coded (Base, Off, Fde_Count_Enc, Fde_Count);
+         Put ("eh_frame_ptr: ");
+         Put (Hex_Image (Eh_Frame_Ptr));
+         Put (", fde_count: ");
+         Put (Hex_Image (Fde_Count));
+         New_Line;
+         for I in 1 .. Fde_Count loop
+            Read_Coded (Base, Off, Table_Enc, Loc);
+            Read_Coded (Base, Off, Table_Enc, Addr);
+            Put ("  init loc: ");
+            Put (Hex_Image (Loc));
+            Put (", addr : ");
+            Put (Hex_Image (Addr));
+            New_Line;
+         end loop;
+      end loop;
+   end Disp_Eh_Frame_Hdr;
+end Elfdumper;
diff --git a/src/ortho/mcode/elfdumper.ads b/src/ortho/mcode/elfdumper.ads
new file mode 100644
index 000000000..0227f0f41
--- /dev/null
+++ b/src/ortho/mcode/elfdumper.ads
@@ -0,0 +1,164 @@
+--  ELF dumper (library).
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System; use System;
+with Elf_Common; use Elf_Common;
+with Elf_Arch; use Elf_Arch;
+with Ada.Unchecked_Conversion;
+
+package Elfdumper is
+   procedure Disp_Ehdr (Ehdr : Elf_Ehdr);
+
+   type Strtab_Fat_Type is array (Elf_Size) of Character;
+   type Strtab_Fat_Acc is access all Strtab_Fat_Type;
+
+   type Strtab_Type is record
+      Base : Strtab_Fat_Acc;
+      Length : Elf_Size;
+   end record;
+
+   Null_Strtab : constant Strtab_Type := (null, 0);
+
+   Nul : constant Character := Character'Val (0);
+
+   function Get_String (Strtab : Strtab_Type; N : Elf_Size)
+                       return String;
+
+   procedure Disp_Shdr (Shdr : Elf_Shdr; Sh_Strtab : Strtab_Type);
+
+   type Elf_Shdr_Array is array (Elf_Half range <>) of Elf_Shdr;
+
+   type Elf_File is limited private;
+   type Elf_File_Status is
+     (
+      --  No error.
+      Status_Ok,
+
+      --  Cannot open file.
+      Status_Open_Failure,
+
+      Status_Bad_File,
+      Status_Memory,
+      Status_Read_Error,
+      Status_Bad_Magic,
+      Status_Bad_Class
+      );
+
+   procedure Open_File (File : out Elf_File; Filename : String);
+
+   function Get_Status (File : Elf_File) return Elf_File_Status;
+
+   type Elf_Ehdr_Acc is access all Elf_Ehdr;
+
+   function Get_Ehdr (File : Elf_File) return Elf_Ehdr_Acc;
+
+   procedure Load_Shdr (File : in out Elf_File);
+
+   type Elf_Shdr_Acc is access all Elf_Shdr;
+
+   function Get_Shdr (File : Elf_File; Index : Elf_Half)
+                     return Elf_Shdr_Acc;
+
+   function Get_Shdr_Type_Name (Stype : Elf_Word) return String;
+
+   procedure Load_Phdr (File : in out Elf_File);
+
+   type Elf_Phdr_Acc is access all Elf_Phdr;
+
+   function Get_Phdr (File : Elf_File; Index : Elf_Half)
+                     return Elf_Phdr_Acc;
+
+   function Get_Segment_Base (File : Elf_File; Index : Elf_Half)
+                             return Address;
+
+   function Get_Sh_Strtab (File : Elf_File) return Strtab_Type;
+
+   procedure Disp_Sym (File : Elf_File;
+                       Sym : Elf_Sym;
+                       Strtab : Strtab_Type);
+
+   procedure Disp_Symtab (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Strtab (File : Elf_File; Index : Elf_Half);
+
+   function Get_Section_Name (File : Elf_File; Index : Elf_Half)
+                             return String;
+
+   function Get_Section_By_Name (File : Elf_File; Name : String)
+                                return Elf_Half;
+
+   procedure Disp_Debug_Abbrev (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Info (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Pubnames (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Aranges (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Line (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Frame (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Eh_Frame_Hdr (File : Elf_File; Index : Elf_Half);
+
+   procedure Disp_Phdr (Phdr : Elf_Phdr);
+
+   procedure Disp_Segment_Note (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Section_Note (File : Elf_File; Index : Elf_Half);
+
+   procedure Disp_Dynamic (File : Elf_File; Index : Elf_Half);
+private
+   use System;
+
+   function To_Strtab_Fat_Acc is new Ada.Unchecked_Conversion
+     (Address, Strtab_Fat_Acc);
+
+   type String_Acc is access String;
+
+   function To_Elf_Ehdr_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Ehdr_Acc);
+
+   function To_Elf_Phdr_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Phdr_Acc);
+
+   function To_Elf_Shdr_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Shdr_Acc);
+
+   type Elf_Sym_Acc is access all Elf_Sym;
+   function To_Elf_Sym_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Sym_Acc);
+
+   type Elf_Shdr_Arr is array (Elf_Half) of Elf_Shdr;
+
+   type Elf_Shdr_Arr_Acc is access all Elf_Shdr_Arr;
+   function To_Elf_Shdr_Arr_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Shdr_Arr_Acc);
+
+   type Elf_File is record
+      --  Name of the file.
+      Filename : String_Acc;
+
+      --  Status, used to report errors.
+      Status : Elf_File_Status;
+
+      --  Length of the file.
+      Length : Elf_Off;
+
+      --  File contents.
+      Base : Address;
+
+      Ehdr : Elf_Ehdr_Acc;
+
+      Shdr_Base : Address;
+      Sh_Strtab : Strtab_Type;
+
+      Phdr_Base : Address;
+   end record;
+end Elfdumper;
diff --git a/src/ortho/mcode/hex_images.adb b/src/ortho/mcode/hex_images.adb
new file mode 100644
index 000000000..a9dca324d
--- /dev/null
+++ b/src/ortho/mcode/hex_images.adb
@@ -0,0 +1,71 @@
+--  To hexadecimal conversions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+
+package body Hex_Images is
+   type Hex_Str_Type is array (0 .. 15) of Character;
+   Hexdigits : constant Hex_Str_Type := "0123456789abcdef";
+
+   function Hex_Image (B : Unsigned_8) return String is
+      Res : String (1 .. 2);
+   begin
+      for I in 1 .. 2 loop
+         Res (I) := Hexdigits
+           (Natural (Shift_Right (B, 8 - 4 * I) and 16#0f#));
+      end loop;
+      return Res;
+   end Hex_Image;
+
+   function Conv is new Ada.Unchecked_Conversion
+     (Source => Integer_32, Target => Unsigned_32);
+
+   function Hex_Image (W : Unsigned_32) return String is
+      Res : String (1 .. 8);
+   begin
+      for I in 1 .. 8 loop
+         Res (I) := Hexdigits
+           (Natural (Shift_Right (W, 32 - 4 * I) and 16#0f#));
+      end loop;
+      return Res;
+   end Hex_Image;
+
+   function Hex_Image (W : Unsigned_64) return String is
+      Res : String (1 .. 16);
+   begin
+      for I in 1 .. 16 loop
+         Res (I) := Hexdigits
+           (Natural (Shift_Right (W, 64 - 4 * I) and 16#0f#));
+      end loop;
+      return Res;
+   end Hex_Image;
+
+   function Hex_Image (W : Unsigned_16) return String is
+      Res : String (1 .. 4);
+   begin
+      for I in 1 .. 4 loop
+         Res (I) := Hexdigits
+           (Natural (Shift_Right (W, 16 - 4 * I) and 16#0f#));
+      end loop;
+      return Res;
+   end Hex_Image;
+
+   function Hex_Image (W : Integer_32) return String is
+   begin
+      return Hex_Image (Conv (W));
+   end Hex_Image;
+end Hex_Images;
diff --git a/src/ortho/mcode/hex_images.ads b/src/ortho/mcode/hex_images.ads
new file mode 100644
index 000000000..830d2ec43
--- /dev/null
+++ b/src/ortho/mcode/hex_images.ads
@@ -0,0 +1,26 @@
+--  To hexadecimal conversions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+
+package Hex_Images is
+   function Hex_Image (W : Integer_32) return String;
+   function Hex_Image (W : Unsigned_32) return String;
+   function Hex_Image (B : Unsigned_8) return String;
+   function Hex_Image (W : Unsigned_16) return String;
+   function Hex_Image (W : Unsigned_64) return String;
+end Hex_Images;
diff --git a/src/ortho/mcode/memsegs.ads b/src/ortho/mcode/memsegs.ads
new file mode 100644
index 000000000..ff7f8947e
--- /dev/null
+++ b/src/ortho/mcode/memsegs.ads
@@ -0,0 +1,3 @@
+with Memsegs_Mmap;
+package Memsegs renames Memsegs_Mmap;
+
diff --git a/src/ortho/mcode/memsegs_c.c b/src/ortho/mcode/memsegs_c.c
new file mode 100644
index 000000000..f0a0e27d5
--- /dev/null
+++ b/src/ortho/mcode/memsegs_c.c
@@ -0,0 +1,133 @@
+/*  Memory segment handling.
+    Copyright (C) 2006 Tristan Gingold.
+
+    GHDL is free software; you can redistribute it and/or modify it under
+    the terms of the GNU General Public License as published by the Free
+    Software Foundation; either version 2, or (at your option) any later
+    version.
+
+    GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+    WARRANTY; without even the implied warranty of MERCHANTABILITY or
+    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+    for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with GCC; see the file COPYING.  If not, write to the Free
+    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+*/
+#ifndef WINNT
+
+#define _GNU_SOURCE
+#include <sys/mman.h>
+#include <stddef.h>
+/* #include <stdio.h> */
+
+/* TODO: init (get pagesize)
+    round size,
+   set rights.
+*/
+
+#ifdef __APPLE__
+#define MAP_ANONYMOUS MAP_ANON
+#else
+#define HAVE_MREMAP
+#endif
+
+#ifndef HAVE_MREMAP
+#include <string.h>
+#endif
+
+void *
+mmap_malloc (int size)
+{
+  void *res;
+  res = mmap (NULL, size, PROT_READ | PROT_WRITE,
+	      MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+  /* printf ("mmap (%d) = %p\n", size, res); */
+  if (res == MAP_FAILED)
+    return NULL;
+  return res;
+}
+
+void *
+mmap_realloc (void *ptr, int old_size, int size)
+{
+  void *res;
+#ifdef HAVE_MREMAP
+  res = mremap (ptr, old_size, size, MREMAP_MAYMOVE);
+#else
+  res = mmap (NULL, size, PROT_READ | PROT_WRITE,
+	      MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+  if (res == MAP_FAILED)
+    return NULL;
+  memcpy (res, ptr, old_size);
+  munmap (ptr, old_size);
+#endif
+  /* printf ("mremap (%p, %d, %d) = %p\n", ptr, old_size, size, res); */
+#if 0
+  if (res == MAP_FAILED)
+    return NULL;
+#endif
+  return res;
+}
+
+void
+mmap_free (void * ptr, int size)
+{
+  munmap (ptr, size);
+}
+
+void
+mmap_rx (void *ptr, int size)
+{
+  mprotect (ptr, size, PROT_READ | PROT_EXEC);
+}
+
+#else
+#include <windows.h>
+
+void *
+mmap_malloc (int size)
+{
+  void *res;
+  res = VirtualAlloc (NULL, size, 
+		      MEM_COMMIT | MEM_RESERVE,
+		      PAGE_READWRITE);
+  return res;
+}
+
+void *
+mmap_realloc (void *ptr, int old_size, int size)
+{
+  void *res;
+
+  res = VirtualAlloc (NULL, size, 
+		      MEM_COMMIT | MEM_RESERVE,
+		      PAGE_READWRITE);
+
+  if (ptr != NULL)
+    {
+      CopyMemory (res, ptr, size > old_size ? old_size : size);
+      VirtualFree (ptr, old_size, MEM_RELEASE);
+    }
+
+  return res;
+}
+
+void
+mmap_free (void * ptr, int size)
+{
+  VirtualFree (ptr, size, MEM_RELEASE);
+}
+
+void
+mmap_rx (void *ptr, int size)
+{
+  DWORD old;
+
+  /* This is not supported on every version.
+     In case of failure, this should still work.  */
+  VirtualProtect (ptr, size,  PAGE_EXECUTE_READ, &old);
+}
+#endif
diff --git a/src/ortho/mcode/memsegs_mmap.adb b/src/ortho/mcode/memsegs_mmap.adb
new file mode 100644
index 000000000..1ee8e7bcf
--- /dev/null
+++ b/src/ortho/mcode/memsegs_mmap.adb
@@ -0,0 +1,64 @@
+--  Memory segments.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Memsegs_Mmap is
+   function Mmap_Malloc (Size : Natural) return Address;
+   pragma Import (C, Mmap_Malloc, "mmap_malloc");
+
+   function Mmap_Realloc (Ptr : Address; Old_Size : Natural; Size : Natural)
+                         return Address;
+   pragma Import (C, Mmap_Realloc, "mmap_realloc");
+
+   procedure Mmap_Free (Ptr : Address; Size : Natural);
+   pragma Import (C, Mmap_Free, "mmap_free");
+
+   procedure Mmap_Rx (Ptr : Address; Size : Natural);
+   pragma Import (C, Mmap_Rx, "mmap_rx");
+
+   function Create return Memseg_Type is
+   begin
+      return (Base => Null_Address, Size => 0);
+   end Create;
+
+   procedure Resize (Seg : in out Memseg_Type; Size : Natural) is
+   begin
+      if Seg.Size = 0 then
+         Seg.Base := Mmap_Malloc (Size);
+      else
+         Seg.Base := Mmap_Realloc (Seg.Base, Seg.Size, Size);
+      end if;
+      Seg.Size := Size;
+   end Resize;
+
+   function Get_Address (Seg : Memseg_Type) return Address is
+   begin
+      return Seg.Base;
+   end Get_Address;
+
+   procedure Delete (Seg : in out Memseg_Type) is
+   begin
+      Mmap_Free (Seg.Base, Seg.Size);
+      Seg.Base := Null_Address;
+      Seg.Size := 0;
+   end Delete;
+
+   procedure Set_Rx (Seg : in out Memseg_Type) is
+   begin
+      Mmap_Rx (Seg.Base, Seg.Size);
+   end Set_Rx;
+end Memsegs_Mmap;
+
diff --git a/src/ortho/mcode/memsegs_mmap.ads b/src/ortho/mcode/memsegs_mmap.ads
new file mode 100644
index 000000000..ba7d76618
--- /dev/null
+++ b/src/ortho/mcode/memsegs_mmap.ads
@@ -0,0 +1,49 @@
+--  Memory segments.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System; use System;
+
+package Memsegs_Mmap is
+   --  A memseg is a growable memory space.  It can be resized with Resize.
+   --  After each operation the base address can change and must be get
+   --  with Get_Address.
+   type Memseg_Type is private;
+
+   --  Create a new memseg.
+   function Create return Memseg_Type;
+
+   --  Resize the memseg.
+   procedure Resize (Seg : in out Memseg_Type; Size : Natural);
+
+   --  Get the base address.
+   function Get_Address (Seg : Memseg_Type) return Address;
+
+   --  Free all the memory and initialize the memseg.
+   procedure Delete (Seg : in out Memseg_Type);
+
+   --  Set the protection to read+execute.
+   procedure Set_Rx (Seg : in out Memseg_Type);
+
+   pragma Inline (Create);
+   pragma Inline (Get_Address);
+private
+   type Memseg_Type is record
+      Base : Address := Null_Address;
+      Size : Natural := 0;
+   end record;
+end Memsegs_Mmap;
+
diff --git a/src/ortho/mcode/ortho_code-abi.ads b/src/ortho/mcode/ortho_code-abi.ads
new file mode 100644
index 000000000..e75b08509
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-abi.ads
@@ -0,0 +1,3 @@
+with Ortho_Code.X86.Abi;
+
+package Ortho_Code.Abi renames Ortho_Code.X86.Abi;
diff --git a/src/ortho/mcode/ortho_code-binary.adb b/src/ortho/mcode/ortho_code-binary.adb
new file mode 100644
index 000000000..7bb6bdd28
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-binary.adb
@@ -0,0 +1,37 @@
+--  Interface with binary writer for mcode.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Decls;
+with Ortho_Code.Exprs;
+
+package body Ortho_Code.Binary is
+   function Get_Decl_Symbol (Decl : O_Dnode) return Symbol
+   is
+   begin
+      return To_Symbol (Decls.Get_Decl_Info (Decl));
+   end Get_Decl_Symbol;
+
+   function Get_Label_Symbol (Label : O_Enode) return Symbol is
+   begin
+      return To_Symbol (Exprs.Get_Label_Info (Label));
+   end Get_Label_Symbol;
+
+   procedure Set_Label_Symbol (Label : O_Enode; Sym : Symbol) is
+   begin
+      Exprs.Set_Label_Info (Label, To_Int32 (Sym));
+   end Set_Label_Symbol;
+end Ortho_Code.Binary;
diff --git a/src/ortho/mcode/ortho_code-binary.ads b/src/ortho/mcode/ortho_code-binary.ads
new file mode 100644
index 000000000..58c79d3b2
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-binary.ads
@@ -0,0 +1,31 @@
+--  Interface with binary writer for mcode.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Binary_File; use Binary_File;
+
+package Ortho_Code.Binary is
+   function To_Symbol is new Ada.Unchecked_Conversion
+     (Source => Int32, Target => Symbol);
+
+   function To_Int32 is new Ada.Unchecked_Conversion
+     (Source => Symbol, Target => Int32);
+
+   function Get_Decl_Symbol (Decl : O_Dnode) return Symbol;
+   function Get_Label_Symbol (Label : O_Enode) return Symbol;
+   procedure Set_Label_Symbol (Label : O_Enode; Sym : Symbol);
+end Ortho_Code.Binary;
+
diff --git a/src/ortho/mcode/ortho_code-consts.adb b/src/ortho/mcode/ortho_code-consts.adb
new file mode 100644
index 000000000..d09a13c34
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-consts.adb
@@ -0,0 +1,559 @@
+--  Mcode back-end for ortho - Constants handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+with GNAT.Table;
+with Ada.Text_IO;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Debug;
+
+package body Ortho_Code.Consts is
+   type Cnode_Common is record
+      Kind : OC_Kind;
+      Lit_Type : O_Tnode;
+   end record;
+   for Cnode_Common use record
+      Kind at 0 range 0 .. 31;
+      Lit_Type at 4 range 0 .. 31;
+   end record;
+   for Cnode_Common'Size use 64;
+
+   type Cnode_Signed is record
+      Val : Integer_64;
+   end record;
+   for Cnode_Signed'Size use 64;
+
+   type Cnode_Unsigned is record
+      Val : Unsigned_64;
+   end record;
+   for Cnode_Unsigned'Size use 64;
+
+   type Cnode_Float is record
+      Val : IEEE_Float_64;
+   end record;
+   for Cnode_Float'Size use 64;
+
+   type Cnode_Enum is record
+      Id : O_Ident;
+      Val : Uns32;
+   end record;
+   for Cnode_Enum'Size use 64;
+
+   type Cnode_Addr is record
+      Decl : O_Dnode;
+      Pad : Int32;
+   end record;
+   for Cnode_Addr'Size use 64;
+
+   type Cnode_Aggr is record
+      Els : Int32;
+      Nbr : Int32;
+   end record;
+   for Cnode_Aggr'Size use 64;
+
+   type Cnode_Sizeof is record
+      Atype : O_Tnode;
+      Pad : Int32;
+   end record;
+   for Cnode_Sizeof'Size use 64;
+
+   type Cnode_Union is record
+      El : O_Cnode;
+      Field : O_Fnode;
+   end record;
+   for Cnode_Union'Size use 64;
+
+   package Cnodes is new GNAT.Table
+     (Table_Component_Type => Cnode_Common,
+      Table_Index_Type => O_Cnode,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   function Get_Const_Kind (Cst : O_Cnode) return OC_Kind is
+   begin
+      return Cnodes.Table (Cst).Kind;
+   end Get_Const_Kind;
+
+   function Get_Const_Type (Cst : O_Cnode) return O_Tnode is
+   begin
+      return Cnodes.Table (Cst).Lit_Type;
+   end Get_Const_Type;
+
+   function Get_Const_U64 (Cst : O_Cnode) return Unsigned_64
+   is
+      function To_Cnode_Unsigned is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Unsigned);
+   begin
+      return To_Cnode_Unsigned (Cnodes.Table (Cst + 1)).Val;
+   end Get_Const_U64;
+
+   function Get_Const_I64 (Cst : O_Cnode) return Integer_64
+   is
+      function To_Cnode_Signed is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Signed);
+   begin
+      return To_Cnode_Signed (Cnodes.Table (Cst + 1)).Val;
+   end Get_Const_I64;
+
+   function Get_Const_F64 (Cst : O_Cnode) return IEEE_Float_64
+   is
+      function To_Cnode_Float is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Float);
+   begin
+      return To_Cnode_Float (Cnodes.Table (Cst + 1)).Val;
+   end Get_Const_F64;
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Cnode_Signed, Target => Cnode_Common);
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Signed,
+                                   Lit_Type => Ltype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Signed'(Val => Value)));
+      return Res;
+   end New_Signed_Literal;
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Unsigned_64, Target => Cnode_Common);
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Unsigned,
+                                   Lit_Type => Ltype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Value));
+      return Res;
+   end New_Unsigned_Literal;
+
+--    function Get_Const_Literal (Cst : O_Cnode) return Uns32 is
+--    begin
+--       return Cnodes.Table (Cst).Val;
+--    end Get_Const_Literal;
+
+   function To_Uns64 is new Ada.Unchecked_Conversion
+     (Source => Cnode_Common, Target => Uns64);
+
+   function Get_Const_U32 (Cst : O_Cnode) return Uns32 is
+   begin
+      return Uns32 (To_Uns64 (Cnodes.Table (Cst + 1)));
+   end Get_Const_U32;
+
+   function Get_Const_R64 (Cst : O_Cnode) return Uns64 is
+   begin
+      return To_Uns64 (Cnodes.Table (Cst + 1));
+   end Get_Const_R64;
+
+   function Get_Const_Low (Cst : O_Cnode) return Uns32
+   is
+      V : Uns64;
+   begin
+      V := Get_Const_R64 (Cst);
+      return Uns32 (V and 16#Ffff_Ffff#);
+   end Get_Const_Low;
+
+   function Get_Const_High (Cst : O_Cnode) return Uns32
+   is
+      V : Uns64;
+   begin
+      V := Get_Const_R64 (Cst);
+      return Uns32 (Shift_Right (V, 32) and 16#Ffff_Ffff#);
+   end Get_Const_High;
+
+   function Get_Const_Low (Cst : O_Cnode) return Int32
+   is
+      V : Uns64;
+   begin
+      V := Get_Const_R64 (Cst);
+      return To_Int32 (Uns32 (V and 16#Ffff_Ffff#));
+   end Get_Const_Low;
+
+   function Get_Const_High (Cst : O_Cnode) return Int32
+   is
+      V : Uns64;
+   begin
+      V := Get_Const_R64 (Cst);
+      return To_Int32 (Uns32 (Shift_Right (V, 32) and 16#Ffff_Ffff#));
+   end Get_Const_High;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode
+   is
+      Res : O_Cnode;
+
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Float, Target => Cnode_Common);
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Float,
+                                   Lit_Type => Ltype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Float'(Val => Value)));
+      return Res;
+   end New_Float_Literal;
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode is
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Null,
+                                   Lit_Type => Ltype));
+      return Cnodes.Last;
+   end New_Null_Access;
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Cnode_Addr, Target => Cnode_Common);
+
+   function To_Cnode_Addr is new Ada.Unchecked_Conversion
+     (Source => Cnode_Common, Target => Cnode_Addr);
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Address,
+                                   Lit_Type => Atype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Decl,
+                                                  Pad => 0)));
+      return Res;
+   end New_Global_Unchecked_Address;
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Address,
+                                   Lit_Type => Atype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Decl,
+                                                  Pad => 0)));
+      return Res;
+   end New_Global_Address;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Subprg_Address,
+                                   Lit_Type => Atype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Subprg,
+                                                  Pad => 0)));
+      return Res;
+   end New_Subprogram_Address;
+
+   function Get_Const_Decl (Cst : O_Cnode) return O_Dnode is
+   begin
+      return To_Cnode_Addr (Cnodes.Table (Cst + 1)).Decl;
+   end Get_Const_Decl;
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Cnode_Enum, Target => Cnode_Common);
+
+   function To_Cnode_Enum is new Ada.Unchecked_Conversion
+     (Source => Cnode_Common, Target => Cnode_Enum);
+
+   --function Get_Named_Literal_Id (Lit : O_Cnode) return O_Ident is
+   --begin
+   --   return To_Cnode_Enum (Cnodes.Table (Lit + 1)).Id;
+   --end Get_Named_Literal_Id;
+
+   function New_Named_Literal
+     (Atype : O_Tnode; Id : O_Ident; Val : Uns32; Prev : O_Cnode)
+     return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Lit,
+                                   Lit_Type => Atype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Enum'(Id => Id,
+                                                  Val => Val)));
+      if Prev /= O_Cnode_Null then
+         if Prev + 2 /= Res then
+            raise Syntax_Error;
+         end if;
+      end if;
+      return Res;
+   end New_Named_Literal;
+
+   function Get_Lit_Ident (L : O_Cnode) return O_Ident is
+   begin
+      return To_Cnode_Enum (Cnodes.Table (L + 1)).Id;
+   end Get_Lit_Ident;
+
+   function Get_Lit_Value (L : O_Cnode) return Uns32 is
+   begin
+      return To_Cnode_Enum (Cnodes.Table (L + 1)).Val;
+   end Get_Lit_Value;
+
+   function Get_Lit_Chain (L : O_Cnode) return O_Cnode is
+   begin
+      return L + 2;
+   end Get_Lit_Chain;
+
+   package Els is new GNAT.Table
+     (Table_Component_Type => O_Cnode,
+      Table_Index_Type => Int32,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Cnode_Aggr, Target => Cnode_Common);
+
+   function To_Cnode_Aggr is new Ada.Unchecked_Conversion
+     (Source => Cnode_Common, Target => Cnode_Aggr);
+
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode)
+   is
+      Val : Int32;
+      Num : Uns32;
+   begin
+      Num := Get_Type_Record_Nbr_Fields (Atype);
+      Val := Els.Allocate (Integer (Num));
+
+      Cnodes.Append (Cnode_Common'(Kind => OC_Record,
+                                   Lit_Type => Atype));
+      List := (Res => Cnodes.Last,
+               Rec_Field => Get_Type_Record_Fields (Atype),
+               El => Val);
+      Cnodes.Append (To_Cnode_Common (Cnode_Aggr'(Els => Val,
+                                                  Nbr => Int32 (Num))));
+   end Start_Record_Aggr;
+
+
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode)
+   is
+   begin
+      Els.Table (List.El) := Value;
+      List.El := List.El + 1;
+   end New_Record_Aggr_El;
+
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode) is
+   begin
+      Res := List.Res;
+   end Finish_Record_Aggr;
+
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode)
+   is
+      Val : Int32;
+      Num : Uns32;
+   begin
+      Num := Get_Type_Subarray_Length (Atype);
+      Val := Els.Allocate (Integer (Num));
+
+      Cnodes.Append (Cnode_Common'(Kind => OC_Array,
+                                   Lit_Type => Atype));
+      List := (Res => Cnodes.Last,
+               El => Val);
+      Cnodes.Append (To_Cnode_Common (Cnode_Aggr'(Els => Val,
+                                                  Nbr => Int32 (Num))));
+   end Start_Array_Aggr;
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode)
+   is
+   begin
+      Els.Table (List.El) := Value;
+      List.El := List.El + 1;
+   end New_Array_Aggr_El;
+
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode)
+   is
+   begin
+      Res := List.Res;
+   end Finish_Array_Aggr;
+
+   function Get_Const_Aggr_Length (Cst : O_Cnode) return Int32 is
+   begin
+      return To_Cnode_Aggr (Cnodes.Table (Cst + 1)).Nbr;
+   end Get_Const_Aggr_Length;
+
+   function Get_Const_Aggr_Element (Cst : O_Cnode; N : Int32) return O_Cnode
+   is
+      El : Int32;
+   begin
+      El := To_Cnode_Aggr (Cnodes.Table (Cst + 1)).Els;
+      return Els.Table (El + N);
+   end Get_Const_Aggr_Element;
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Union, Target => Cnode_Common);
+
+      Res : O_Cnode;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Cnodes.Append (Cnode_Common'(Kind => OC_Union,
+                                      Lit_Type => Atype));
+         Res := Cnodes.Last;
+         Cnodes.Append (To_Cnode_Common (Cnode_Union'(El => Value,
+                                                      Field => Field)));
+         return Res;
+      else
+         return Value;
+      end if;
+   end New_Union_Aggr;
+
+   function To_Cnode_Union is new Ada.Unchecked_Conversion
+        (Source => Cnode_Common, Target => Cnode_Union);
+
+   function Get_Const_Union_Field (Cst : O_Cnode) return O_Fnode is
+   begin
+      return To_Cnode_Union (Cnodes.Table (Cst + 1)).Field;
+   end Get_Const_Union_Field;
+
+   function Get_Const_Union_Value (Cst : O_Cnode) return O_Cnode is
+   begin
+      return To_Cnode_Union (Cnodes.Table (Cst + 1)).El;
+   end Get_Const_Union_Value;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Sizeof, Target => Cnode_Common);
+
+      Res : O_Cnode;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Cnodes.Append (Cnode_Common'(Kind => OC_Sizeof,
+                                      Lit_Type => Rtype));
+         Res := Cnodes.Last;
+         Cnodes.Append (To_Cnode_Common (Cnode_Sizeof'(Atype => Atype,
+                                                       Pad => 0)));
+         return Res;
+      else
+         return New_Unsigned_Literal
+           (Rtype, Unsigned_64 (Get_Type_Size (Atype)));
+      end if;
+   end New_Sizeof;
+
+   function Get_Sizeof_Type (Cst : O_Cnode) return O_Tnode
+   is
+      function To_Cnode_Sizeof is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Sizeof);
+   begin
+      return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype;
+   end Get_Sizeof_Type;
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Sizeof, Target => Cnode_Common);
+
+      Res : O_Cnode;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Cnodes.Append (Cnode_Common'(Kind => OC_Alignof,
+                                      Lit_Type => Rtype));
+         Res := Cnodes.Last;
+         Cnodes.Append (To_Cnode_Common (Cnode_Sizeof'(Atype => Atype,
+                                                       Pad => 0)));
+         return Res;
+      else
+         return New_Unsigned_Literal
+           (Rtype, Unsigned_64 (Get_Type_Align_Bytes (Atype)));
+      end if;
+   end New_Alignof;
+
+   function Get_Alignof_Type (Cst : O_Cnode) return O_Tnode
+   is
+      function To_Cnode_Sizeof is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Sizeof);
+   begin
+      return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype;
+   end Get_Alignof_Type;
+
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode is
+   begin
+      if Get_Field_Parent (Field) /= Rec_Type then
+         raise Syntax_Error;
+      end if;
+      return New_Unsigned_Literal
+        (Rtype, Unsigned_64 (Get_Field_Offset (Field)));
+   end New_Offsetof;
+
+   procedure Get_Const_Bytes (Cst : O_Cnode; H, L : out Uns32) is
+   begin
+      case Get_Const_Kind (Cst) is
+         when OC_Signed
+           | OC_Unsigned
+           | OC_Float =>
+            H := Get_Const_High (Cst);
+            L := Get_Const_Low (Cst);
+         when OC_Null =>
+            H := 0;
+            L := 0;
+         when OC_Lit =>
+            H := 0;
+            L := To_Cnode_Enum (Cnodes.Table (Cst + 1)).Val;
+         when OC_Array
+           | OC_Record
+           | OC_Union
+           | OC_Sizeof
+           | OC_Alignof
+           | OC_Address
+           | OC_Subprg_Address =>
+            raise Syntax_Error;
+      end case;
+   end Get_Const_Bytes;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Cnode := Cnodes.Last;
+      M.Els := Els.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Cnodes.Set_Last (M.Cnode);
+      Els.Set_Last (M.Els);
+   end Release;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Cnodes: " & O_Cnode'Image (Cnodes.Last));
+      Put_Line ("Number of Cnodes-Els: " & Int32'Image (Els.Last));
+   end Disp_Stats;
+
+   procedure Finish is
+   begin
+      Cnodes.Free;
+      Els.Free;
+   end Finish;
+end Ortho_Code.Consts;
diff --git a/src/ortho/mcode/ortho_code-consts.ads b/src/ortho/mcode/ortho_code-consts.ads
new file mode 100644
index 000000000..0076bc6eb
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-consts.ads
@@ -0,0 +1,158 @@
+--  Mcode back-end for ortho - Constants handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+
+package Ortho_Code.Consts is
+   type OC_Kind is (OC_Signed, OC_Unsigned, OC_Float, OC_Lit, OC_Null,
+                    OC_Array, OC_Record, OC_Union,
+                    OC_Subprg_Address, OC_Address,
+                    OC_Sizeof, OC_Alignof);
+
+   function Get_Const_Kind (Cst : O_Cnode) return OC_Kind;
+
+   function Get_Const_Type (Cst : O_Cnode) return O_Tnode;
+
+   --  Get bytes for signed, unsigned, float, lit, null.
+   procedure Get_Const_Bytes (Cst : O_Cnode; H, L : out Uns32);
+
+   --  Used to set the length of a constrained type.
+   --  FIXME: check for no overflow.
+   function Get_Const_U32 (Cst : O_Cnode) return Uns32;
+
+   function Get_Const_U64 (Cst : O_Cnode) return Unsigned_64;
+   function Get_Const_I64 (Cst : O_Cnode) return Integer_64;
+
+   function Get_Const_F64 (Cst : O_Cnode) return IEEE_Float_64;
+
+   --  Get the low and high part of a constant.
+   function Get_Const_Low (Cst : O_Cnode) return Uns32;
+   function Get_Const_High (Cst : O_Cnode) return Uns32;
+
+   function Get_Const_Low (Cst : O_Cnode) return Int32;
+   function Get_Const_High (Cst : O_Cnode) return Int32;
+
+   function Get_Const_Aggr_Length (Cst : O_Cnode) return Int32;
+   function Get_Const_Aggr_Element (Cst : O_Cnode; N : Int32) return O_Cnode;
+
+   --  Only available in HLI.
+   function Get_Const_Union_Field (Cst : O_Cnode) return O_Fnode;
+   function Get_Const_Union_Value (Cst : O_Cnode) return O_Cnode;
+
+   --  Declaration for an address.
+   function Get_Const_Decl (Cst : O_Cnode) return O_Dnode;
+
+   --  Get the type from an OC_Sizeof node.
+   function Get_Sizeof_Type (Cst : O_Cnode) return O_Tnode;
+
+   --  Get the type from an OC_Alignof node.
+   function Get_Alignof_Type (Cst : O_Cnode) return O_Tnode;
+
+   --  Get the value of a named literal.
+   --function Get_Const_Literal (Cst : O_Cnode) return Uns32;
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode;
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode;
+
+   function New_Named_Literal
+     (Atype : O_Tnode; Id : O_Ident; Val : Uns32; Prev : O_Cnode)
+     return O_Cnode;
+
+   --  For boolean/enum literals.
+   function Get_Lit_Ident (L : O_Cnode) return O_Ident;
+   function Get_Lit_Chain (L : O_Cnode) return O_Cnode;
+   function Get_Lit_Value (L : O_Cnode) return Uns32;
+
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record REC_TYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   procedure Disp_Stats;
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+   procedure Finish;
+private
+   type O_Array_Aggr_List is record
+      Res : O_Cnode;
+      El : Int32;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Res : O_Cnode;
+      Rec_Field : O_Fnode;
+      El : Int32;
+   end record;
+
+   type Mark_Type is record
+      Cnode : O_Cnode;
+      Els : Int32;
+   end record;
+
+end Ortho_Code.Consts;
diff --git a/src/ortho/mcode/ortho_code-debug.adb b/src/ortho/mcode/ortho_code-debug.adb
new file mode 100644
index 000000000..0f3e01ab9
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-debug.adb
@@ -0,0 +1,143 @@
+--  Mcode back-end for ortho - Internal debugging.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Flags;
+
+package body Ortho_Code.Debug is
+   procedure Disp_Mode (M : Mode_Type)
+   is
+      use Ada.Text_IO;
+   begin
+      case M is
+         when Mode_U8 =>
+            Put ("U8 ");
+         when Mode_U16 =>
+            Put ("U16");
+         when Mode_U32 =>
+            Put ("U32");
+         when Mode_U64 =>
+            Put ("U64");
+         when Mode_I8 =>
+            Put ("I8 ");
+         when Mode_I16 =>
+            Put ("I16");
+         when Mode_I32 =>
+            Put ("I32");
+         when Mode_I64 =>
+            Put ("I64");
+         when Mode_X1 =>
+            Put ("xxx");
+         when Mode_Nil =>
+            Put ("Nil");
+         when Mode_F32 =>
+            Put ("F32");
+         when Mode_F64 =>
+            Put ("F64");
+         when Mode_B2 =>
+            Put ("B2 ");
+         when Mode_Blk =>
+            Put ("Blk");
+         when Mode_P32 =>
+            Put ("P32");
+         when Mode_P64 =>
+            Put ("P64");
+      end case;
+   end Disp_Mode;
+
+   procedure Set_Debug_Be_Flag (C : Character)
+   is
+      use Ada.Text_IO;
+   begin
+      case C is
+         when 'a' =>
+            Flag_Debug_Asm := True;
+         when 'b' =>
+            Flag_Debug_Body := True;
+         when 'B' =>
+            Flag_Debug_Body2 := True;
+         when 'c' =>
+            Flag_Debug_Code := True;
+         when 'C' =>
+            Flag_Debug_Code2 := True;
+         when 'd' =>
+            Flag_Debug_Dump := True;
+         when 'h' =>
+            Flag_Debug_Hex := True;
+         when 'H' =>
+            Flag_Debug_Hli := True;
+         when 'i' =>
+            Flag_Debug_Insn := True;
+         when 's' =>
+            Flag_Debug_Stat := True;
+         when 'k' =>
+            Flag_Debug_Keep := True;
+         when 't' =>
+            Flags.Flag_Type_Name := True;
+         when others =>
+            Put_Line (Standard_Error, "unknown debug be flag '" & C & "'");
+      end case;
+   end Set_Debug_Be_Flag;
+
+   procedure Set_Be_Flag (Str : String)
+   is
+      use Ada.Text_IO;
+
+      subtype Str_Type is String (1 .. Str'Length);
+      S : Str_Type renames Str;
+   begin
+      if S'Length > 11 and then S (1 .. 11) = "--be-debug=" then
+         for I in 12 .. S'Last loop
+            Set_Debug_Be_Flag (S (I));
+         end loop;
+      elsif S'Length > 10 and then S (1 .. 10) = "--be-dump=" then
+         for I in 11 .. S'Last loop
+            case S (I) is
+               when 'c' =>
+                  Flag_Dump_Code := True;
+               when others =>
+                  Put_Line (Standard_Error,
+                            "unknown back-end dump flag '" & S (I) & "'");
+            end case;
+         end loop;
+      elsif S'Length > 10 and then S (1 .. 10) = "--be-disp=" then
+         for I in 11 .. S'Last loop
+            case S (I) is
+               when 'c' =>
+                  Flag_Disp_Code := True;
+                  Flags.Flag_Type_Name := True;
+               when others =>
+                  Put_Line (Standard_Error,
+                            "unknown back-end disp flag '" & S (I) & "'");
+            end case;
+         end loop;
+      elsif S'Length > 9 and then S (1 .. 9) = "--be-opt=" then
+         for I in 10 .. S'Last loop
+            case S (I) is
+               when 'O' =>
+                  Flags.Flag_Optimize := True;
+               when 'b' =>
+                  Flags.Flag_Opt_BB := True;
+               when others =>
+                  Put_Line (Standard_Error,
+                            "unknown back-end opt flag '" & S (I) & "'");
+            end case;
+         end loop;
+      else
+         Put_Line (Standard_Error, "unknown back-end option " & Str);
+      end if;
+   end Set_Be_Flag;
+end Ortho_Code.Debug;
diff --git a/src/ortho/mcode/ortho_code-debug.ads b/src/ortho/mcode/ortho_code-debug.ads
new file mode 100644
index 000000000..03f550ac9
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-debug.ads
@@ -0,0 +1,70 @@
+--  Mcode back-end for ortho - Internal debugging.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO;
+
+package Ortho_Code.Debug is
+   package Int32_IO is new Ada.Text_IO.Integer_IO (Ortho_Code.Int32);
+
+   procedure Disp_Mode (M : Mode_Type);
+
+   --  Set a debug flag.
+   procedure Set_Debug_Be_Flag (C : Character);
+
+   --  any '--be-XXX=YY' option.
+   procedure Set_Be_Flag (Str : String);
+
+   --  c: tree created, before any back-end.
+   Flag_Disp_Code : Boolean := False;
+   Flag_Dump_Code : Boolean := False;
+
+   --  a: disp assembly code.
+   Flag_Debug_Asm : Boolean := False;
+
+   --  A: do internal checks (assertions).
+   Flag_Debug_Assert : Boolean := True;
+
+   --  b: disp top-level subprogram body before code generation.
+   Flag_Debug_Body : Boolean := False;
+
+   --  B: disp top-level subprogram body after code generation.
+   Flag_Debug_Body2 : Boolean := False;
+
+   --  c: display generated code.
+   Flag_Debug_Code : Boolean := False;
+
+   --  C: display generated code just before asm.
+   Flag_Debug_Code2 : Boolean := False;
+
+   --  h: disp bytes generated (in hexa).
+   Flag_Debug_Hex : Boolean := False;
+
+   --  H: generate high-level instructions.
+   Flag_Debug_Hli : Boolean := False;
+
+   --  r: raw dump, do not generate code.
+   Flag_Debug_Dump : Boolean := False;
+
+   --  i: disp insns, when generated.
+   Flag_Debug_Insn : Boolean := False;
+
+   --  s: disp stats (number of nodes).
+   Flag_Debug_Stat : Boolean := False;
+
+   --  k: keep all nodes in memory (do not free).
+   Flag_Debug_Keep: Boolean := False;
+end Ortho_Code.Debug;
diff --git a/src/ortho/mcode/ortho_code-decls.adb b/src/ortho/mcode/ortho_code-decls.adb
new file mode 100644
index 000000000..fcbf0b0de
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-decls.adb
@@ -0,0 +1,783 @@
+--  Mcode back-end for ortho - Declarations handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with GNAT.Table;
+with Ada.Text_IO;
+with Ortho_Ident;
+with Ortho_Code.Debug; use Ortho_Code.Debug;
+with Ortho_Code.Exprs;
+with Ortho_Code.Abi; use Ortho_Code.Abi;
+with Ortho_Code.Flags;
+
+package body Ortho_Code.Decls is
+   --  Common fields:
+   --    kind: 4 bits
+   --    storage: 2 bits
+   --    reg : 8 bits
+   --    depth : 16 bits
+   --    flags: addr + 9
+   --  Additionnal fields:
+   --    OD_Type: Id, dtype
+   --    OD_Var: Id, Dtype, symbol
+   --    OD_Local: Id, Dtype, offset/reg
+   --    OD_Const: Id, Dtype, Val, Symbol?
+   --    OD_Function: Id, Dtype [interfaces follows], Symbol
+   --    OD_Procedure: Id [interfaces follows], Symbol
+   --    OD_Interface: Id, Dtype, offset/reg
+   --    OD_Begin: Last
+   --    OD_Body: Decl, Stmt, Parent
+   type Dnode_Common (Kind : OD_Kind := OD_Type) is record
+      Storage : O_Storage;
+
+      --  True if the address of the declaration is taken.
+      Flag_Addr : Boolean;
+
+      Flag2 : Boolean;
+
+      Reg : O_Reg;
+
+      --  Depth of the declaration.
+      Depth : O_Depth;
+
+      case Kind is
+         when OD_Type
+           | OD_Const
+           | OD_Var
+           | OD_Local
+           | OD_Function
+           | OD_Procedure
+           | OD_Interface =>
+            --  Identifier of this declaration.
+            Id : O_Ident;
+            --  Type of this declaration.
+            Dtype : O_Tnode;
+            --  Symbol or offset.
+            Ref : Int32;
+            --  For const: the value.
+            --  For subprg: size of pushed arguments.
+            Info2 : Int32;
+         when OD_Subprg_Ext =>
+            --  Chain of interfaces.
+            Subprg_Inter : O_Dnode;
+
+         when OD_Block =>
+            --  Last declaration of this block.
+            Last : O_Dnode;
+            --  Max stack offset.
+            Block_Max_Stack : Uns32;
+            --  Infos: may be used to store symbols.
+            Block_Info1 : Int32;
+            Block_Info2 : Int32;
+         when OD_Body =>
+            --  Corresponding declaration (function/procedure).
+            Body_Decl : O_Dnode;
+            --  Entry statement for this body.
+            Body_Stmt : O_Enode;
+            --  Parent (as a body) of this body or null if at top level.
+            Body_Parent : O_Dnode;
+            Body_Info : Int32;
+         when OD_Const_Val =>
+            --  Corresponding declaration.
+            Val_Decl : O_Dnode;
+            --  Value.
+            Val_Val : O_Cnode;
+      end case;
+   end record;
+
+   Use_Subprg_Ext : constant Boolean := False;
+
+   pragma Pack (Dnode_Common);
+
+   package Dnodes is new GNAT.Table
+     (Table_Component_Type => Dnode_Common,
+      Table_Index_Type => O_Dnode,
+      Table_Low_Bound => O_Dnode_First,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   package TDnodes is new GNAT.Table
+     (Table_Component_Type => O_Dnode,
+      Table_Index_Type => O_Tnode,
+      Table_Low_Bound => O_Tnode_First,
+      Table_Initial => 1,
+      Table_Increment => 100);
+
+   Context : O_Dnode := O_Dnode_Null;
+
+   function Get_Decl_Type (Decl : O_Dnode) return O_Tnode is
+   begin
+      return Dnodes.Table (Decl).Dtype;
+   end Get_Decl_Type;
+
+   function Get_Decl_Kind (Decl : O_Dnode) return OD_Kind is
+   begin
+      return Dnodes.Table (Decl).Kind;
+   end Get_Decl_Kind;
+
+   function Get_Decl_Storage (Decl : O_Dnode) return O_Storage is
+   begin
+      return Dnodes.Table (Decl).Storage;
+   end Get_Decl_Storage;
+
+   procedure Set_Decl_Storage (Decl : O_Dnode; Storage : O_Storage) is
+   begin
+      Dnodes.Table (Decl).Storage := Storage;
+   end Set_Decl_Storage;
+
+   function Get_Decl_Reg (Decl : O_Dnode) return O_Reg is
+   begin
+      return Dnodes.Table (Decl).Reg;
+   end Get_Decl_Reg;
+
+   procedure Set_Decl_Reg (Decl : O_Dnode; Reg : O_Reg) is
+   begin
+      Dnodes.Table (Decl).Reg := Reg;
+   end Set_Decl_Reg;
+
+   function Get_Decl_Depth (Decl : O_Dnode) return O_Depth is
+   begin
+      return Dnodes.Table (Decl).Depth;
+   end Get_Decl_Depth;
+
+   function Get_Decl_Chain (Decl : O_Dnode) return O_Dnode is
+   begin
+      case Get_Decl_Kind (Decl) is
+         when OD_Block =>
+            return Get_Block_Last (Decl) + 1;
+         when OD_Body =>
+            return Get_Block_Last (Decl + 1) + 1;
+         when OD_Function
+           | OD_Procedure =>
+            if Use_Subprg_Ext then
+               return Decl + 2;
+            else
+               return Decl + 1;
+            end if;
+         when others =>
+            return Decl + 1;
+      end case;
+   end Get_Decl_Chain;
+
+   function Get_Body_Stmt (Bod : O_Dnode) return O_Enode is
+   begin
+      return Dnodes.Table (Bod).Body_Stmt;
+   end Get_Body_Stmt;
+
+   function Get_Body_Decl (Bod : O_Dnode) return O_Dnode is
+   begin
+      return Dnodes.Table (Bod).Body_Decl;
+   end Get_Body_Decl;
+
+   function Get_Body_Parent (Bod : O_Dnode) return O_Dnode is
+   begin
+      return Dnodes.Table (Bod).Body_Parent;
+   end Get_Body_Parent;
+
+   function Get_Body_Info (Bod : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Bod).Body_Info;
+   end Get_Body_Info;
+
+   procedure Set_Body_Info (Bod : O_Dnode; Info : Int32) is
+   begin
+      Dnodes.Table (Bod).Body_Info := Info;
+   end Set_Body_Info;
+
+   function Get_Decl_Ident (Decl : O_Dnode) return O_Ident is
+   begin
+      return Dnodes.Table (Decl).Id;
+   end Get_Decl_Ident;
+
+   function Get_Decl_Last return O_Dnode is
+   begin
+      return Dnodes.Last;
+   end Get_Decl_Last;
+
+   function Get_Block_Last (Blk : O_Dnode) return O_Dnode is
+   begin
+      return Dnodes.Table (Blk).Last;
+   end Get_Block_Last;
+
+   function Get_Block_Max_Stack (Blk : O_Dnode) return Uns32 is
+   begin
+      return Dnodes.Table (Blk).Block_Max_Stack;
+   end Get_Block_Max_Stack;
+
+   procedure Set_Block_Max_Stack (Blk : O_Dnode; Max : Uns32) is
+   begin
+      Dnodes.Table (Blk).Block_Max_Stack := Max;
+   end Set_Block_Max_Stack;
+
+   function Get_Block_Info1 (Blk : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Blk).Block_Info1;
+   end Get_Block_Info1;
+
+   procedure Set_Block_Info1 (Blk : O_Dnode; Info : Int32) is
+   begin
+      Dnodes.Table (Blk).Block_Info1 := Info;
+   end Set_Block_Info1;
+
+   function Get_Block_Info2 (Blk : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Blk).Block_Info2;
+   end Get_Block_Info2;
+
+   procedure Set_Block_Info2 (Blk : O_Dnode; Info : Int32) is
+   begin
+      Dnodes.Table (Blk).Block_Info2 := Info;
+   end Set_Block_Info2;
+
+   function Get_Subprg_Interfaces (Decl : O_Dnode) return O_Dnode
+   is
+      Res : O_Dnode;
+   begin
+      if Use_Subprg_Ext then
+         Res := Decl + 2;
+      else
+         Res := Decl + 1;
+      end if;
+
+      if Get_Decl_Kind (Res) = OD_Interface then
+         return Res;
+      else
+         return O_Dnode_Null;
+      end if;
+   end Get_Subprg_Interfaces;
+
+   function Get_Interface_Chain (Decl : O_Dnode) return O_Dnode
+   is
+      Res : constant O_Dnode := Decl + 1;
+   begin
+      if Get_Decl_Kind (Res) = OD_Interface then
+         return Res;
+      else
+         return O_Dnode_Null;
+      end if;
+   end Get_Interface_Chain;
+
+   function Get_Val_Decl (Decl : O_Dnode) return O_Dnode is
+   begin
+      return Dnodes.Table (Decl).Val_Decl;
+   end Get_Val_Decl;
+
+   function Get_Val_Val (Decl : O_Dnode) return O_Cnode is
+   begin
+      return Dnodes.Table (Decl).Val_Val;
+   end Get_Val_Val;
+
+   Cur_Depth : O_Depth := O_Toplevel;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Type,
+                                   Storage => O_Storage_Private,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => Atype,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      if Flags.Flag_Type_Name then
+         declare
+            L : O_Tnode;
+         begin
+            L := TDnodes.Last;
+            if Atype > L then
+               TDnodes.Set_Last (Atype);
+               TDnodes.Table (L + 1 .. Atype) := (others => O_Dnode_Null);
+            end if;
+         end;
+         TDnodes.Table (Atype) := Dnodes.Last;
+      end if;
+   end New_Type_Decl;
+
+   function Get_Type_Decl (Atype : O_Tnode) return O_Dnode is
+   begin
+      if Atype <= TDnodes.Last then
+         return TDnodes.Table (Atype);
+      else
+         return O_Dnode_Null;
+      end if;
+   end Get_Type_Decl;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Const,
+                                   Storage => Storage,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => Atype,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      Res := Dnodes.Last;
+      if not Flag_Debug_Hli then
+         Expand_Const_Decl (Res);
+      end if;
+   end New_Const_Decl;
+
+   procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode) is
+   begin
+      if Dnodes.Table (Cst).Info2 /= 0 then
+         --  Value was already set.
+         raise Syntax_Error;
+      end if;
+      Dnodes.Table (Cst).Info2 := Int32 (Val);
+      if Flag_Debug_Hli then
+         Dnodes.Append (Dnode_Common'(Kind => OD_Const_Val,
+                                      Storage => O_Storage_Private,
+                                      Depth => Cur_Depth,
+                                      Reg => R_Nil,
+                                      Val_Decl => Cst,
+                                      Val_Val => Val,
+                                      others => False));
+      else
+         Expand_Const_Value (Cst, Val);
+      end if;
+   end New_Const_Value;
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+   begin
+      if Storage = O_Storage_Local then
+         Dnodes.Append (Dnode_Common'(Kind => OD_Local,
+                                      Storage => Storage,
+                                      Depth => Cur_Depth,
+                                      Reg => R_Nil,
+                                      Id => Ident,
+                                      Dtype => Atype,
+                                      Ref => 0,
+                                      Info2 => 0,
+                                      others => False));
+         Res := Dnodes.Last;
+      else
+         Dnodes.Append (Dnode_Common'(Kind => OD_Var,
+                                      Storage => Storage,
+                                      Depth => Cur_Depth,
+                                      Reg => R_Nil,
+                                      Id => Ident,
+                                      Dtype => Atype,
+                                      Ref => 0,
+                                      Info2 => 0,
+                                      others => False));
+         Res := Dnodes.Last;
+         if not Flag_Debug_Hli then
+            Expand_Var_Decl (Res);
+         end if;
+      end if;
+   end New_Var_Decl;
+
+   Static_Chain_Id : O_Ident := O_Ident_Nul;
+
+   procedure Add_Static_Chain (Interfaces : in out O_Inter_List)
+   is
+      Res : O_Dnode;
+   begin
+      if Static_Chain_Id = O_Ident_Nul then
+         Static_Chain_Id := Ortho_Ident.Get_Identifier ("STATIC_CHAIN");
+      end if;
+
+      New_Interface_Decl (Interfaces, Res, Static_Chain_Id, O_Tnode_Ptr);
+   end Add_Static_Chain;
+
+   procedure Start_Subprogram_Decl (Interfaces : out O_Inter_List)
+   is
+      Storage : O_Storage;
+      Decl : constant O_Dnode := Dnodes.Last;
+   begin
+      Storage := Get_Decl_Storage (Decl);
+      if Cur_Depth /= O_Toplevel then
+         case Storage is
+            when O_Storage_External
+              | O_Storage_Local =>
+               null;
+            when O_Storage_Public =>
+               raise Syntax_Error;
+            when O_Storage_Private =>
+               Storage := O_Storage_Local;
+               Set_Decl_Storage (Decl, Storage);
+         end case;
+      end if;
+      if Use_Subprg_Ext then
+         Dnodes.Append (Dnode_Common'(Kind => OD_Subprg_Ext,
+                                      Storage => Storage,
+                                      Depth => Cur_Depth,
+                                      Reg => R_Nil,
+                                      Subprg_Inter => O_Dnode_Null,
+                                      others => False));
+      end if;
+
+      Start_Subprogram (Decl, Interfaces.Abi);
+      Interfaces.Decl := Decl;
+      if Storage = O_Storage_Local then
+         Add_Static_Chain (Interfaces);
+      end if;
+   end Start_Subprogram_Decl;
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Function,
+                                   Storage => Storage,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => Rtype,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      Start_Subprogram_Decl (Interfaces);
+   end Start_Function_Decl;
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage)
+   is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Procedure,
+                                   Storage => Storage,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => O_Tnode_Null,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      Start_Subprogram_Decl (Interfaces);
+   end Start_Procedure_Decl;
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode)
+   is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Interface,
+                                   Storage => O_Storage_Local,
+                                   Depth => Cur_Depth + 1,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => Atype,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      Res := Dnodes.Last;
+      New_Interface (Res, Interfaces.Abi);
+   end New_Interface_Decl;
+
+   procedure Set_Local_Offset (Decl : O_Dnode; Off : Int32) is
+   begin
+      Dnodes.Table (Decl).Ref := Off;
+   end Set_Local_Offset;
+
+   function Get_Local_Offset (Decl : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Decl).Ref;
+   end Get_Local_Offset;
+
+   function Get_Inter_Offset (Inter : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Inter).Ref;
+   end Get_Inter_Offset;
+
+   procedure Set_Decl_Info (Decl : O_Dnode; Ref : Int32) is
+   begin
+      Dnodes.Table (Decl).Ref := Ref;
+   end Set_Decl_Info;
+
+   function Get_Decl_Info (Decl : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Decl).Ref;
+   end Get_Decl_Info;
+
+   procedure Set_Subprg_Stack (Decl : O_Dnode; Val : Int32) is
+   begin
+      Dnodes.Table (Decl).Info2 := Val;
+   end Set_Subprg_Stack;
+
+   function Get_Subprg_Stack (Decl : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Decl).Info2;
+   end Get_Subprg_Stack;
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode) is
+   begin
+      Res := Interfaces.Decl;
+      Finish_Subprogram (Res, Interfaces.Abi);
+   end Finish_Subprogram_Decl;
+
+   Cur_Block : O_Dnode := O_Dnode_Null;
+
+   function Start_Declare_Stmt return O_Dnode is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Block,
+                                   Storage => O_Storage_Local,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Last => O_Dnode_Null,
+                                   Block_Max_Stack => 0,
+                                   Block_Info1 => 0,
+                                   Block_Info2 => 0,
+                                   others => False));
+      Cur_Block := Dnodes.Last;
+      return Cur_Block;
+   end Start_Declare_Stmt;
+
+   procedure Finish_Declare_Stmt (Parent : O_Dnode) is
+   begin
+      Dnodes.Table (Cur_Block).Last := Dnodes.Last;
+      Cur_Block := Parent;
+   end Finish_Declare_Stmt;
+
+   function Start_Subprogram_Body (Decl : O_Dnode; Stmt : O_Enode)
+                                  return O_Dnode
+   is
+      Res : O_Dnode;
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Body,
+                                   Storage => O_Storage_Local,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Body_Parent => Context,
+                                   Body_Decl => Decl,
+                                   Body_Stmt => Stmt,
+                                   Body_Info => 0,
+                                   others => False));
+      Res := Dnodes.Last;
+      Context := Res;
+      Cur_Depth := Cur_Depth + 1;
+      return Res;
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body is
+   begin
+      Cur_Depth := Cur_Depth - 1;
+      Context := Get_Body_Parent (Context);
+   end Finish_Subprogram_Body;
+
+
+--    function Image (Decl : O_Dnode) return String is
+--    begin
+--       return O_Dnode'Image (Decl);
+--    end Image;
+
+   procedure Disp_Decl_Name (Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Ident;
+      Id : O_Ident;
+   begin
+      Id := Get_Decl_Ident (Decl);
+      if Is_Equal (Id, O_Ident_Nul) then
+         declare
+            Res : String := O_Dnode'Image (Decl);
+         begin
+            Res (1) := '?';
+            Put (Res);
+         end;
+      else
+         Put (Get_String (Id));
+      end if;
+   end Disp_Decl_Name;
+
+   procedure Disp_Decl_Storage (Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+   begin
+      case Get_Decl_Storage (Decl) is
+         when O_Storage_Local =>
+            Put ("local");
+         when O_Storage_External =>
+            Put ("external");
+         when O_Storage_Public =>
+            Put ("public");
+         when O_Storage_Private =>
+            Put ("private");
+      end case;
+   end Disp_Decl_Storage;
+
+   procedure Disp_Decl (Indent : Natural; Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Ident;
+      use Ortho_Code.Debug.Int32_IO;
+   begin
+      Set_Col (Count (Indent));
+      Put (Int32 (Decl), 0);
+      Set_Col (Count (7 + Indent));
+      case Get_Decl_Kind (Decl) is
+         when OD_Type =>
+            Put ("type ");
+            Disp_Decl_Name (Decl);
+            Put (" is ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+         when OD_Function =>
+            Disp_Decl_Storage (Decl);
+            Put (" function ");
+            Disp_Decl_Name (Decl);
+            Put (" return ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+         when OD_Procedure =>
+            Disp_Decl_Storage (Decl);
+            Put (" procedure ");
+            Disp_Decl_Name (Decl);
+         when OD_Interface =>
+            Put (" interface ");
+            Disp_Decl_Name (Decl);
+            Put (": ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+            Put (", offset=");
+            Put (Get_Inter_Offset (Decl), 0);
+         when OD_Const =>
+            Disp_Decl_Storage (Decl);
+            Put (" const ");
+            Disp_Decl_Name (Decl);
+            Put (": ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+         when OD_Const_Val =>
+            Put ("constant ");
+            Disp_Decl_Name (Get_Val_Decl (Decl));
+            Put (": ");
+            Put (Int32 (Get_Val_Val (Decl)), 0);
+         when OD_Local =>
+            Put ("local ");
+            Disp_Decl_Name (Decl);
+            Put (": ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+            Put (", offset=");
+            Put (Get_Inter_Offset (Decl), 0);
+         when OD_Var =>
+            Disp_Decl_Storage (Decl);
+            Put (" var ");
+            Disp_Decl_Name (Decl);
+            Put (": ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+         when OD_Body =>
+            Put ("body of ");
+            Put (Int32 (Get_Body_Decl (Decl)), 0);
+            Put (", stmt at ");
+            Put (Int32 (Get_Body_Stmt (Decl)), 0);
+         when OD_Block =>
+            Put ("block until ");
+            Put (Int32 (Get_Block_Last (Decl)), 0);
+         when OD_Subprg_Ext =>
+            Put ("Subprg_Ext");
+--           when others =>
+--              Put (OD_Kind'Image (Get_Decl_Kind (Decl)));
+      end case;
+      New_Line;
+   end Disp_Decl;
+
+   procedure Disp_Decls (Indent : Natural; First, Last : O_Dnode)
+   is
+      N : O_Dnode;
+   begin
+      N := First;
+      while N <= Last loop
+         case Get_Decl_Kind (N) is
+            when OD_Body =>
+               Disp_Decl (Indent, N);
+               Ortho_Code.Exprs.Disp_Subprg_Body
+                 (Indent + 2, Get_Body_Stmt (N));
+               N := N + 1;
+            when OD_Block =>
+               --  Skip inner bindings.
+               N := Get_Block_Last (N) + 1;
+            when others =>
+               Disp_Decl (Indent, N);
+               N := N + 1;
+         end case;
+      end loop;
+   end Disp_Decls;
+
+   procedure Disp_Block (Indent : Natural; Start : O_Dnode)
+   is
+      Last : O_Dnode;
+   begin
+      if Get_Decl_Kind (Start) /= OD_Block then
+         Disp_Decl (Indent, Start);
+         raise Program_Error;
+      end if;
+      Last := Get_Block_Last (Start);
+      Disp_Decl (Indent, Start);
+      Disp_Decls (Indent, Start + 1, Last);
+   end Disp_Block;
+
+   procedure Disp_All_Decls
+   is
+   begin
+      if False then
+         for I in Dnodes.First .. Dnodes.Last loop
+            Disp_Decl (1, I);
+         end loop;
+      end if;
+
+      Disp_Decls (1, Dnodes.First, Dnodes.Last);
+   end Disp_All_Decls;
+
+   procedure Debug_Decl (Decl : O_Dnode) is
+   begin
+      Disp_Decl (1, Decl);
+   end Debug_Decl;
+
+   pragma Unreferenced (Debug_Decl);
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Dnodes: " & O_Dnode'Image (Dnodes.Last));
+      Put_Line ("Number of TDnodes: " & O_Tnode'Image (TDnodes.Last));
+   end Disp_Stats;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Dnode := Dnodes.Last;
+      M.TDnode := TDnodes.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Dnodes.Set_Last (M.Dnode);
+      TDnodes.Set_Last (M.TDnode);
+   end Release;
+
+   procedure Finish is
+   begin
+      Dnodes.Free;
+      TDnodes.Free;
+   end Finish;
+end Ortho_Code.Decls;
diff --git a/src/ortho/mcode/ortho_code-decls.ads b/src/ortho/mcode/ortho_code-decls.ads
new file mode 100644
index 000000000..ad18892fe
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-decls.ads
@@ -0,0 +1,209 @@
+--  Mcode back-end for ortho - Declarations handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Abi;
+
+package Ortho_Code.Decls is
+   --  Kind of a declaration.
+   type OD_Kind is (OD_Type,
+                    OD_Const, OD_Const_Val,
+
+                    --  Global and local variables.
+                    OD_Var, OD_Local,
+
+                    --  Subprograms.
+                    OD_Function, OD_Procedure,
+
+                    --  Additional node for a subprogram.  Internal use only.
+                    OD_Subprg_Ext,
+
+                    OD_Interface,
+                    OD_Body,
+                    OD_Block);
+
+   --  Return the kind of declaration DECL.
+   function Get_Decl_Kind (Decl : O_Dnode) return OD_Kind;
+
+   --  Return the type of a declaration.
+   function Get_Decl_Type (Decl : O_Dnode) return O_Tnode;
+
+   --  Return the identifier of a declaration.
+   function Get_Decl_Ident (Decl : O_Dnode) return O_Ident;
+
+   --  Return the storage of a declaration.
+   function Get_Decl_Storage (Decl : O_Dnode) return O_Storage;
+
+   --  Return the depth of a declaration.
+   function Get_Decl_Depth (Decl : O_Dnode) return O_Depth;
+
+   --  Register for the declaration.
+   function Get_Decl_Reg (Decl : O_Dnode) return O_Reg;
+   procedure Set_Decl_Reg (Decl : O_Dnode; Reg : O_Reg);
+
+   --  Return the next decl (in the same scope) after DECL.
+   --  This skips declarations in an inner block.
+   function Get_Decl_Chain (Decl : O_Dnode) return O_Dnode;
+
+   --  Get the last declaration.
+   function Get_Decl_Last return O_Dnode;
+
+   --  Return the subprogram declaration correspondig to body BOD.
+   function Get_Body_Decl (Bod : O_Dnode) return O_Dnode;
+
+   --  Return the parent of a body.
+   function Get_Body_Parent (Bod : O_Dnode) return O_Dnode;
+
+   --  Get the entry statement of body DECL.
+   function Get_Body_Stmt (Bod : O_Dnode) return O_Enode;
+
+   --  Get/Set the info field of a body.
+   function Get_Body_Info (Bod : O_Dnode) return Int32;
+   procedure Set_Body_Info (Bod : O_Dnode; Info : Int32);
+
+   --  Get the last declaration of block BLK.
+   function Get_Block_Last (Blk : O_Dnode) return O_Dnode;
+
+   --  Get/Set the block max stack offset.
+   function Get_Block_Max_Stack (Blk : O_Dnode) return Uns32;
+   procedure Set_Block_Max_Stack (Blk : O_Dnode; Max : Uns32);
+
+   --  Info on blocks.
+   function Get_Block_Info1 (Blk : O_Dnode) return Int32;
+   procedure Set_Block_Info1 (Blk : O_Dnode; Info : Int32);
+   function Get_Block_Info2 (Blk : O_Dnode) return Int32;
+   procedure Set_Block_Info2 (Blk : O_Dnode; Info : Int32);
+
+   --  Get the declaration and the value associated with a constant value.
+   function Get_Val_Decl (Decl : O_Dnode) return O_Dnode;
+   function Get_Val_Val (Decl : O_Dnode) return O_Cnode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   --  If Flag_Type_Name is set, a map from type to name is maintained.
+   function Get_Type_Decl (Atype : O_Tnode) return O_Dnode;
+
+   --  Set/Get the offset (or register) of interface or local DECL.
+   --  To be used by ABI.
+   procedure Set_Local_Offset (Decl : O_Dnode; Off : Int32);
+   function Get_Local_Offset (Decl : O_Dnode) return Int32;
+
+   --  Get/Set user info on subprogram, variable, constant declaration.
+   procedure Set_Decl_Info (Decl : O_Dnode; Ref : Int32);
+   function Get_Decl_Info (Decl : O_Dnode) return Int32;
+
+   --  Get/Set the stack size of subprogram arguments.
+   procedure Set_Subprg_Stack (Decl : O_Dnode; Val : Int32);
+   function Get_Subprg_Stack (Decl : O_Dnode) return Int32;
+
+   --  Get the first interface of a subprogram declaration.
+   function Get_Subprg_Interfaces (Decl : O_Dnode) return O_Dnode;
+
+   --  Get the next interface.
+   --  End of interface chain when result is O_Dnode_Null.
+   function Get_Interface_Chain (Decl : O_Dnode) return O_Dnode;
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value to CST.
+   procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   type O_Inter_List is limited private;
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+
+   --  Start subprogram body of DECL.  STMT is the corresponding statement.
+   --  Return the declaration for the body.
+   function Start_Subprogram_Body (Decl : O_Dnode; Stmt : O_Enode)
+                                  return O_Dnode;
+   procedure Finish_Subprogram_Body;
+
+   --  Start a declarative region.
+   function Start_Declare_Stmt return O_Dnode;
+   procedure Finish_Declare_Stmt (Parent : O_Dnode);
+
+   procedure Disp_All_Decls;
+   procedure Disp_Block (Indent : Natural; Start : O_Dnode);
+   procedure Disp_Decl_Name (Decl : O_Dnode);
+   procedure Disp_Decl (Indent : Natural; Decl : O_Dnode);
+   procedure Disp_Stats;
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+   procedure Finish;
+private
+   type O_Inter_List is record
+      --  The declaration of the subprogram.
+      Decl : O_Dnode;
+
+      --  Last declared parameter.
+      Last_Param : O_Dnode;
+
+      --  Data for ABI.
+      Abi : Ortho_Code.Abi.O_Abi_Subprg;
+   end record;
+
+   type Mark_Type is record
+      Dnode : O_Dnode;
+      TDnode : O_Tnode;
+   end record;
+
+end Ortho_Code.Decls;
diff --git a/src/ortho/mcode/ortho_code-disps.adb b/src/ortho/mcode/ortho_code-disps.adb
new file mode 100644
index 000000000..9e8ac1272
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-disps.adb
@@ -0,0 +1,790 @@
+--  Mcode back-end for ortho - Internal tree dumper.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with Ortho_Code.Debug;
+with Ortho_Code.Consts;
+with Ortho_Code.Decls;
+with Ortho_Code.Types;
+with Ortho_Code.Flags;
+with Ortho_Ident;
+with Interfaces;
+
+package body Ortho_Code.Disps is
+   procedure Disp_Subprg (Ident : Natural; S_Entry : O_Enode);
+   procedure Disp_Expr (Expr : O_Enode);
+
+   procedure Disp_Indent (Indent : Natural)
+   is
+   begin
+      Put ((1 .. 2 * Indent => ' '));
+   end Disp_Indent;
+
+   procedure Disp_Ident (Id : O_Ident)
+   is
+      use Ortho_Ident;
+   begin
+      Put (Get_String (Id));
+   end Disp_Ident;
+
+   procedure Disp_Storage (Storage : O_Storage) is
+   begin
+      case Storage is
+         when O_Storage_External =>
+            Put ("external");
+         when O_Storage_Public =>
+            Put ("public");
+         when O_Storage_Private =>
+            Put ("private");
+         when O_Storage_Local =>
+            Put ("local");
+      end case;
+   end Disp_Storage;
+
+   procedure Disp_Label (Label : O_Enode)
+   is
+      N : Int32;
+   begin
+      case Get_Expr_Kind (Label) is
+         when OE_Label =>
+            Put ("label");
+            N := Int32 (Label);
+         when OE_Loop =>
+            Put ("loop");
+            N := Int32 (Label);
+         when OE_BB =>
+            Put ("BB");
+            N := Get_BB_Number (Label);
+         when others =>
+            raise Program_Error;
+      end case;
+      Put (Int32'Image (N));
+      Put (":");
+   end Disp_Label;
+
+   procedure Disp_Call (Call : O_Enode)
+   is
+      Arg : O_Enode;
+   begin
+      Decls.Disp_Decl_Name (Get_Call_Subprg (Call));
+
+      Arg := Get_Arg_Link (Call);
+      if Arg /= O_Enode_Null then
+         Put (" (");
+         loop
+            Disp_Expr (Get_Expr_Operand (Arg));
+            Arg := Get_Arg_Link (Arg);
+            exit when Arg = O_Enode_Null;
+            Put (", ");
+         end loop;
+         Put (")");
+      end if;
+   end Disp_Call;
+
+   procedure Put_Trim (Str : String) is
+   begin
+      if Str (Str'First) = ' ' then
+         Put (Str (Str'First + 1 .. Str'Last));
+      else
+         Put (Str);
+      end if;
+   end Put_Trim;
+
+   procedure Disp_Typed_Lit (Lit : O_Cnode; Val : String)
+   is
+      use Ortho_Code.Consts;
+   begin
+      Disp_Type (Get_Const_Type (Lit));
+      Put ("'[");
+      Put_Trim (Val);
+      Put (']');
+   end Disp_Typed_Lit;
+
+   procedure Disp_Lit (Lit : O_Cnode)
+   is
+      use Interfaces;
+      use Ortho_Code.Consts;
+   begin
+      case Get_Const_Kind (Lit) is
+         when OC_Unsigned =>
+            Disp_Typed_Lit (Lit, Unsigned_64'Image (Get_Const_U64 (Lit)));
+         when OC_Signed =>
+            Disp_Typed_Lit (Lit, Integer_64'Image (Get_Const_I64 (Lit)));
+         when OC_Subprg_Address =>
+            Disp_Type (Get_Const_Type (Lit));
+            Put ("'subprg_addr (");
+            Decls.Disp_Decl_Name (Get_Const_Decl (Lit));
+            Put (")");
+         when OC_Address =>
+            Disp_Type (Get_Const_Type (Lit));
+            Put ("'address (");
+            Decls.Disp_Decl_Name (Get_Const_Decl (Lit));
+            Put (")");
+         when OC_Sizeof =>
+            Disp_Type (Get_Const_Type (Lit));
+            Put ("'sizeof (");
+            Disp_Type (Get_Sizeof_Type (Lit));
+            Put (")");
+         when OC_Null =>
+            Disp_Type (Get_Const_Type (Lit));
+            Put ("'[null]");
+         when OC_Lit =>
+            declare
+               L : O_Cnode;
+            begin
+               L := Types.Get_Type_Enum_Lit
+                 (Get_Const_Type (Lit), Get_Lit_Value (Lit));
+               Disp_Typed_Lit
+                 (Lit, Ortho_Ident.Get_String (Get_Lit_Ident (L)));
+            end;
+         when OC_Array =>
+            Put ('{');
+            for I in 1 .. Get_Const_Aggr_Length (Lit) loop
+               if I /= 1 then
+                  Put (", ");
+               end if;
+               Disp_Lit (Get_Const_Aggr_Element (Lit, I - 1));
+            end loop;
+            Put ('}');
+         when OC_Record =>
+            declare
+               use Ortho_Code.Types;
+               F : O_Fnode;
+            begin
+               F := Get_Type_Record_Fields (Get_Const_Type (Lit));
+               Put ('{');
+               for I in 1 .. Get_Const_Aggr_Length (Lit) loop
+                  if I /= 1 then
+                     Put (", ");
+                  end if;
+                  Put ('.');
+                  Disp_Ident (Get_Field_Ident (F));
+                  Put (" = ");
+                  Disp_Lit (Get_Const_Aggr_Element (Lit, I - 1));
+                  F := Get_Field_Chain (F);
+               end loop;
+               Put ('}');
+            end;
+         when OC_Union =>
+            Put ('{');
+            Put ('.');
+            Disp_Ident (Types.Get_Field_Ident (Get_Const_Union_Field (Lit)));
+            Put ('=');
+            Disp_Lit (Get_Const_Union_Value (Lit));
+            Put ('}');
+         when others =>
+            Put ("*lit " & OC_Kind'Image (Get_Const_Kind (Lit)) & '*');
+      end case;
+   end Disp_Lit;
+
+   procedure Disp_Expr (Expr : O_Enode)
+   is
+      Kind : OE_Kind;
+   begin
+      Kind := Get_Expr_Kind (Expr);
+      case Kind is
+         when OE_Const =>
+            case Get_Expr_Mode (Expr) is
+               when Mode_I8
+                 | Mode_I16
+                 | Mode_I32 =>
+                  Put_Trim (Int32'Image (To_Int32 (Get_Expr_Low (Expr))));
+               when Mode_U8
+                 | Mode_U16
+                 | Mode_U32 =>
+                  Put_Trim (Uns32'Image (Get_Expr_Low (Expr)));
+               when others =>
+                  Put ("const:");
+                  Debug.Disp_Mode (Get_Expr_Mode (Expr));
+            end case;
+         when OE_Lit =>
+            Disp_Lit (Get_Expr_Lit (Expr));
+         when OE_Case_Expr =>
+            Put ("{case}");
+         when OE_Kind_Dyadic
+           | OE_Kind_Cmp
+           | OE_Add
+           | OE_Mul
+           | OE_Shl =>
+            Put ("(");
+            Disp_Expr (Get_Expr_Left (Expr));
+            Put (' ');
+            case Kind is
+               when OE_Eq =>
+                  Put ('=');
+               when OE_Neq =>
+                  Put ("/=");
+               when OE_Lt =>
+                  Put ("<");
+               when OE_Gt =>
+                  Put (">");
+               when OE_Ge =>
+                  Put (">=");
+               when OE_Le =>
+                  Put ("<=");
+               when OE_Add =>
+                  Put ('+');
+               when OE_Mul =>
+                  Put ('*');
+               when OE_Add_Ov =>
+                  Put ("+#");
+               when OE_Sub_Ov =>
+                  Put ("-#");
+               when OE_Mul_Ov =>
+                  Put ("*#");
+               when OE_Shl =>
+                  Put ("<<");
+               when OE_And =>
+                  Put ("and");
+               when OE_Or =>
+                  Put ("or");
+               when others =>
+                  Put (OE_Kind'Image (Kind));
+            end case;
+            Put (' ');
+            Disp_Expr (Get_Expr_Right (Expr));
+            Put (")");
+         when OE_Not =>
+            Put ("not ");
+            Disp_Expr (Get_Expr_Operand (Expr));
+         when OE_Neg_Ov =>
+            Put ("neg ");
+            Disp_Expr (Get_Expr_Operand (Expr));
+         when OE_Abs_Ov =>
+            Put ("abs ");
+            Disp_Expr (Get_Expr_Operand (Expr));
+         when OE_Indir =>
+            declare
+               Op : O_Enode;
+            begin
+               Op := Get_Expr_Operand (Expr);
+               case Get_Expr_Kind (Op) is
+                  when OE_Addrg
+                    | OE_Addrl =>
+                     Decls.Disp_Decl_Name (Get_Addr_Object (Op));
+                  when others =>
+                     --Put ("*");
+                     Disp_Expr (Op);
+               end case;
+            end;
+         when OE_Addrl
+           | OE_Addrg =>
+            -- Put ('@');
+            Decls.Disp_Decl_Name (Get_Addr_Object (Expr));
+         when OE_Call =>
+            Disp_Call (Expr);
+         when OE_Alloca =>
+            Put ("alloca (");
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (")");
+         when OE_Conv =>
+            Disp_Type (Get_Conv_Type (Expr));
+            Put ("'conv (");
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (")");
+         when OE_Conv_Ptr =>
+            Disp_Type (Get_Conv_Type (Expr));
+            Put ("'address (");
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (")");
+         when OE_Typed =>
+            Disp_Type (Get_Conv_Type (Expr));
+            Put ("'");
+            --  Note: there is always parenthesis around comparison.
+            Disp_Expr (Get_Expr_Operand (Expr));
+         when OE_Record_Ref =>
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (".");
+            Disp_Ident (Types.Get_Field_Ident (Get_Ref_Field (Expr)));
+         when OE_Access_Ref =>
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (".all");
+         when OE_Index_Ref =>
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put ('[');
+            Disp_Expr (Get_Ref_Index (Expr));
+            Put (']');
+         when OE_Slice_Ref =>
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put ('[');
+            Disp_Expr (Get_Ref_Index (Expr));
+            Put ("...]");
+         when OE_Get_Stack =>
+            Put ("%sp");
+         when OE_Get_Frame =>
+            Put ("%fp");
+         when others =>
+            Put_Line (Standard_Error, "disps.disp_expr: unknown expr "
+                      & OE_Kind'Image (Kind));
+      end case;
+   end Disp_Expr;
+
+   procedure Disp_Fields (Indent : Natural; Atype : O_Tnode)
+   is
+      use Types;
+      Nbr : Uns32;
+      F : O_Fnode;
+   begin
+      Nbr := Get_Type_Record_Nbr_Fields (Atype);
+      F := Get_Type_Record_Fields (Atype);
+      for I in 1 .. Nbr loop
+         Disp_Indent (Indent);
+         Disp_Ident (Get_Field_Ident (F));
+         Put (": ");
+         Disp_Type (Get_Field_Type (F));
+         Put (";");
+         New_Line;
+         F := Get_Field_Chain (F);
+      end loop;
+   end Disp_Fields;
+
+   procedure Disp_Type (Atype : O_Tnode; Force : Boolean := False)
+   is
+      use Types;
+      Kind : OT_Kind;
+      Decl : O_Dnode;
+   begin
+      if not Force then
+         Decl := Decls.Get_Type_Decl (Atype);
+         if Decl /= O_Dnode_Null then
+            Decls.Disp_Decl_Name (Decl);
+            return;
+         end if;
+      end if;
+
+      Kind := Get_Type_Kind (Atype);
+      case Kind is
+         when OT_Signed =>
+            Put ("signed (");
+            Put_Trim (Uns32'Image (8 * Get_Type_Size (Atype)));
+            Put (")");
+         when OT_Unsigned =>
+            Put ("unsigned (");
+            Put_Trim (Uns32'Image (8 * Get_Type_Size (Atype)));
+            Put (")");
+         when OT_Float =>
+            Put ("float");
+         when OT_Access =>
+            Put ("access");
+            declare
+               Acc_Type : O_Tnode;
+            begin
+               Acc_Type := Get_Type_Access_Type (Atype);
+               if Acc_Type /= O_Tnode_Null then
+                  Put (' ');
+                  Disp_Type (Acc_Type);
+               end if;
+            end;
+         when OT_Ucarray =>
+            Put ("array [");
+            Disp_Type (Get_Type_Ucarray_Index (Atype));
+            Put ("] of ");
+            Disp_Type (Get_Type_Ucarray_Element (Atype));
+         when OT_Subarray =>
+            Put ("subarray ");
+            Disp_Type (Get_Type_Subarray_Base (Atype));
+            Put ("[");
+            Put_Trim (Uns32'Image (Get_Type_Subarray_Length (Atype)));
+            Put ("]");
+         when OT_Record =>
+            Put_Line ("record");
+            Disp_Fields (1, Atype);
+            Put ("end record");
+         when OT_Union =>
+            Put_Line ("union");
+            Disp_Fields (1, Atype);
+            Put ("end union");
+         when OT_Boolean =>
+            declare
+               Lit : O_Cnode;
+            begin
+               Put ("boolean {");
+               Lit := Get_Type_Bool_False (Atype);
+               Disp_Ident (Consts.Get_Lit_Ident (Lit));
+               Put (", ");
+               Lit := Get_Type_Bool_True (Atype);
+               Disp_Ident (Consts.Get_Lit_Ident (Lit));
+               Put ("}");
+            end;
+         when OT_Enum =>
+            declare
+               use Consts;
+               Lit : O_Cnode;
+            begin
+               Put ("enum {");
+               Lit := Get_Type_Enum_Lits (Atype);
+               for I in 1 .. Get_Type_Enum_Nbr_Lits (Atype) loop
+                  if I /= 1 then
+                     Put (", ");
+                  end if;
+                  Disp_Ident (Get_Lit_Ident (Lit));
+                  Put (" =");
+                  Put (Uns32'Image (I - 1));
+                  Lit := Get_Lit_Chain (Lit);
+               end loop;
+               Put ('}');
+            end;
+         when OT_Complete =>
+            Put ("-- complete: ");
+            Disp_Type (Get_Type_Complete_Type (Atype));
+      end case;
+   end Disp_Type;
+
+   procedure Disp_Decl_Storage (Decl : O_Dnode) is
+   begin
+      Disp_Storage (Decls.Get_Decl_Storage (Decl));
+      Put (' ');
+   end Disp_Decl_Storage;
+
+   procedure Disp_Subprg_Decl (Indent : Natural; Decl : O_Dnode)
+   is
+      use Decls;
+      Kind : OD_Kind;
+      Inter : O_Dnode;
+   begin
+      Disp_Decl_Storage (Decl);
+      Kind := Get_Decl_Kind (Decl);
+      case Kind is
+         when OD_Function =>
+            Put ("function ");
+         when OD_Procedure =>
+            Put ("procedure ");
+         when others =>
+            raise Program_Error;
+      end case;
+
+      Disp_Decl_Name (Decl);
+      Inter := Get_Subprg_Interfaces (Decl);
+      Put (" (");
+      New_Line;
+      if Inter /= O_Dnode_Null then
+         loop
+            Disp_Indent (Indent + 1);
+            Disp_Decl_Name (Inter);
+            Put (": ");
+            Disp_Type (Get_Decl_Type (Inter));
+            Inter := Get_Interface_Chain (Inter);
+            exit when Inter = O_Dnode_Null;
+            Put (";");
+            New_Line;
+         end loop;
+      else
+         Disp_Indent (Indent + 1);
+      end if;
+      Put (")");
+      if Kind = OD_Function then
+         New_Line;
+         Disp_Indent (Indent + 1);
+         Put ("return ");
+         Disp_Type (Get_Decl_Type (Decl));
+      end if;
+   end Disp_Subprg_Decl;
+
+   procedure Disp_Decl (Indent : Natural;
+                        Decl : O_Dnode;
+                        Nl : Boolean := False)
+   is
+      use Decls;
+      Kind : OD_Kind;
+      Dtype : O_Tnode;
+   begin
+      Kind := Get_Decl_Kind (Decl);
+      if Kind = OD_Interface then
+         return;
+      end if;
+      Disp_Indent (Indent);
+      case Kind is
+         when OD_Type =>
+            Dtype := Get_Decl_Type (Decl);
+            Put ("type ");
+            Disp_Decl_Name (Decl);
+            Put (" is ");
+            Disp_Type (Dtype, True);
+            Put_Line (";");
+         when OD_Local
+           | OD_Var =>
+            Disp_Decl_Storage (Decl);
+            Put ("var ");
+            Disp_Decl_Name (Decl);
+            Put (" : ");
+            Dtype := Get_Decl_Type (Decl);
+            Disp_Type (Dtype);
+            if True then
+               Put (" {size="
+                    & Uns32'Image (Types.Get_Type_Size (Dtype)) & "}");
+            end if;
+            Put_Line (";");
+         when OD_Const =>
+            Disp_Decl_Storage (Decl);
+            Put ("constant ");
+            Disp_Decl_Name (Decl);
+            Put (" : ");
+            Disp_Type (Get_Decl_Type (Decl));
+            Put_Line (";");
+         when OD_Const_Val =>
+            Put ("constant ");
+            Disp_Decl_Name (Get_Val_Decl (Decl));
+            Put (" := ");
+            Disp_Lit (Get_Val_Val (Decl));
+            Put_Line (";");
+         when OD_Function
+           | OD_Procedure =>
+            Disp_Subprg_Decl (Indent, Decl);
+            Put_Line (";");
+         when OD_Interface =>
+            null;
+         when OD_Body =>
+            --  Put ("body ");
+            Disp_Subprg_Decl (Indent, Get_Body_Decl (Decl));
+            -- Disp_Decl_Name (Get_Body_Decl (Decl));
+            New_Line;
+            Disp_Subprg (Indent, Get_Body_Stmt (Decl));
+         when OD_Block | OD_Subprg_Ext =>
+            null;
+      end case;
+      if Nl then
+         New_Line;
+      end if;
+   end Disp_Decl;
+
+   procedure Disp_Stmt (Indent : in out Natural; Stmt : O_Enode)
+   is
+      use Decls;
+      Expr : O_Enode;
+   begin
+      case Get_Expr_Kind (Stmt) is
+         when OE_Beg =>
+            Disp_Indent (Indent);
+            Put_Line ("declare");
+            declare
+               Last : O_Dnode;
+               Decl : O_Dnode;
+            begin
+               Decl := Get_Block_Decls (Stmt);
+               Last := Get_Block_Last (Decl);
+               Decl := Decl + 1;
+               while Decl <= Last loop
+                  case Get_Decl_Kind (Decl) is
+                     when OD_Block =>
+                        Decl := Get_Block_Last (Decl) + 1;
+                     when others =>
+                        Disp_Decl (Indent + 1, Decl, False);
+                        Decl := Decl + 1;
+                  end case;
+               end loop;
+            end;
+            Disp_Indent (Indent);
+            Put_Line ("begin");
+            Indent := Indent + 1;
+         when OE_End =>
+            Indent := Indent - 1;
+            Disp_Indent (Indent);
+            Put_Line ("end;");
+         when OE_Line =>
+            Disp_Indent (Indent);
+            Put_Line ("--#" & Int32'Image (Get_Expr_Line_Number (Stmt)));
+         when OE_BB =>
+            Disp_Indent (Indent);
+            Put_Line ("# BB" & Int32'Image (Get_BB_Number (Stmt)));
+         when OE_Asgn =>
+            Disp_Indent (Indent);
+            Disp_Expr (Get_Assign_Target (Stmt));
+            Put (" := ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            Put_Line (";");
+         when OE_Call =>
+            Disp_Indent (Indent);
+            Disp_Call (Stmt);
+            Put_Line (";");
+         when OE_Jump_F =>
+            Disp_Indent (Indent);
+            Put ("jump ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            Put (" if not ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Jump_T =>
+            Disp_Indent (Indent);
+            Put ("jump ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            Put (" if ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Jump =>
+            Disp_Indent (Indent);
+            Put ("jump ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            New_Line;
+         when OE_Label =>
+            Disp_Indent (Indent);
+            Disp_Label (Stmt);
+            New_Line;
+         when OE_Ret =>
+            Disp_Indent (Indent);
+            Put ("return");
+            Expr := Get_Expr_Operand (Stmt);
+            if Expr /= O_Enode_Null then
+               Put (" ");
+               Disp_Expr (Expr);
+            end if;
+            Put_Line (";");
+         when OE_Set_Stack =>
+            Disp_Indent (Indent);
+            Put ("%sp := ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            Put_Line (";");
+         when OE_Leave =>
+            Disp_Indent (Indent);
+            Put_Line ("# leave");
+         when OE_If =>
+            Disp_Indent (Indent);
+            Put ("if ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            Put (" then");
+            New_Line;
+            Indent := Indent + 1;
+         when OE_Else =>
+            Disp_Indent (Indent - 1);
+            Put ("else");
+            New_Line;
+         when OE_Endif =>
+            Indent := Indent - 1;
+            Disp_Indent (Indent);
+            Put_Line ("end if;");
+         when OE_Loop =>
+            Disp_Indent (Indent);
+            Disp_Label (Stmt);
+            New_Line;
+            Indent := Indent + 1;
+         when OE_Exit =>
+            Disp_Indent (Indent);
+            Put ("exit ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            Put (";");
+            New_Line;
+         when OE_Next =>
+            Disp_Indent (Indent);
+            Put ("next ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            Put (";");
+            New_Line;
+         when OE_Eloop =>
+            Indent := Indent - 1;
+            Disp_Indent (Indent);
+            Put_Line ("end loop;");
+         when OE_Case =>
+            Disp_Indent (Indent);
+            Put ("case ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            Put (" is");
+            New_Line;
+            if Debug.Flag_Debug_Hli then
+               Indent := Indent + 2;
+            end if;
+         when OE_Case_Branch =>
+            Disp_Indent (Indent - 1);
+            Put ("when ");
+            declare
+               C : O_Enode;
+               L, H : O_Enode;
+            begin
+               C := Get_Case_Branch_Choice (Stmt);
+               loop
+                  L := Get_Expr_Left (C);
+                  H := Get_Expr_Right (C);
+                  if L = O_Enode_Null then
+                     Put ("others");
+                  else
+                     Disp_Expr (L);
+                     if H /= O_Enode_Null then
+                        Put (" ... ");
+                        Disp_Expr (H);
+                     end if;
+                  end if;
+                  C := Get_Case_Choice_Link (C);
+                  exit when C = O_Enode_Null;
+                  New_Line;
+                  Disp_Indent (Indent - 1);
+                  Put ("  | ");
+               end loop;
+               Put (" =>");
+               New_Line;
+            end;
+         when OE_Case_End =>
+            Indent := Indent - 2;
+            Disp_Indent (Indent);
+            Put ("end case;");
+            New_Line;
+         when others =>
+            Put_Line (Standard_Error, "debug.disp_stmt: unknown statement " &
+                      OE_Kind'Image (Get_Expr_Kind (Stmt)));
+      end case;
+   end Disp_Stmt;
+
+   procedure Disp_Subprg (Ident : Natural; S_Entry : O_Enode)
+   is
+      Stmt : O_Enode;
+      N_Ident : Natural := Ident;
+   begin
+      Stmt := S_Entry;
+      loop
+         Stmt := Get_Stmt_Link (Stmt);
+         Disp_Stmt (N_Ident, Stmt);
+         exit when Get_Expr_Kind (Stmt) = OE_Leave;
+      end loop;
+   end Disp_Subprg;
+
+   Last_Decl : O_Dnode := O_Dnode_First;
+
+   procedure Disp_Decls_Until (Last : O_Dnode; Nl : Boolean := False) is
+   begin
+      while Last_Decl <= Last loop
+         Disp_Decl (0, Last_Decl, Nl);
+         Last_Decl := Last_Decl + 1;
+      end loop;
+   end Disp_Decls_Until;
+
+   procedure Disp_Subprg (Subprg : Subprogram_Data_Acc)
+   is
+      use Decls;
+   begin
+      Disp_Decls_Until (Subprg.D_Body, True);
+      if Get_Decl_Kind (Last_Decl) /= OD_Block then
+         raise Program_Error;
+      end if;
+      if Debug.Flag_Debug_Keep then
+         --  If nodes are kept, the next declaration to be displayed (at top
+         --   level) is the one that follow the subprogram block.
+         Last_Decl := Get_Block_Last (Last_Decl) + 1;
+      else
+         --  If nodes are not kept, this subprogram block will be freed, and
+         --  the next declaration is the block itself.
+         Last_Decl := Subprg.D_Body;
+      end if;
+   end Disp_Subprg;
+
+   procedure Init is
+   begin
+      Flags.Flag_Type_Name := True;
+   end Init;
+
+   procedure Finish is
+   begin
+      Disp_Decls_Until (Decls.Get_Decl_Last, True);
+   end Finish;
+
+end Ortho_Code.Disps;
diff --git a/src/ortho/mcode/ortho_code-disps.ads b/src/ortho/mcode/ortho_code-disps.ads
new file mode 100644
index 000000000..5ae4d8697
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-disps.ads
@@ -0,0 +1,25 @@
+--  Mcode back-end for ortho - Internal tree dumper.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+package Ortho_Code.Disps is
+   procedure Disp_Subprg (Subprg : Subprogram_Data_Acc);
+   procedure Disp_Type (Atype : O_Tnode; Force : Boolean := False);
+   procedure Init;
+   procedure Finish;
+end Ortho_Code.Disps;
diff --git a/src/ortho/mcode/ortho_code-dwarf.adb b/src/ortho/mcode/ortho_code-dwarf.adb
new file mode 100644
index 000000000..ad67d1ff6
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-dwarf.adb
@@ -0,0 +1,1351 @@
+--  Mcode back-end for ortho - Dwarf generator.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with GNAT.Directory_Operations;
+with GNAT.Table;
+with Interfaces; use Interfaces;
+with Binary_File; use Binary_File;
+with Dwarf; use Dwarf;
+with Ada.Text_IO;
+with Ortho_Code.Decls;
+with Ortho_Code.Types;
+with Ortho_Code.Consts;
+with Ortho_Code.Flags;
+with Ortho_Ident;
+with Ortho_Code.Binary;
+
+package body Ortho_Code.Dwarf is
+   --  Dwarf debugging format.
+   --  Debugging.
+   Line1_Sect : Section_Acc := null;
+   Line_Last : Int32 := 0;
+   Line_Pc : Pc_Type := 0;
+
+   --  Constant.
+   Min_Insn_Len : constant := 1;
+   Line_Base : constant := 1;
+   Line_Range : constant := 4;
+   Line_Opcode_Base : constant := 13;
+   Line_Max_Addr : constant := (255 - Line_Opcode_Base) / Line_Range;
+   -- + Line_Base;
+
+   Cur_File : Natural := 0;
+   Last_File : Natural := 0;
+
+   Orig_Sym : Symbol;
+   End_Sym : Symbol;
+   Abbrev_Sym : Symbol;
+   Info_Sym : Symbol;
+   Line_Sym : Symbol;
+
+   Line_Sect : Section_Acc;
+   Abbrev_Sect : Section_Acc;
+   Info_Sect : Section_Acc;
+   Aranges_Sect : Section_Acc;
+
+   Abbrev_Last : Unsigned_32;
+
+--     procedure Gen_String (Str : String)
+--     is
+--     begin
+--        for I in Str'Range loop
+--           Gen_B8 (Character'Pos (Str (I)));
+--        end loop;
+--     end Gen_String;
+
+   procedure Gen_String_Nul (Str : String)
+   is
+   begin
+      Prealloc (Str'Length + 1);
+      for I in Str'Range loop
+         Gen_B8 (Character'Pos (Str (I)));
+      end loop;
+      Gen_B8 (0);
+   end Gen_String_Nul;
+
+   procedure Gen_Sleb128 (V : Int32)
+   is
+      V1 : Uns32 := To_Uns32 (V);
+      V2 : Uns32;
+      B : Byte;
+      function Shift_Right_Arithmetic (Value : Uns32; Amount : Natural)
+                                      return Uns32;
+      pragma Import (Intrinsic, Shift_Right_Arithmetic);
+   begin
+      loop
+         B := Byte (V1 and 16#7F#);
+         V2 := Shift_Right_Arithmetic (V1, 7);
+         if (V2 = 0 and (B and 16#40#) = 0)
+           or (V2 = -1 and (B and 16#40#) /= 0)
+         then
+            Gen_B8 (B);
+            exit;
+         else
+            Gen_B8 (B or 16#80#);
+            V1 := V2;
+         end if;
+      end loop;
+   end Gen_Sleb128;
+
+   procedure Gen_Uleb128 (V : Unsigned_32)
+   is
+      V1 : Unsigned_32 := V;
+      B : Byte;
+   begin
+      loop
+         B := Byte (V1 and 16#7f#);
+         V1 := Shift_Right (V1, 7);
+         if V1 /= 0 then
+            Gen_B8 (B or 16#80#);
+         else
+            Gen_B8 (B);
+            exit;
+         end if;
+      end loop;
+   end Gen_Uleb128;
+
+--     procedure New_Debug_Line_Decl (Line : Int32)
+--     is
+--     begin
+--        Line_Last := Line;
+--     end New_Debug_Line_Decl;
+
+   procedure Set_Line_Stmt (Line : Int32)
+   is
+      Pc : Pc_Type;
+      D_Pc : Pc_Type;
+      D_Ln : Int32;
+   begin
+      if Line = Line_Last then
+         return;
+      end if;
+      Pc := Get_Current_Pc;
+
+      D_Pc := (Pc - Line_Pc) / Min_Insn_Len;
+      D_Ln := Line - Line_Last;
+
+      --  Always emit line information, since missing info can distrub the
+      --  user.
+      --  As an optimization, we could try to emit the highest line for the
+      --  same PC, since GDB seems to handle this way.
+      if False and D_Pc = 0 then
+         return;
+      end if;
+
+      Set_Current_Section (Line1_Sect);
+      Prealloc (32);
+
+      if Cur_File /= Last_File then
+         Gen_B8 (Byte (DW_LNS_Set_File));
+         Gen_Uleb128 (Unsigned_32 (Cur_File));
+         Last_File := Cur_File;
+      elsif Cur_File = 0 then
+         return;
+      end if;
+
+      if D_Ln < Line_Base or D_Ln >= (Line_Base + Line_Range) then
+         --  Emit an advance line.
+         Gen_B8 (Byte (DW_LNS_Advance_Line));
+         Gen_Sleb128 (Int32 (D_Ln - Line_Base));
+         D_Ln := Line_Base;
+      end if;
+      if D_Pc >= Line_Max_Addr then
+         --  Emit an advance addr.
+         Gen_B8 (Byte (DW_LNS_Advance_Pc));
+         Gen_Uleb128 (Unsigned_32 (D_Pc));
+         D_Pc := 0;
+      end if;
+      Gen_B8 (Line_Opcode_Base
+              + Byte (D_Pc) * Line_Range
+              + Byte (D_Ln - Line_Base));
+
+      --Set_Current_Section (Text_Sect);
+      Line_Pc := Pc;
+      Line_Last := Line;
+   end Set_Line_Stmt;
+
+
+   type String_Acc is access constant String;
+
+   type Dir_Chain;
+   type Dir_Chain_Acc is access Dir_Chain;
+   type Dir_Chain is record
+      Name : String_Acc;
+      Next : Dir_Chain_Acc;
+   end record;
+
+   type File_Chain;
+   type File_Chain_Acc is access File_Chain;
+   type File_Chain is record
+      Name : String_Acc;
+      Dir : Natural;
+      Next : File_Chain_Acc;
+   end record;
+
+   Dirs : Dir_Chain_Acc := null;
+   Files : File_Chain_Acc := null;
+
+   procedure Set_Filename (Dir : String; File : String)
+   is
+      D : Natural;
+      F : Natural;
+      D_C : Dir_Chain_Acc;
+      F_C : File_Chain_Acc;
+   begin
+      --  Find directory.
+      if Dir = "" then
+         --  Current directory.
+         D := 0;
+      elsif Dirs = null then
+         --  First directory.
+         Dirs := new Dir_Chain'(Name => new String'(Dir),
+                                Next => null);
+         D := 1;
+      else
+         --  Find a directory.
+         D_C := Dirs;
+         D := 1;
+         loop
+            exit when D_C.Name.all = Dir;
+            D := D + 1;
+            if D_C.Next = null then
+               D_C.Next := new Dir_Chain'(Name => new String'(Dir),
+                                          Next => null);
+               exit;
+            else
+               D_C := D_C.Next;
+            end if;
+         end loop;
+      end if;
+
+      --  Find file.
+      F := 1;
+      if Files = null then
+         --  first file.
+         Files := new File_Chain'(Name => new String'(File),
+                                  Dir => D,
+                                  Next => null);
+      else
+         F_C := Files;
+         loop
+            exit when F_C.Name.all = File and F_C.Dir = D;
+            F := F + 1;
+            if F_C.Next = null then
+               F_C.Next := new File_Chain'(Name => new String'(File),
+                                           Dir => D,
+                                           Next => null);
+               exit;
+            else
+               F_C := F_C.Next;
+            end if;
+         end loop;
+      end if;
+      Cur_File := F;
+   end Set_Filename;
+
+   procedure Gen_Abbrev_Header (Tag : Unsigned_32; Child : Byte) is
+   begin
+      Gen_Uleb128 (Tag);
+      Gen_B8 (Child);
+   end Gen_Abbrev_Header;
+
+   procedure Gen_Abbrev_Tuple (Attr : Unsigned_32; Form : Unsigned_32) is
+   begin
+      Gen_Uleb128 (Attr);
+      Gen_Uleb128 (Form);
+   end Gen_Abbrev_Tuple;
+
+   procedure Init
+   is
+   begin
+      --  Generate type names.
+      Flags.Flag_Type_Name := True;
+
+
+      Orig_Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Orig_Sym, False);
+      End_Sym := Create_Local_Symbol;
+
+      Create_Section (Line1_Sect, ".debug_line-1", Section_Debug);
+      Set_Current_Section (Line1_Sect);
+
+      --  Write Address.
+      Gen_B8 (0); -- extended opcode
+      Gen_B8 (5); -- length: 1 + 4
+      Gen_B8 (Byte (DW_LNE_Set_Address));
+      Gen_Ua_32 (Orig_Sym, 0);
+
+      Line_Last := 1;
+
+      Create_Section (Line_Sect, ".debug_line", Section_Debug);
+      Set_Section_Info (Line_Sect, null, 0, 0);
+      Set_Current_Section (Line_Sect);
+      Line_Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Line_Sym, False);
+
+      --  Abbrevs.
+      Create_Section (Abbrev_Sect, ".debug_abbrev", Section_Debug);
+      Set_Section_Info (Abbrev_Sect, null, 0, 0);
+      Set_Current_Section (Abbrev_Sect);
+
+      Abbrev_Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Abbrev_Sym, False);
+
+      Gen_Uleb128 (1);
+      Gen_Abbrev_Header (DW_TAG_Compile_Unit, DW_CHILDREN_Yes);
+
+      Gen_Abbrev_Tuple (DW_AT_Stmt_List, DW_FORM_Data4);
+      Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+      Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+      Gen_Abbrev_Tuple (DW_AT_Producer, DW_FORM_String);
+      Gen_Abbrev_Tuple (DW_AT_Comp_Dir, DW_FORM_String);
+      Gen_Abbrev_Tuple (0, 0);
+
+      Abbrev_Last := 1;
+
+      --  Info.
+      Create_Section (Info_Sect, ".debug_info", Section_Debug);
+      Set_Section_Info (Info_Sect, null, 0, 0);
+      Set_Current_Section (Info_Sect);
+      Info_Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Info_Sym, False);
+
+      Gen_32 (7);  --  Length: to be patched.
+      Gen_16 (2);  --  version
+      Gen_Ua_32 (Abbrev_Sym, 0); --  Abbrev offset
+      Gen_B8 (4);  --  Ptr size.
+
+      --  Compile_unit.
+      Gen_Uleb128 (1);
+      Gen_Ua_32 (Line_Sym, 0);
+      Gen_Ua_32 (Orig_Sym, 0);
+      Gen_Ua_32 (End_Sym, 0);
+      Gen_String_Nul ("T.Gingold ortho_mcode (2004)");
+      Gen_String_Nul (GNAT.Directory_Operations.Get_Current_Dir);
+   end Init;
+
+   procedure Emit_Decl (Decl : O_Dnode);
+
+   --  Next node to be emitted.
+   Last_Decl : O_Dnode := O_Dnode_First;
+
+   procedure Emit_Decls_Until (Last : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      while Last_Decl < Last loop
+         Emit_Decl (Last_Decl);
+         Last_Decl := Get_Decl_Chain (Last_Decl);
+      end loop;
+   end Emit_Decls_Until;
+
+   procedure Finish
+   is
+      Length : Pc_Type;
+      Last : O_Dnode;
+   begin
+      Set_Symbol_Pc (End_Sym, False);
+      Length := Get_Current_Pc;
+
+      Last := Decls.Get_Decl_Last;
+      Emit_Decls_Until (Last);
+      if Last_Decl <= Last then
+         Emit_Decl (Last);
+      end if;
+
+      --  Finish abbrevs.
+      Set_Current_Section (Abbrev_Sect);
+      Gen_Uleb128 (0);
+
+      --  Emit header.
+      Set_Current_Section (Line_Sect);
+
+      --  Unit_Length (to be patched).
+      Gen_32 (0);
+      --  version
+      Gen_16 (2);
+      --  header_length (to be patched).
+      Gen_32 (5 + 12 + 1);
+      --  minimum_instruction_length.
+      Gen_B8 (Min_Insn_Len);
+      --  default_is_stmt
+      Gen_B8 (1);
+      --  line base
+      Gen_B8 (Line_Base);
+      --  line range
+      Gen_B8 (Line_Range);
+      --  opcode base
+      Gen_B8 (Line_Opcode_Base);
+      --  standard_opcode_length.
+      Gen_B8 (0); --  copy
+      Gen_B8 (1); --  advance pc
+      Gen_B8 (1); --  advance line
+      Gen_B8 (1); --  set file
+      Gen_B8 (1); --  set column
+      Gen_B8 (0); --  negate stmt
+      Gen_B8 (0); --  set basic block
+      Gen_B8 (0); --  const add pc
+      Gen_B8 (1); --  fixed advance pc
+      Gen_B8 (0); --  set prologue end
+      Gen_B8 (0); --  set epilogue begin
+      Gen_B8 (1); --  set isa
+      --if Line_Opcode_Base /= 13 then
+      --   raise Program_Error;
+      --end if;
+
+      --  include directories
+      declare
+         D : Dir_Chain_Acc;
+      begin
+         D := Dirs;
+         while D /= null loop
+            Gen_String_Nul (D.Name.all);
+            D := D.Next;
+         end loop;
+         Gen_B8 (0); -- last entry.
+      end;
+
+      --  file_names.
+      declare
+         F : File_Chain_Acc;
+      begin
+         F := Files;
+         while F /= null loop
+            Gen_String_Nul (F.Name.all);
+            Gen_Uleb128 (Unsigned_32 (F.Dir));
+            Gen_B8 (0);  --  time
+            Gen_B8 (0);  --  length
+            F := F.Next;
+         end loop;
+         Gen_B8 (0);  --  last entry.
+      end;
+
+      --  Set prolog length
+      Patch_32 (6, Unsigned_32 (Get_Current_Pc - 6));
+
+      Merge_Section (Line_Sect, Line1_Sect);
+
+      --  Emit end of sequence.
+      Gen_B8 (0); -- extended opcode
+      Gen_B8 (1); -- length: 1
+      Gen_B8 (Byte (DW_LNE_End_Sequence));
+
+      --  Set total length.
+      Patch_32 (0, Unsigned_32 (Get_Current_Pc - 4));
+
+      --  Info.
+      Set_Current_Section (Info_Sect);
+      --  Finish child.
+      Gen_Uleb128 (0);
+      --  Set total length.
+      Patch_32 (0, Unsigned_32 (Get_Current_Pc - 4));
+
+      --  Aranges
+      Create_Section (Aranges_Sect, ".debug_aranges", Section_Debug);
+      Set_Section_Info (Aranges_Sect, null, 0, 0);
+      Set_Current_Section (Aranges_Sect);
+
+      Gen_32 (28);  --  Length.
+      Gen_16 (2);  --  version
+      Gen_Ua_32 (Info_Sym, 0); --  info offset
+      Gen_B8 (4);  --  Ptr size.
+      Gen_B8 (0);  --  seg desc size.
+      Gen_32 (0);  --  pad
+      Gen_Ua_32 (Orig_Sym, 0); --  text offset
+      Gen_32 (Unsigned_32 (Length));
+      Gen_32 (0); --  End
+      Gen_32 (0);
+   end Finish;
+
+   procedure Generate_Abbrev (Abbrev : out Unsigned_32) is
+   begin
+      Abbrev_Last := Abbrev_Last + 1;
+      Abbrev := Abbrev_Last;
+
+      Set_Current_Section (Abbrev_Sect);
+      --  FIXME: should be enough ?
+      Prealloc (128);
+      Gen_Uleb128 (Abbrev);
+   end Generate_Abbrev;
+
+   procedure Gen_Info_Header (Abbrev : Unsigned_32) is
+   begin
+      Set_Current_Section (Info_Sect);
+      Gen_Uleb128 (Abbrev);
+   end Gen_Info_Header;
+
+   function Gen_Info_Sibling return Pc_Type
+   is
+      Pc : Pc_Type;
+   begin
+      Pc := Get_Current_Pc;
+      Gen_32 (0);
+      return Pc;
+   end Gen_Info_Sibling;
+
+   procedure Patch_Info_Sibling (Pc : Pc_Type) is
+   begin
+      Patch_32 (Pc, Unsigned_32 (Get_Current_Pc));
+   end Patch_Info_Sibling;
+
+   Abbrev_Base_Type : Unsigned_32 := 0;
+   Abbrev_Base_Type_Name : Unsigned_32 := 0;
+   Abbrev_Pointer : Unsigned_32 := 0;
+   Abbrev_Pointer_Name : Unsigned_32 := 0;
+   Abbrev_Uncomplete_Pointer : Unsigned_32 := 0;
+   Abbrev_Uncomplete_Pointer_Name : Unsigned_32 := 0;
+   Abbrev_Ucarray : Unsigned_32 := 0;
+   Abbrev_Ucarray_Name : Unsigned_32 := 0;
+   Abbrev_Uc_Subrange : Unsigned_32 := 0;
+   Abbrev_Subarray : Unsigned_32 := 0;
+   Abbrev_Subarray_Name : Unsigned_32 := 0;
+   Abbrev_Subrange : Unsigned_32 := 0;
+   Abbrev_Struct : Unsigned_32 := 0;
+   Abbrev_Struct_Name : Unsigned_32 := 0;
+   Abbrev_Union : Unsigned_32 := 0;
+   Abbrev_Union_Name : Unsigned_32 := 0;
+   Abbrev_Member : Unsigned_32 := 0;
+   Abbrev_Enum : Unsigned_32 := 0;
+   Abbrev_Enum_Name : Unsigned_32 := 0;
+   Abbrev_Enumerator : Unsigned_32 := 0;
+
+   package TOnodes is new GNAT.Table
+     (Table_Component_Type => Pc_Type,
+      Table_Index_Type => O_Tnode,
+      Table_Low_Bound => O_Tnode_First,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   procedure Emit_Type_Ref (Atype : O_Tnode)
+   is
+      Off : Pc_Type;
+   begin
+      Off := TOnodes.Table (Atype);
+      if Off = Null_Pc then
+         raise Program_Error;
+      end if;
+      Gen_32 (Unsigned_32 (Off));
+   end Emit_Type_Ref;
+
+   procedure Emit_Ident (Id : O_Ident)
+   is
+      use Ortho_Ident;
+      L : Natural;
+   begin
+      L := Get_String_Length (Id);
+      Prealloc (Pc_Type (L) + 128);
+      Gen_String_Nul (Get_String (Id));
+   end Emit_Ident;
+
+   procedure Add_Type_Ref (Atype : O_Tnode; Pc : Pc_Type)
+   is
+      Prev : O_Tnode;
+   begin
+      if Atype > TOnodes.Last then
+         --  Expand.
+         Prev := TOnodes.Last;
+         TOnodes.Set_Last (Atype);
+         TOnodes.Table (Prev + 1 .. Atype - 1) := (others => Null_Pc);
+      end if;
+      TOnodes.Table (Atype) := Pc;
+   end Add_Type_Ref;
+
+   procedure Emit_Decl_Ident (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      Emit_Ident (Get_Decl_Ident (Decl));
+   end Emit_Decl_Ident;
+
+   procedure Emit_Decl_Ident_If_Set (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      if Decl /= O_Dnode_Null then
+         Emit_Ident (Get_Decl_Ident (Decl));
+      end if;
+   end Emit_Decl_Ident_If_Set;
+
+   procedure Emit_Type (Atype : O_Tnode);
+
+   procedure Emit_Base_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Encoding, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Base_Type = 0 then
+            Generate_Abbrev (Abbrev_Base_Type);
+            Gen_Abbrev_Header (DW_TAG_Base_Type, DW_CHILDREN_No);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Base_Type);
+      else
+         if Abbrev_Base_Type_Name = 0 then
+            Generate_Abbrev (Abbrev_Base_Type_Name);
+            Gen_Abbrev_Header (DW_TAG_Base_Type, DW_CHILDREN_No);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Base_Type_Name);
+         Emit_Decl_Ident (Decl);
+      end if;
+
+      case Get_Type_Kind (Atype) is
+         when OT_Signed =>
+            Gen_B8 (DW_ATE_Signed);
+         when OT_Unsigned =>
+            Gen_B8 (DW_ATE_Unsigned);
+         when OT_Float =>
+            Gen_B8 (DW_ATE_Float);
+         when others =>
+            raise Program_Error;
+      end case;
+      Gen_B8 (Byte (Get_Type_Size (Atype)));
+   end Emit_Base_Type;
+
+   procedure Emit_Access_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+
+      procedure Finish_Gen_Abbrev_Uncomplete is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev_Uncomplete;
+
+      Dtype : O_Tnode;
+      D_Pc : Pc_Type;
+   begin
+      Dtype := Get_Type_Access_Type (Atype);
+
+      if Dtype = O_Tnode_Null then
+         if Decl = O_Dnode_Null then
+            if Abbrev_Uncomplete_Pointer = 0 then
+               Generate_Abbrev (Abbrev_Uncomplete_Pointer);
+               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
+               Finish_Gen_Abbrev_Uncomplete;
+            end if;
+            Gen_Info_Header (Abbrev_Uncomplete_Pointer);
+         else
+            if Abbrev_Uncomplete_Pointer_Name = 0 then
+               Generate_Abbrev (Abbrev_Uncomplete_Pointer_Name);
+               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
+               Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+               Finish_Gen_Abbrev_Uncomplete;
+            end if;
+            Gen_Info_Header (Abbrev_Uncomplete_Pointer_Name);
+            Emit_Decl_Ident (Decl);
+         end if;
+         Gen_B8 (Byte (Get_Type_Size (Atype)));
+      else
+         if Decl = O_Dnode_Null then
+            if Abbrev_Pointer = 0 then
+               Generate_Abbrev (Abbrev_Pointer);
+               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
+               Finish_Gen_Abbrev;
+            end if;
+            Gen_Info_Header (Abbrev_Pointer);
+         else
+            if Abbrev_Pointer_Name = 0 then
+               Generate_Abbrev (Abbrev_Pointer_Name);
+               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
+               Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+               Finish_Gen_Abbrev;
+            end if;
+            Gen_Info_Header (Abbrev_Pointer_Name);
+            Emit_Decl_Ident (Decl);
+         end if;
+         Gen_B8 (Byte (Get_Type_Size (Atype)));
+         --  Break possible loops: generate the access entry...
+         D_Pc := Get_Current_Pc;
+         Gen_32 (0);
+         --  ... generate the designated type ...
+         Emit_Type (Dtype);
+         --  ... and write its reference.
+         Patch_32 (D_Pc, Unsigned_32 (TOnodes.Table (Dtype)));
+      end if;
+   end Emit_Access_Type;
+
+   procedure Emit_Ucarray_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Ucarray = 0 then
+            Generate_Abbrev (Abbrev_Ucarray);
+            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Ucarray);
+      else
+         if Abbrev_Ucarray_Name = 0 then
+            Generate_Abbrev (Abbrev_Ucarray_Name);
+            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Ucarray_Name);
+         Emit_Decl_Ident (Decl);
+      end if;
+      Emit_Type_Ref (Get_Type_Ucarray_Element (Atype));
+
+      if Abbrev_Uc_Subrange = 0 then
+         Generate_Abbrev (Abbrev_Uc_Subrange);
+         Gen_Abbrev_Header (DW_TAG_Subrange_Type, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Gen_Info_Header (Abbrev_Uc_Subrange);
+      Emit_Type_Ref (Get_Type_Ucarray_Index (Atype));
+
+      Gen_Uleb128 (0);
+   end Emit_Ucarray_Type;
+
+   procedure Emit_Subarray_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+
+      Base : O_Tnode;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Subarray = 0 then
+            Generate_Abbrev (Abbrev_Subarray);
+            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Subarray);
+      else
+         if Abbrev_Subarray_Name = 0 then
+            Generate_Abbrev (Abbrev_Subarray_Name);
+            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Subarray_Name);
+         Emit_Decl_Ident (Decl);
+      end if;
+
+      Base := Get_Type_Subarray_Base (Atype);
+
+      Emit_Type_Ref (Get_Type_Ucarray_Element (Base));
+      Gen_Uleb128 (Unsigned_32 (Get_Type_Size (Atype)));
+
+      if Abbrev_Subrange = 0 then
+         Generate_Abbrev (Abbrev_Subrange);
+         Gen_Abbrev_Header (DW_TAG_Subrange_Type, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Lower_Bound, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (DW_AT_Count, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Gen_Info_Header (Abbrev_Subrange);
+      Emit_Type_Ref (Get_Type_Ucarray_Index (Base));
+      Gen_B8 (0);
+      Gen_Uleb128 (Unsigned_32 (Get_Type_Subarray_Length (Atype)));
+
+      Gen_Uleb128 (0);
+   end Emit_Subarray_Type;
+
+   procedure Emit_Members (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      Nbr : Uns32;
+      F : O_Fnode;
+      Loc_Pc : Pc_Type;
+      Sibling_Pc : Pc_Type;
+   begin
+      if Abbrev_Member = 0 then
+         Generate_Abbrev (Abbrev_Member);
+
+         Gen_Abbrev_Header (DW_TAG_Member, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Data_Member_Location, DW_FORM_Block1);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Set_Current_Section (Info_Sect);
+      Sibling_Pc := Gen_Info_Sibling;
+      Emit_Decl_Ident_If_Set (Decl);
+      Gen_Uleb128 (Unsigned_32 (Get_Type_Size (Atype)));
+
+      Nbr := Get_Type_Record_Nbr_Fields (Atype);
+      F := Get_Type_Record_Fields (Atype);
+      while Nbr > 0 loop
+         Gen_Uleb128 (Abbrev_Member);
+         Emit_Ident (Get_Field_Ident (F));
+         Emit_Type_Ref (Get_Field_Type (F));
+
+         --  Location.
+         Loc_Pc := Get_Current_Pc;
+         Gen_B8 (3);
+         Gen_B8 (DW_OP_Plus_Uconst);
+         Gen_Uleb128 (Unsigned_32 (Get_Field_Offset (F)));
+         Patch_B8 (Loc_Pc, Unsigned_8 (Get_Current_Pc - (Loc_Pc + 1)));
+
+         F := Get_Field_Chain (F);
+         Nbr := Nbr - 1;
+      end loop;
+
+      --  end of children.
+      Gen_Uleb128 (0);
+      Patch_Info_Sibling (Sibling_Pc);
+   end Emit_Members;
+
+   procedure Emit_Record_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Struct = 0 then
+            Generate_Abbrev (Abbrev_Struct);
+
+            Gen_Abbrev_Header (DW_TAG_Structure_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Struct);
+      else
+         if Abbrev_Struct_Name = 0 then
+            Generate_Abbrev (Abbrev_Struct_Name);
+
+            Gen_Abbrev_Header (DW_TAG_Structure_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Struct_Name);
+      end if;
+      Emit_Members (Atype, Decl);
+   end Emit_Record_Type;
+
+   procedure Emit_Union_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Union = 0 then
+            Generate_Abbrev (Abbrev_Union);
+
+            Gen_Abbrev_Header (DW_TAG_Union_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Union);
+      else
+         if Abbrev_Union_Name = 0 then
+            Generate_Abbrev (Abbrev_Union_Name);
+
+            Gen_Abbrev_Header (DW_TAG_Union_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Union_Name);
+      end if;
+      Emit_Members (Atype, Decl);
+   end Emit_Union_Type;
+
+   procedure Emit_Enum_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      use Ortho_Code.Consts;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+
+      procedure Emit_Enumerator (L : O_Cnode) is
+      begin
+         Gen_Uleb128 (Abbrev_Enumerator);
+         Emit_Ident (Get_Lit_Ident (L));
+         Gen_Uleb128 (Unsigned_32 (Get_Lit_Value (L)));
+      end Emit_Enumerator;
+
+      Nbr : Uns32;
+      L : O_Cnode;
+      Sibling_Pc : Pc_Type;
+   begin
+      if Abbrev_Enumerator = 0 then
+         Generate_Abbrev (Abbrev_Enumerator);
+
+         Gen_Abbrev_Header (DW_TAG_Enumerator, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+         Gen_Abbrev_Tuple (DW_AT_Const_Value, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+      if Decl = O_Dnode_Null then
+         if Abbrev_Enum = 0 then
+            Generate_Abbrev (Abbrev_Enum);
+            Gen_Abbrev_Header (DW_TAG_Enumeration_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Enum);
+      else
+         if Abbrev_Enum_Name = 0 then
+            Generate_Abbrev (Abbrev_Enum_Name);
+            Gen_Abbrev_Header (DW_TAG_Enumeration_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Enum_Name);
+      end if;
+
+      Sibling_Pc := Gen_Info_Sibling;
+      Emit_Decl_Ident_If_Set (Decl);
+      Gen_B8 (Byte (Get_Type_Size (Atype)));
+      case Get_Type_Kind (Atype) is
+         when OT_Enum =>
+            Nbr := Get_Type_Enum_Nbr_Lits (Atype);
+            L := Get_Type_Enum_Lits (Atype);
+            while Nbr > 0 loop
+               Emit_Enumerator (L);
+
+               L := Get_Lit_Chain (L);
+               Nbr := Nbr - 1;
+            end loop;
+         when OT_Boolean =>
+            Emit_Enumerator (Get_Type_Bool_False (Atype));
+            Emit_Enumerator (Get_Type_Bool_True (Atype));
+         when others =>
+            raise Program_Error;
+      end case;
+
+      --  End of children.
+      Gen_Uleb128 (0);
+      Patch_Info_Sibling (Sibling_Pc);
+   end Emit_Enum_Type;
+
+   procedure Emit_Type (Atype : O_Tnode)
+   is
+      use Ortho_Code.Types;
+      use Ada.Text_IO;
+      Kind : OT_Kind;
+      Decl : O_Dnode;
+   begin
+      --  If already emitted, then return.
+      if Atype <= TOnodes.Last
+        and then TOnodes.Table (Atype) /= Null_Pc
+      then
+         return;
+      end if;
+
+      Kind := Get_Type_Kind (Atype);
+
+      --  First step: emit inner types (if any).
+      case Kind is
+         when OT_Signed
+           | OT_Unsigned
+           | OT_Float
+           | OT_Boolean
+           | OT_Enum =>
+            null;
+         when OT_Access =>
+            null;
+         when OT_Ucarray =>
+            Emit_Type (Get_Type_Ucarray_Index (Atype));
+            Emit_Type (Get_Type_Ucarray_Element (Atype));
+         when OT_Subarray =>
+            Emit_Type (Get_Type_Subarray_Base (Atype));
+         when OT_Record
+           | OT_Union =>
+            declare
+               Nbr : Uns32;
+               F : O_Fnode;
+            begin
+               Nbr := Get_Type_Record_Nbr_Fields (Atype);
+               F := Get_Type_Record_Fields (Atype);
+               while Nbr > 0 loop
+                  Emit_Type (Get_Field_Type (F));
+                  F := Get_Field_Chain (F);
+                  Nbr := Nbr - 1;
+               end loop;
+            end;
+         when OT_Complete =>
+            null;
+      end case;
+
+      Set_Current_Section (Info_Sect);
+      Add_Type_Ref (Atype, Get_Current_Pc);
+
+      Decl := Decls.Get_Type_Decl (Atype);
+
+      --  Second step: emit info.
+      case Kind is
+         when OT_Signed
+           | OT_Unsigned
+           | OT_Float =>
+            Emit_Base_Type (Atype, Decl);
+            -- base types.
+         when OT_Access =>
+            Emit_Access_Type (Atype, Decl);
+         when OT_Ucarray =>
+            Emit_Ucarray_Type (Atype, Decl);
+         when OT_Subarray =>
+            Emit_Subarray_Type (Atype, Decl);
+         when OT_Record =>
+            Emit_Record_Type (Atype, Decl);
+         when OT_Union =>
+            Emit_Union_Type (Atype, Decl);
+         when OT_Enum
+           | OT_Boolean =>
+            Emit_Enum_Type (Atype, Decl);
+         when OT_Complete =>
+            null;
+      end case;
+   end Emit_Type;
+
+   procedure Emit_Decl_Type (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      Emit_Type_Ref (Get_Decl_Type (Decl));
+   end Emit_Decl_Type;
+
+   Abbrev_Variable : Unsigned_32 := 0;
+   Abbrev_Const : Unsigned_32 := 0;
+
+   procedure Emit_Local_Location (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Pc : Pc_Type;
+   begin
+      Pc := Get_Current_Pc;
+      Gen_B8 (2);
+      Gen_B8 (DW_OP_Fbreg);
+      Gen_Sleb128 (Get_Decl_Info (Decl));
+      Patch_B8 (Pc, Unsigned_8 (Get_Current_Pc - (Pc + 1)));
+   end Emit_Local_Location;
+
+   procedure Emit_Global_Location (Decl : O_Dnode)
+   is
+      use Ortho_Code.Binary;
+   begin
+      Gen_B8 (5);
+      Gen_B8 (DW_OP_Addr);
+      Gen_Ua_32 (Get_Decl_Symbol (Decl), 0);
+   end Emit_Global_Location;
+
+   procedure Emit_Variable (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Dtype : O_Tnode;
+   begin
+      if Get_Decl_Ident (Decl) = O_Ident_Nul then
+         return;
+      end if;
+
+      if Abbrev_Variable = 0 then
+         Generate_Abbrev (Abbrev_Variable);
+         Gen_Abbrev_Header (DW_TAG_Variable, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Dtype := Get_Decl_Type (Decl);
+      Emit_Type (Dtype);
+
+      Gen_Info_Header (Abbrev_Variable);
+      Emit_Decl_Ident (Decl);
+      Emit_Type_Ref (Dtype);
+      case Get_Decl_Kind (Decl) is
+         when OD_Local =>
+            Emit_Local_Location (Decl);
+         when OD_Var =>
+            Emit_Global_Location (Decl);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Emit_Variable;
+
+   procedure Emit_Const (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Dtype : O_Tnode;
+   begin
+      if Abbrev_Const = 0 then
+         Generate_Abbrev (Abbrev_Const);
+         --  FIXME: should be a TAG_Constant, however, GDB does not support it.
+         --  work-around: could use a const_type.
+         Gen_Abbrev_Header (DW_TAG_Variable, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Dtype := Get_Decl_Type (Decl);
+      Emit_Type (Dtype);
+      Gen_Info_Header (Abbrev_Const);
+      Emit_Decl_Ident (Decl);
+      Emit_Type_Ref (Dtype);
+      Emit_Global_Location (Decl);
+   end Emit_Const;
+
+   procedure Emit_Type_Decl (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      Emit_Type (Get_Decl_Type (Decl));
+   end Emit_Type_Decl;
+
+   Subprg_Sym : Symbol;
+
+   Abbrev_Block : Unsigned_32 := 0;
+
+   procedure Emit_Block_Decl (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Last : O_Dnode;
+      Sdecl : O_Dnode;
+      Sibling_Pc : Pc_Type;
+   begin
+      if Abbrev_Block = 0 then
+         Generate_Abbrev (Abbrev_Block);
+
+         Gen_Abbrev_Header (DW_TAG_Lexical_Block, DW_CHILDREN_Yes);
+         Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+         Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Gen_Info_Header (Abbrev_Block);
+      Sibling_Pc := Gen_Info_Sibling;
+
+      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info1 (Decl)));
+      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info2 (Decl)));
+
+      --  Emit decls for children.
+      Last := Get_Block_Last (Decl);
+      Sdecl := Decl + 1;
+      while Sdecl <= Last loop
+         Emit_Decl (Sdecl);
+         Sdecl := Get_Decl_Chain (Sdecl);
+      end loop;
+
+      --  End of children.
+      Set_Current_Section (Info_Sect);
+      Gen_Uleb128 (0);
+
+      Patch_Info_Sibling (Sibling_Pc);
+   end Emit_Block_Decl;
+
+   Abbrev_Function : Unsigned_32 := 0;
+   Abbrev_Procedure : Unsigned_32 := 0;
+   Abbrev_Interface : Unsigned_32 := 0;
+
+   procedure Emit_Subprg_Body (Bod : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Kind : OD_Kind;
+      Decl : O_Dnode;
+      Idecl : O_Dnode;
+      Prev_Subprg_Sym : Symbol;
+      Sibling_Pc : Pc_Type;
+   begin
+      Decl := Get_Body_Decl (Bod);
+      Kind := Get_Decl_Kind (Decl);
+
+      --  Emit interfaces type.
+      Idecl := Get_Subprg_Interfaces (Decl);
+      while Idecl /= O_Dnode_Null loop
+         Emit_Type (Get_Decl_Type (Idecl));
+         Idecl := Get_Interface_Chain (Idecl);
+      end loop;
+
+      if Kind = OD_Function then
+         Emit_Type (Get_Decl_Type (Decl));
+         if Abbrev_Function = 0 then
+            Generate_Abbrev (Abbrev_Function);
+
+            Gen_Abbrev_Header (DW_TAG_Subprogram, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+
+            Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+            Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+            Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
+            --Gen_Abbrev_Tuple (DW_AT_Return_Addr, DW_FORM_Block1);
+            Gen_Abbrev_Tuple (0, 0);
+         end if;
+         Gen_Info_Header (Abbrev_Function);
+      else
+         if Abbrev_Procedure = 0 then
+            Generate_Abbrev (Abbrev_Procedure);
+
+            Gen_Abbrev_Header (DW_TAG_Subprogram, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+            Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+            Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
+            --Gen_Abbrev_Tuple (DW_AT_Return_Addr, DW_FORM_Block1);
+            Gen_Abbrev_Tuple (0, 0);
+         end if;
+         Gen_Info_Header (Abbrev_Procedure);
+      end if;
+
+      Sibling_Pc := Gen_Info_Sibling;
+
+      if Kind = OD_Function then
+         Emit_Decl_Type (Decl);
+      end if;
+
+      Emit_Decl_Ident (Decl);
+      Prev_Subprg_Sym := Subprg_Sym;
+      Subprg_Sym := Binary.Get_Decl_Symbol (Decl);
+      Gen_Ua_32 (Subprg_Sym, 0);
+      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Body_Info (Bod)));
+
+      --  Frame base.
+      Gen_B8 (1);
+      Gen_B8 (DW_OP_Reg5);
+
+      --  Interfaces.
+      Idecl := Get_Subprg_Interfaces (Decl);
+      if Idecl /= O_Dnode_Null then
+         if Abbrev_Interface = 0 then
+            Generate_Abbrev (Abbrev_Interface);
+
+            Gen_Abbrev_Header (DW_TAG_Formal_Parameter, DW_CHILDREN_No);
+            Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
+            Gen_Abbrev_Tuple (0, 0);
+         end if;
+
+         loop
+            Gen_Info_Header (Abbrev_Interface);
+            Emit_Decl_Type (Idecl);
+            Emit_Decl_Ident (Idecl);
+
+            Emit_Local_Location (Idecl);
+
+            Idecl := Get_Interface_Chain (Idecl);
+            exit when Idecl = O_Dnode_Null;
+         end loop;
+      end if;
+
+      --  Internal declarations.
+      Emit_Block_Decl (Bod + 1);
+
+      --  End of children.
+      Gen_Uleb128 (0);
+
+      Patch_Info_Sibling (Sibling_Pc);
+
+      Subprg_Sym := Prev_Subprg_Sym;
+   end Emit_Subprg_Body;
+
+   procedure Emit_Decl (Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Decls;
+   begin
+      case Get_Decl_Kind (Decl) is
+         when OD_Type =>
+            Emit_Type_Decl (Decl);
+         when OD_Local
+           | OD_Var =>
+            Emit_Variable (Decl);
+         when OD_Const =>
+            Emit_Const (Decl);
+         when OD_Function
+           | OD_Procedure
+           | OD_Interface =>
+            null;
+         when OD_Body =>
+            Emit_Subprg_Body (Decl);
+         when OD_Block =>
+            Emit_Block_Decl (Decl);
+         when others =>
+            Put_Line ("dwarf.emit_decl: emit "
+                      & OD_Kind'Image (Get_Decl_Kind (Decl)));
+      end case;
+   end Emit_Decl;
+
+   procedure Emit_Subprg (Bod : O_Dnode) is
+   begin
+      Emit_Decls_Until (Bod);
+      Emit_Decl (Bod);
+      Last_Decl := Decls.Get_Decl_Chain (Bod);
+   end Emit_Subprg;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Last_Decl := Last_Decl;
+      M.Last_Tnode := TOnodes.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Last_Decl := M.Last_Decl;
+      TOnodes.Set_Last (M.Last_Tnode);
+   end Release;
+
+end Ortho_Code.Dwarf;
+
diff --git a/src/ortho/mcode/ortho_code-dwarf.ads b/src/ortho/mcode/ortho_code-dwarf.ads
new file mode 100644
index 000000000..c120bcfe1
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-dwarf.ads
@@ -0,0 +1,41 @@
+--  Mcode back-end for ortho - Dwarf generator.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Ortho_Code.Dwarf is
+   procedure Init;
+   procedure Finish;
+
+   --  For a body.
+   procedure Emit_Subprg (Bod : O_Dnode);
+
+   --  Emit all debug info until but not including LAST.
+   procedure Emit_Decls_Until (Last : O_Dnode);
+
+   --  For a line in a subprogram.
+   procedure Set_Line_Stmt (Line : Int32);
+   procedure Set_Filename (Dir : String; File : String);
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+private
+   type Mark_Type is record
+      Last_Decl : O_Dnode;
+      Last_Tnode : O_Tnode;
+   end record;
+end Ortho_Code.Dwarf;
diff --git a/src/ortho/mcode/ortho_code-exprs.adb b/src/ortho/mcode/ortho_code-exprs.adb
new file mode 100644
index 000000000..b2dfa1a67
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-exprs.adb
@@ -0,0 +1,1663 @@
+--  Mcode back-end for ortho - Expressions and control handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with GNAT.Table;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Consts; use Ortho_Code.Consts;
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Debug; use Ortho_Code.Debug;
+with Ortho_Code.Abi; use Ortho_Code.Abi;
+with Ortho_Code.Disps;
+with Ortho_Code.Opts;
+with Ortho_Code.Flags;
+
+package body Ortho_Code.Exprs is
+
+   type Enode_Pad is mod 256;
+
+   type Enode_Common is record
+      Kind : OE_Kind; --  about 1 byte (6 bits)
+      Reg : O_Reg; --  1 byte
+      Mode : Mode_Type; -- 4 bits
+      Ref : Boolean;
+      Flag1 : Boolean;
+      Flag2 : Boolean;
+      Flag3 : Boolean;
+      Pad : Enode_Pad;
+      Arg1 : O_Enode;
+      Arg2 : O_Enode;
+      Info : Int32;
+   end record;
+   pragma Pack (Enode_Common);
+   for Enode_Common'Size use 4*32;
+   for Enode_Common'Alignment use 4;
+
+   package Enodes is new GNAT.Table
+     (Table_Component_Type => Enode_Common,
+      Table_Index_Type => O_Enode,
+      Table_Low_Bound => 2,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   function Get_Expr_Kind (Enode : O_Enode) return OE_Kind is
+   begin
+      return Enodes.Table (Enode).Kind;
+   end Get_Expr_Kind;
+
+   function Get_Expr_Mode (Enode : O_Enode) return Mode_Type is
+   begin
+      return Enodes.Table (Enode).Mode;
+   end Get_Expr_Mode;
+
+   function Get_Enode_Type (Enode : O_Enode) return O_Tnode is
+   begin
+      return O_Tnode (Enodes.Table (Enode).Info);
+   end Get_Enode_Type;
+
+   function Get_Expr_Reg (Enode : O_Enode) return O_Reg is
+   begin
+      return Enodes.Table (Enode).Reg;
+   end Get_Expr_Reg;
+
+   procedure Set_Expr_Reg (Enode : O_Enode; Reg : O_Reg) is
+   begin
+      Enodes.Table (Enode).Reg := Reg;
+   end Set_Expr_Reg;
+
+   function Get_Expr_Operand (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg1;
+   end Get_Expr_Operand;
+
+   procedure Set_Expr_Operand (Enode : O_Enode; Val : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg1 := Val;
+   end Set_Expr_Operand;
+
+   function Get_Expr_Left (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg1;
+   end Get_Expr_Left;
+
+   function Get_Expr_Right (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Expr_Right;
+
+   procedure Set_Expr_Left (Enode : O_Enode; Val : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg1 := Val;
+   end Set_Expr_Left;
+
+   procedure Set_Expr_Right (Enode : O_Enode; Val : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg2 := Val;
+   end Set_Expr_Right;
+
+   function Get_Expr_Low (Cst : O_Enode) return Uns32 is
+   begin
+      return To_Uns32 (Int32 (Enodes.Table (Cst).Arg1));
+   end Get_Expr_Low;
+
+   function Get_Expr_High (Cst : O_Enode) return Uns32 is
+   begin
+      return To_Uns32 (Int32 (Enodes.Table (Cst).Arg2));
+   end Get_Expr_High;
+
+   function Get_Assign_Target (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Assign_Target;
+
+   procedure Set_Assign_Target (Enode : O_Enode; Targ : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg2 := Targ;
+   end Set_Assign_Target;
+
+   function Get_Expr_Lit (Lit : O_Enode) return O_Cnode is
+   begin
+      return O_Cnode (Enodes.Table (Lit).Arg1);
+   end Get_Expr_Lit;
+
+   function Get_Conv_Type (Enode : O_Enode) return O_Tnode is
+   begin
+      return O_Tnode (Enodes.Table (Enode).Arg2);
+   end Get_Conv_Type;
+
+   --  Leave node corresponding to the entry.
+   function Get_Entry_Leave (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg1;
+   end Get_Entry_Leave;
+
+   procedure Set_Entry_Leave (Enode : O_Enode; Leave : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg1 := Leave;
+   end Set_Entry_Leave;
+
+   function Get_Jump_Label (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Jump_Label;
+
+   procedure Set_Jump_Label (Enode : O_Enode; Label : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg2 := Label;
+   end Set_Jump_Label;
+
+   function Get_Addr_Object (Enode : O_Enode) return O_Dnode is
+   begin
+      return O_Dnode (Enodes.Table (Enode).Arg1);
+   end Get_Addr_Object;
+
+   function Get_Addrl_Frame (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Addrl_Frame;
+
+   procedure Set_Addrl_Frame (Enode : O_Enode; Frame : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg2 := Frame;
+   end Set_Addrl_Frame;
+
+   function Get_Call_Subprg (Enode : O_Enode) return O_Dnode is
+   begin
+      return O_Dnode (Enodes.Table (Enode).Arg1);
+   end Get_Call_Subprg;
+
+   function Get_Stack_Adjust (Enode : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Enode).Arg1);
+   end Get_Stack_Adjust;
+
+   function Get_Arg_Link (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Arg_Link;
+
+   function Get_Block_Decls (Blk : O_Enode) return O_Dnode is
+   begin
+      return O_Dnode (Enodes.Table (Blk).Arg2);
+   end Get_Block_Decls;
+
+   function Get_Block_Parent (Blk : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Blk).Arg1;
+   end Get_Block_Parent;
+
+   function Get_Block_Has_Alloca (Blk : O_Enode) return Boolean is
+   begin
+      return Enodes.Table (Blk).Flag1;
+   end Get_Block_Has_Alloca;
+
+   procedure Set_Block_Has_Alloca (Blk : O_Enode; Flag : Boolean) is
+   begin
+      Enodes.Table (Blk).Flag1 := Flag;
+   end Set_Block_Has_Alloca;
+
+   function Get_End_Beg (Blk : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Blk).Arg1;
+   end Get_End_Beg;
+
+   function Get_Label_Info (Label : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Label).Arg2);
+   end Get_Label_Info;
+
+   procedure Set_Label_Info (Label : O_Enode; Info : Int32) is
+   begin
+      Enodes.Table (Label).Arg2 := O_Enode (Info);
+   end Set_Label_Info;
+
+   function Get_Label_Block (Label : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Label).Arg1;
+   end Get_Label_Block;
+
+   function Get_Spill_Info (Spill : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Spill).Arg2);
+   end Get_Spill_Info;
+
+   procedure Set_Spill_Info (Spill : O_Enode; Info : Int32) is
+   begin
+      Enodes.Table (Spill).Arg2 := O_Enode (Info);
+   end Set_Spill_Info;
+
+   --  Get the statement link.
+   function Get_Stmt_Link (Stmt : O_Enode) return O_Enode is
+   begin
+      return O_Enode (Enodes.Table (Stmt).Info);
+   end Get_Stmt_Link;
+
+   procedure Set_Stmt_Link (Stmt : O_Enode; Next : O_Enode) is
+   begin
+      Enodes.Table (Stmt).Info := Int32 (Next);
+   end Set_Stmt_Link;
+
+   function Get_BB_Next (Stmt : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Stmt).Arg1;
+   end Get_BB_Next;
+   pragma Unreferenced (Get_BB_Next);
+
+   procedure Set_BB_Next (Stmt : O_Enode; Next : O_Enode) is
+   begin
+      Enodes.Table (Stmt).Arg1 := Next;
+   end Set_BB_Next;
+
+   function Get_BB_Number (Stmt : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Stmt).Arg2);
+   end Get_BB_Number;
+
+   function Get_Loop_Level (Stmt : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Stmt).Arg1);
+   end Get_Loop_Level;
+
+   procedure Set_Loop_Level (Stmt : O_Enode; Level : Int32) is
+   begin
+      Enodes.Table (Stmt).Arg1 := O_Enode (Level);
+   end Set_Loop_Level;
+
+   procedure Set_Case_Branch (C : O_Enode; Branch : O_Enode) is
+   begin
+      Enodes.Table (C).Arg2 := Branch;
+   end Set_Case_Branch;
+
+   procedure Set_Case_Branch_Choice (Branch : O_Enode; Choice : O_Enode) is
+   begin
+      Enodes.Table (Branch).Arg1 := Choice;
+   end Set_Case_Branch_Choice;
+
+   function Get_Case_Branch_Choice (Branch : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Branch).Arg1;
+   end Get_Case_Branch_Choice;
+
+   procedure Set_Case_Choice_Link (Choice : O_Enode; N_Choice : O_Enode) is
+   begin
+      Enodes.Table (Choice).Info := Int32 (N_Choice);
+   end Set_Case_Choice_Link;
+
+   function Get_Case_Choice_Link (Choice : O_Enode) return O_Enode is
+   begin
+      return O_Enode (Enodes.Table (Choice).Info);
+   end Get_Case_Choice_Link;
+
+   function Get_Ref_Field (Ref : O_Enode) return O_Fnode is
+   begin
+      return O_Fnode (Enodes.Table (Ref).Arg2);
+   end Get_Ref_Field;
+
+   function Get_Ref_Index (Ref : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Ref).Arg2;
+   end Get_Ref_Index;
+
+   function Get_Expr_Line_Number (Stmt : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Stmt).Arg1);
+   end Get_Expr_Line_Number;
+
+   function Get_Intrinsic_Operation (Stmt : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Stmt).Arg1);
+   end Get_Intrinsic_Operation;
+
+   Last_Stmt : O_Enode := O_Enode_Null;
+
+   procedure Link_Stmt (Stmt : O_Enode) is
+   begin
+      if Last_Stmt = O_Enode_Null then
+         raise Program_Error;
+      end if;
+      Set_Stmt_Link (Last_Stmt, Stmt);
+      Last_Stmt := Stmt;
+   end Link_Stmt;
+
+   function New_Enode (Kind : OE_Kind;
+                       Rtype : O_Tnode;
+                       Arg1 : O_Enode;
+                       Arg2 : O_Enode) return O_Enode
+   is
+      Mode : Mode_Type;
+   begin
+      Mode := Get_Type_Mode (Rtype);
+      Enodes.Append (Enode_Common'(Kind => Kind,
+                                   Reg => 0,
+                                   Mode => Mode,
+                                   Ref => False,
+                                   Flag1 => False,
+                                   Flag2 => False,
+                                   Flag3 => False,
+                                   Pad => 0,
+                                   Arg1 => Arg1,
+                                   Arg2 => Arg2,
+                                   Info => Int32 (Rtype)));
+      return Enodes.Last;
+   end New_Enode;
+
+   function New_Enode (Kind : OE_Kind;
+                       Mode : Mode_Type;
+                       Rtype : O_Tnode;
+                       Arg1 : O_Enode;
+                       Arg2 : O_Enode) return O_Enode
+   is
+   begin
+      Enodes.Append (Enode_Common'(Kind => Kind,
+                                   Reg => 0,
+                                   Mode => Mode,
+                                   Ref => False,
+                                   Flag1 => False,
+                                   Flag2 => False,
+                                   Flag3 => False,
+                                   Pad => 0,
+                                   Arg1 => Arg1,
+                                   Arg2 => Arg2,
+                                   Info => Int32 (Rtype)));
+      return Enodes.Last;
+   end New_Enode;
+
+   procedure New_Enode_Stmt (Kind : OE_Kind; Arg1 : O_Enode; Arg2 : O_Enode)
+   is
+   begin
+      Enodes.Append (Enode_Common'(Kind => Kind,
+                                   Reg => 0,
+                                   Mode => Mode_Nil,
+                                   Ref => False,
+                                   Flag1 => False,
+                                   Flag2 => False,
+                                   Flag3 => False,
+                                   Pad => 0,
+                                   Arg1 => Arg1,
+                                   Arg2 => Arg2,
+                                   Info => 0));
+      Link_Stmt (Enodes.Last);
+   end New_Enode_Stmt;
+
+   procedure New_Enode_Stmt
+     (Kind : OE_Kind; Mode : Mode_Type; Arg1 : O_Enode; Arg2 : O_Enode)
+   is
+   begin
+      Enodes.Append (Enode_Common'(Kind => Kind,
+                                   Reg => 0,
+                                   Mode => Mode,
+                                   Ref => False,
+                                   Flag1 => False,
+                                   Flag2 => False,
+                                   Flag3 => False,
+                                   Pad => 0,
+                                   Arg1 => Arg1,
+                                   Arg2 => Arg2,
+                                   Info => 0));
+      Link_Stmt (Enodes.Last);
+   end New_Enode_Stmt;
+
+   Bb_Num : Int32 := 0;
+   Last_Bb : O_Enode := O_Enode_Null;
+
+   procedure Create_BB is
+   begin
+      New_Enode_Stmt (OE_BB, Mode_Nil, O_Enode_Null, O_Enode (Bb_Num));
+      if Last_Bb /= O_Enode_Null then
+         Set_BB_Next (Last_Bb, Enodes.Last);
+      end if;
+      Last_Bb := Enodes.Last;
+      Bb_Num := Bb_Num + 1;
+   end Create_BB;
+
+   procedure Start_BB is
+   begin
+      if Flags.Flag_Opt_BB then
+         Create_BB;
+      end if;
+   end Start_BB;
+   pragma Inline (Start_BB);
+
+   procedure Check_Ref (E : O_Enode) is
+   begin
+      if Enodes.Table (E).Ref then
+         raise Syntax_Error;
+      end if;
+      Enodes.Table (E).Ref := True;
+   end Check_Ref;
+
+   procedure Check_Ref (E : O_Lnode) is
+   begin
+      Check_Ref (O_Enode (E));
+   end Check_Ref;
+
+   procedure Check_Value_Type (Val : O_Enode; Vtype : O_Tnode) is
+   begin
+      if Get_Enode_Type (Val) /= Vtype then
+         raise Syntax_Error;
+      end if;
+   end Check_Value_Type;
+
+   function New_Const_U32 (Val : Uns32; Vtype : O_Tnode) return O_Enode
+   is
+   begin
+      return New_Enode (OE_Const, Vtype,
+                        O_Enode (To_Int32 (Val)), O_Enode_Null);
+   end New_Const_U32;
+
+   Last_Decl : O_Dnode := 2;
+   Cur_Block : O_Enode := O_Enode_Null;
+
+   procedure Start_Declare_Stmt
+   is
+      Res : O_Enode;
+   begin
+      New_Enode_Stmt (OE_Beg, Cur_Block, O_Enode_Null);
+      Res := Enodes.Last;
+      Enodes.Table (Res).Arg2 := O_Enode
+        (Ortho_Code.Decls.Start_Declare_Stmt);
+      Cur_Block := Res;
+   end Start_Declare_Stmt;
+
+   function New_Stack (Rtype : O_Tnode) return O_Enode is
+   begin
+      return New_Enode (OE_Get_Stack, Rtype, O_Enode_Null, O_Enode_Null);
+   end New_Stack;
+
+   procedure New_Stack_Restore (Blk : O_Enode)
+   is
+      Save_Asgn : O_Enode;
+      Save_Var : O_Dnode;
+   begin
+      Save_Asgn := Get_Stmt_Link (Blk);
+      Save_Var := Get_Addr_Object (Get_Assign_Target (Save_Asgn));
+      New_Enode_Stmt (OE_Set_Stack, New_Value (New_Obj (Save_Var)),
+                      O_Enode_Null);
+   end New_Stack_Restore;
+
+   procedure Finish_Declare_Stmt
+   is
+      Parent : O_Dnode;
+   begin
+      if Get_Block_Has_Alloca (Cur_Block) then
+         New_Stack_Restore (Cur_Block);
+      end if;
+      New_Enode_Stmt (OE_End, Cur_Block, O_Enode_Null);
+      Cur_Block := Get_Block_Parent (Cur_Block);
+      if Cur_Block = O_Enode_Null then
+         Parent := O_Dnode_Null;
+      else
+         Parent := Get_Block_Decls (Cur_Block);
+      end if;
+      Ortho_Code.Decls.Finish_Declare_Stmt (Parent);
+   end Finish_Declare_Stmt;
+
+   function New_Label return O_Enode is
+   begin
+      return New_Enode (OE_Label, Mode_Nil, O_Tnode_Null,
+                        Cur_Block, O_Enode_Null);
+   end New_Label;
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+      Start : O_Enode;
+      D_Body : O_Dnode;
+      Data : Subprogram_Data_Acc;
+   begin
+      if Cur_Subprg = null then
+         Abi.Start_Body (Func);
+      end if;
+
+      Start := New_Enode (OE_Entry, Mode_Nil, O_Tnode_Null,
+                          Last_Stmt, O_Enode_Null);
+      D_Body := Decls.Start_Subprogram_Body (Func, Start);
+
+      --  Create the corresponding decl.
+      Enodes.Table (Start).Arg2 := O_Enode (D_Body);
+
+      --  Create the data record.
+      Data := new Subprogram_Data'(Parent => Cur_Subprg,
+                                   First_Child => null,
+                                   Last_Child => null,
+                                   Brother => null,
+                                   Depth => Get_Decl_Depth (Func),
+                                   D_Decl => Func,
+                                   E_Entry => Start,
+                                   D_Body => D_Body,
+                                   Exit_Label => O_Enode_Null,
+                                   Last_Stmt => O_Enode_Null,
+                                   Stack_Max => 0);
+
+      if not Flag_Debug_Hli then
+         Data.Exit_Label := New_Label;
+      end if;
+
+      --  Link the record.
+      if Cur_Subprg = null then
+         --  A top-level subprogram.
+         if First_Subprg = null then
+            First_Subprg := Data;
+         else
+            Last_Subprg.Brother := Data;
+         end if;
+         Last_Subprg := Data;
+      else
+         --  A nested subprogram.
+         if Cur_Subprg.First_Child = null then
+            Cur_Subprg.First_Child := Data;
+         else
+            Cur_Subprg.Last_Child.Brother := Data;
+         end if;
+         Cur_Subprg.Last_Child := Data;
+
+         --  Also save last_stmt.
+         Cur_Subprg.Last_Stmt := Last_Stmt;
+      end if;
+
+      Cur_Subprg := Data;
+      Last_Stmt := Start;
+
+      Start_Declare_Stmt;
+
+      --  Create a basic block for the beginning of the subprogram.
+      Start_BB;
+
+      --  Disp declarations.
+      if Cur_Subprg.Parent = null then
+         if Ortho_Code.Debug.Flag_Debug_Body
+           or Ortho_Code.Debug.Flag_Debug_Code
+         then
+            while Last_Decl <= D_Body loop
+               case Get_Decl_Kind (Last_Decl) is
+                  when OD_Block =>
+                     --  Skip blocks.
+                     Disp_Decl (1, Last_Decl);
+                     Last_Decl := Get_Block_Last (Last_Decl) + 1;
+                  when others =>
+                     Disp_Decl (1, Last_Decl);
+                     Last_Decl := Last_Decl + 1;
+               end case;
+            end loop;
+         end if;
+      end if;
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body
+   is
+      Parent : Subprogram_Data_Acc;
+   begin
+      Finish_Declare_Stmt;
+
+      --  Create a new basic block for the epilog.
+      Start_BB;
+
+      if not Flag_Debug_Hli then
+         Link_Stmt (Cur_Subprg.Exit_Label);
+      end if;
+
+      New_Enode_Stmt (OE_Leave, O_Enode_Null, O_Enode_Null);
+
+      --  Save last statement.
+      Cur_Subprg.Last_Stmt := Enodes.Last;
+      --  Set Leave of Entry.
+      Set_Entry_Leave (Cur_Subprg.E_Entry, Enodes.Last);
+
+      Decls.Finish_Subprogram_Body;
+
+      Parent := Cur_Subprg.Parent;
+
+      if Flags.Flag_Optimize then
+         Opts.Optimize_Subprg (Cur_Subprg);
+      end if;
+
+      if Parent = null then
+         --  This is a top-level subprogram.
+         if Ortho_Code.Debug.Flag_Disp_Code then
+            Disps.Disp_Subprg (Cur_Subprg);
+         end if;
+         if Ortho_Code.Debug.Flag_Dump_Code then
+            Disp_Subprg_Body (1, Cur_Subprg.E_Entry);
+         end if;
+         if not Ortho_Code.Debug.Flag_Debug_Dump then
+            Abi.Finish_Body (Cur_Subprg);
+         end if;
+      end if;
+
+      --  Restore Cur_Subprg.
+      Cur_Subprg := Parent;
+
+      --  Restore Last_Stmt.
+      if Cur_Subprg = null then
+         Last_Stmt := O_Enode_Null;
+      else
+         Last_Stmt := Cur_Subprg.Last_Stmt;
+      end if;
+   end Finish_Subprogram_Body;
+
+   function Get_Inner_Alloca (Label : O_Enode) return O_Enode
+   is
+      Res : O_Enode := O_Enode_Null;
+      Blk : O_Enode;
+      Last_Blk : constant O_Enode := Get_Label_Block (Label);
+   begin
+      Blk := Cur_Block;
+      while Blk /= Last_Blk loop
+         if Get_Block_Has_Alloca (Blk) then
+            Res := Blk;
+         end if;
+         Blk := Get_Block_Parent (Blk);
+      end loop;
+      return Res;
+   end Get_Inner_Alloca;
+
+   procedure Emit_Jmp (Code : OE_Kind; Expr : O_Enode; Label : O_Enode)
+   is
+   begin
+      --  Discard jump after jump.
+      if Code /= OE_Jump or else Get_Expr_Kind (Last_Stmt) /= OE_Jump then
+         New_Enode_Stmt (Code, Expr, Label);
+      end if;
+   end Emit_Jmp;
+
+
+   --  If there is stack allocated memory to be freed, free it.
+   --  Then jump to LABEL.
+   procedure New_Allocb_Jump (Label : O_Enode)
+   is
+      Inner_Alloca : O_Enode;
+   begin
+      Inner_Alloca := Get_Inner_Alloca (Label);
+      if Inner_Alloca /= O_Enode_Null then
+         New_Stack_Restore (Inner_Alloca);
+      end if;
+      Emit_Jmp (OE_Jump, O_Enode_Null, Label);
+   end New_Allocb_Jump;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode
+   is
+      L_Type : O_Tnode;
+      H, L : Uns32;
+   begin
+      L_Type := Get_Const_Type (Lit);
+      if Flag_Debug_Hli then
+         return New_Enode (OE_Lit, L_Type, O_Enode (Lit), O_Enode_Null);
+      else
+         case Get_Const_Kind (Lit) is
+            when OC_Signed
+              | OC_Unsigned
+              | OC_Float
+              | OC_Null
+              | OC_Lit =>
+               Get_Const_Bytes (Lit, H, L);
+               return New_Enode
+                 (OE_Const, L_Type,
+                  O_Enode (To_Int32 (L)), O_Enode (To_Int32 (H)));
+            when OC_Address
+              | OC_Subprg_Address =>
+               return New_Enode (OE_Addrg, L_Type,
+                                 O_Enode (Get_Const_Decl (Lit)), O_Enode_Null);
+            when OC_Array
+              | OC_Record
+              | OC_Union
+              | OC_Sizeof
+              | OC_Alignof =>
+               raise Syntax_Error;
+         end case;
+      end if;
+   end New_Lit;
+
+   function Get_Static_Chain (Depth : O_Depth) return O_Enode
+   is
+      Cur_Depth : O_Depth := Cur_Subprg.Depth;
+      Subprg : Subprogram_Data_Acc;
+      Res : O_Enode;
+   begin
+      if Depth = Cur_Depth then
+         return New_Enode (OE_Get_Frame, Abi.Mode_Ptr, O_Tnode_Ptr,
+                           O_Enode_Null, O_Enode_Null);
+      else
+         Subprg := Cur_Subprg;
+         Res := O_Enode_Null;
+         loop
+            --  The static chain is the first interface of the subprogram.
+            Res := New_Enode (OE_Addrl, Abi.Mode_Ptr, O_Tnode_Ptr,
+                              O_Enode (Get_Subprg_Interfaces (Subprg.D_Decl)),
+                              Res);
+            Res := New_Enode (OE_Indir, O_Tnode_Ptr, Res, O_Enode_Null);
+            Cur_Depth := Cur_Depth - 1;
+            if Cur_Depth = Depth then
+               return Res;
+            end if;
+            Subprg := Subprg.Parent;
+         end loop;
+      end if;
+   end Get_Static_Chain;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode
+   is
+      O_Type : O_Tnode;
+      Kind : OE_Kind;
+      Chain : O_Enode;
+      Depth : O_Depth;
+   begin
+      O_Type := Get_Decl_Type (Obj);
+      case Get_Decl_Kind (Obj) is
+         when OD_Local
+           | OD_Interface =>
+            Kind := OE_Addrl;
+            --  Local declarations are 1 deeper than their subprogram.
+            Depth := Get_Decl_Depth (Obj) - 1;
+            if Depth /= Cur_Subprg.Depth then
+               Chain := Get_Static_Chain (Depth);
+            else
+               Chain := O_Enode_Null;
+            end if;
+         when OD_Var
+           | OD_Const =>
+            Kind := OE_Addrg;
+            Chain := O_Enode_Null;
+         when others =>
+            raise Program_Error;
+      end case;
+      return O_Lnode (New_Enode (Kind, Abi.Mode_Ptr, O_Type,
+                                 O_Enode (Obj), Chain));
+   end New_Obj;
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+                          return O_Enode
+   is
+      L_Type : O_Tnode;
+   begin
+      L_Type := Get_Enode_Type (Left);
+      if Flag_Debug_Assert then
+         if L_Type /= Get_Enode_Type (Right) then
+            raise Syntax_Error;
+         end if;
+         if Get_Type_Mode (L_Type) = Mode_Blk then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Left);
+         Check_Ref (Right);
+      end if;
+
+      return New_Enode (OE_Kind'Val (ON_Op_Kind'Pos (Kind)),
+                        L_Type, Left, Right);
+   end New_Dyadic_Op;
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+                           return O_Enode
+   is
+      O_Type : O_Tnode;
+   begin
+      O_Type := Get_Enode_Type (Operand);
+
+      if Flag_Debug_Assert then
+         if Get_Type_Mode (O_Type) = Mode_Blk then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Operand);
+      end if;
+
+      return New_Enode (OE_Kind'Val (ON_Op_Kind'Pos (Kind)), O_Type,
+                        Operand, O_Enode_Null);
+   end New_Monadic_Op;
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode
+   is
+      Res : O_Enode;
+   begin
+      if Flag_Debug_Assert then
+         if Get_Enode_Type (Left) /= Get_Enode_Type (Right) then
+            raise Syntax_Error;
+         end if;
+         if Get_Expr_Mode (Left) = Mode_Blk then
+            raise Syntax_Error;
+         end if;
+         if Get_Type_Kind (Ntype) /= OT_Boolean then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Left);
+         Check_Ref (Right);
+      end if;
+
+      Res := New_Enode (OE_Kind'Val (ON_Op_Kind'Pos (Kind)), Ntype,
+                        Left, Right);
+      if Flag_Debug_Hli then
+         return New_Enode (OE_Typed, Ntype, Res, O_Enode (Ntype));
+      else
+         return Res;
+      end if;
+   end New_Compare_Op;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Enode is
+   begin
+      return New_Const_U32 (Get_Type_Size (Atype), Rtype);
+   end New_Sizeof;
+
+   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Enode is
+   begin
+      return New_Const_U32 (Get_Field_Offset (Field), Rtype);
+   end New_Offsetof;
+
+   function Is_Pow2 (V : Uns32) return Boolean is
+   begin
+      return (V and -V) = V;
+   end Is_Pow2;
+
+   function Extract_Pow2 (V : Uns32) return Uns32 is
+   begin
+      for I in Natural range 0 .. 31 loop
+         if V = Shift_Left (1, I) then
+            return Uns32 (I);
+         end if;
+      end loop;
+      raise Program_Error;
+   end Extract_Pow2;
+
+   function New_Index_Slice_Element
+     (Arr : O_Lnode; Index : O_Enode; Res_Type : O_Tnode)
+     return O_Lnode
+   is
+      El_Type : O_Tnode;
+      In_Type : O_Tnode;
+      Sz : O_Enode;
+      El_Size : Uns32;
+   begin
+      El_Type := Get_Type_Array_Element (Get_Enode_Type (O_Enode (Arr)));
+      In_Type := Get_Enode_Type (Index);
+
+      if Flag_Debug_Assert then
+         Check_Ref (Index);
+         Check_Ref (Arr);
+      end if;
+
+      --  result := arr + index * sizeof (element).
+      El_Size := Get_Type_Size (El_Type);
+      if El_Size = 1 then
+         Sz := Index;
+      elsif Get_Expr_Kind (Index) = OE_Const then
+         --  FIXME: may recycle previous index?
+         Sz := New_Const_U32 (Get_Expr_Low (Index) * El_Size, In_Type);
+      else
+         if Is_Pow2 (El_Size) then
+            Sz := New_Const_U32 (Extract_Pow2 (El_Size), In_Type);
+            Sz := New_Enode (OE_Shl, In_Type, Index, Sz);
+         else
+            Sz := New_Const_U32 (El_Size, In_Type);
+            Sz := New_Enode (OE_Mul, In_Type, Index, Sz);
+         end if;
+      end if;
+      return O_Lnode (New_Enode (OE_Add, Abi.Mode_Ptr, Res_Type,
+                                 O_Enode (Arr), Sz));
+   end New_Index_Slice_Element;
+
+   function New_Hli_Index_Slice
+     (Kind : OE_Kind; Res_Type : O_Tnode; Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode
+   is
+   begin
+      if Flag_Debug_Assert then
+         Check_Ref (Index);
+         Check_Ref (Arr);
+      end if;
+      return O_Lnode (New_Enode (Kind, Res_Type, O_Enode (Arr), Index));
+   end New_Hli_Index_Slice;
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+                                return O_Lnode
+   is
+      El_Type : O_Tnode;
+   begin
+      El_Type := Get_Type_Array_Element (Get_Enode_Type (O_Enode (Arr)));
+
+      if Flag_Debug_Hli then
+         return New_Hli_Index_Slice (OE_Index_Ref, El_Type, Arr, Index);
+      else
+         return New_Index_Slice_Element (Arr, Index, El_Type);
+      end if;
+   end New_Indexed_Element;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+                      return O_Lnode
+   is
+   begin
+      if Flag_Debug_Hli then
+         return New_Hli_Index_Slice (OE_Slice_Ref, Res_Type, Arr, Index);
+      else
+         return New_Index_Slice_Element (Arr, Index, Res_Type);
+      end if;
+   end New_Slice;
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+                                 return O_Lnode
+   is
+      Offset : Uns32;
+      Off : O_Enode;
+      Res_Type : O_Tnode;
+   begin
+      if Flag_Debug_Assert then
+         Check_Ref (Rec);
+      end if;
+
+      Res_Type := Get_Field_Type (El);
+      if Flag_Debug_Hli then
+         return O_Lnode (New_Enode (OE_Record_Ref, Res_Type,
+                                    O_Enode (Rec), O_Enode (El)));
+      else
+         Offset := Get_Field_Offset (El);
+         if Offset = 0 then
+            return O_Lnode (New_Enode (OE_Conv_Ptr, Abi.Mode_Ptr, Res_Type,
+                                       O_Enode (Rec), O_Enode (Res_Type)));
+         else
+            Off := New_Enode (OE_Const, Mode_U32, O_Tnode_Null,
+                              O_Enode (Offset), O_Enode_Null);
+
+            return O_Lnode (New_Enode (OE_Add, Abi.Mode_Ptr, Res_Type,
+                                       O_Enode (Rec), Off));
+         end if;
+      end if;
+   end New_Selected_Element;
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      Acc_Type : O_Tnode;
+      Res_Type : O_Tnode;
+   begin
+      Acc_Type := Get_Enode_Type (Acc);
+
+      if Flag_Debug_Assert then
+         if Get_Type_Kind (Acc_Type) /= OT_Access then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Acc);
+      end if;
+
+      Res_Type := Get_Type_Access_Type (Acc_Type);
+      if Flag_Debug_Hli then
+         return O_Lnode (New_Enode (OE_Access_Ref, Abi.Mode_Ptr, Res_Type,
+                                    Acc, O_Enode_Null));
+      else
+         return O_Lnode (New_Enode (OE_Conv_Ptr, Abi.Mode_Ptr, Res_Type,
+                                    Acc, O_Enode (Res_Type)));
+      end if;
+   end New_Access_Element;
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode is
+   begin
+      if Flag_Debug_Assert then
+         Check_Ref (Val);
+      end if;
+
+      return New_Enode (OE_Conv, Rtype, Val, O_Enode (Rtype));
+   end New_Convert_Ov;
+
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+                                  return O_Enode is
+   begin
+      if Flag_Debug_Assert then
+         if Get_Type_Kind (Atype) /= OT_Access then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Lvalue);
+      end if;
+
+      return New_Enode (OE_Conv_Ptr, Abi.Mode_Ptr, Atype,
+                        O_Enode (Lvalue), O_Enode (Atype));
+   end New_Unchecked_Address;
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode is
+   begin
+      if Flag_Debug_Assert then
+         if Get_Type_Kind (Atype) /= OT_Access then
+            raise Syntax_Error;
+         end if;
+         if Get_Base_Type (Get_Enode_Type (O_Enode (Lvalue)))
+           /= Get_Base_Type (Get_Type_Access_Type (Atype))
+         then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Lvalue);
+      end if;
+
+      return New_Enode (OE_Conv_Ptr, Abi.Mode_Ptr, Atype,
+                        O_Enode (Lvalue), O_Enode (Atype));
+   end New_Address;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Enode is
+   begin
+      raise Program_Error;
+      return O_Enode_Null;
+   end New_Subprogram_Address;
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode
+   is
+      V_Type : O_Tnode;
+   begin
+      V_Type := Get_Enode_Type (O_Enode (Lvalue));
+
+      if Flag_Debug_Assert then
+         Check_Ref (Lvalue);
+      end if;
+
+      return New_Enode (OE_Indir, V_Type, O_Enode (Lvalue), O_Enode_Null);
+   end New_Value;
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      Save_Var : O_Dnode;
+      Stmt : O_Enode;
+      St_Type : O_Tnode;
+   begin
+      if Flag_Debug_Assert then
+         Check_Ref (Size);
+         if Get_Type_Kind (Rtype) /= OT_Access then
+            raise Syntax_Error;
+         end if;
+         if Get_Type_Kind (Get_Enode_Type (Size)) /= OT_Unsigned then
+            raise Syntax_Error;
+         end if;
+      end if;
+
+      if not Get_Block_Has_Alloca (Cur_Block) then
+         Set_Block_Has_Alloca (Cur_Block, True);
+         if Stack_Ptr_Type /= O_Tnode_Null then
+            St_Type := Stack_Ptr_Type;
+         else
+            St_Type := Rtype;
+         end if;
+         --  Add a decl.
+         New_Var_Decl (Save_Var, O_Ident_Nul, O_Storage_Local, St_Type);
+         --  Add insn to save stack ptr.
+         Stmt := New_Enode (OE_Asgn, St_Type,
+                            New_Stack (St_Type),
+                            O_Enode (New_Obj (Save_Var)));
+         if Cur_Block = Last_Stmt then
+            Set_Stmt_Link (Last_Stmt, Stmt);
+            Last_Stmt := Stmt;
+         else
+            Set_Stmt_Link (Stmt, Get_Stmt_Link (Cur_Block));
+            Set_Stmt_Link (Cur_Block, Stmt);
+         end if;
+      end if;
+
+      return New_Enode (OE_Alloca, Rtype, Size, O_Enode (Rtype));
+   end New_Alloca;
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+      Depth : O_Depth;
+      Arg : O_Enode;
+      First_Inter : O_Dnode;
+   begin
+      First_Inter := Get_Subprg_Interfaces (Subprg);
+      if Get_Decl_Storage (Subprg) = O_Storage_Local then
+         Depth := Get_Decl_Depth (Subprg);
+         Arg := New_Enode (OE_Arg, Abi.Mode_Ptr, O_Tnode_Ptr,
+                           Get_Static_Chain (Depth - 1), O_Enode_Null);
+         First_Inter := Get_Interface_Chain (First_Inter);
+      else
+         Arg := O_Enode_Null;
+      end if;
+      Assocs := (Subprg => Subprg,
+                 First_Arg => Arg,
+                 Last_Arg => Arg,
+                 Next_Inter => First_Inter);
+   end Start_Association;
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode)
+   is
+      V_Type : O_Tnode;
+      Mode : Mode_Type;
+      N_Mode : Mode_Type;
+      Res : O_Enode;
+   begin
+      V_Type := Get_Enode_Type (Val);
+
+      if Flag_Debug_Assert then
+         if Assocs.Next_Inter = O_Dnode_Null then
+            --  More assocs than interfaces.
+            raise Syntax_Error;
+         end if;
+         Check_Value_Type (Val, Get_Decl_Type (Assocs.Next_Inter));
+         Check_Ref (Val);
+      end if;
+
+      --  Follow the C convention call: no parameters shorter than int.
+      Mode := Get_Type_Mode (V_Type);
+      case Mode is
+         when Mode_B2
+           | Mode_U8
+           | Mode_U16 =>
+            N_Mode := Mode_U32;
+         when Mode_I8
+           | Mode_I16 =>
+            N_Mode := Mode_I32;
+         when Mode_P32
+           | Mode_U32
+           | Mode_I32
+           | Mode_U64
+           | Mode_I64
+           | Mode_P64
+           | Mode_F32
+           | Mode_F64 =>
+            N_Mode := Mode;
+         when Mode_Blk
+           | Mode_Nil
+           | Mode_X1 =>
+            raise Program_Error;
+      end case;
+      if N_Mode /= Mode and not Flag_Debug_Hli then
+         Res := New_Enode (OE_Conv, N_Mode, V_Type, Val, O_Enode (V_Type));
+      else
+         Res := Val;
+      end if;
+      Res := New_Enode (OE_Arg, N_Mode, V_Type, Res, O_Enode_Null);
+      if Assocs.Last_Arg /= O_Enode_Null then
+         Enodes.Table (Assocs.Last_Arg).Arg2 := Res;
+      else
+         Assocs.First_Arg := Res;
+      end if;
+      Assocs.Last_Arg := Res;
+      Assocs.Next_Inter := Get_Interface_Chain (Assocs.Next_Inter);
+   end New_Association;
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+      F_Type : O_Tnode;
+   begin
+      if Flag_Debug_Assert then
+         if Assocs.Next_Inter /= O_Dnode_Null then
+            --  Not enough assocs.
+            raise Syntax_Error;
+         end if;
+      end if;
+
+      F_Type := Get_Decl_Type (Assocs.Subprg);
+      return New_Enode (OE_Call, F_Type,
+                        O_Enode (Assocs.Subprg), Assocs.First_Arg);
+   end New_Function_Call;
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List) is
+   begin
+      if Flag_Debug_Assert then
+         if Assocs.Next_Inter /= O_Dnode_Null then
+            --  Not enough assocs.
+            raise Syntax_Error;
+         end if;
+      end if;
+      New_Enode_Stmt (OE_Call, O_Enode (Assocs.Subprg), Assocs.First_Arg);
+   end New_Procedure_Call;
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      V_Type : O_Tnode;
+   begin
+      V_Type := Get_Enode_Type (Value);
+
+      if Flag_Debug_Assert then
+         Check_Value_Type (Value, Get_Enode_Type (O_Enode (Target)));
+         Check_Ref (Value);
+         Check_Ref (Target);
+      end if;
+
+      New_Enode_Stmt (OE_Asgn, Get_Type_Mode (V_Type),
+                      Value, O_Enode (Target));
+   end New_Assign_Stmt;
+
+   procedure New_Return_Stmt (Value : O_Enode)
+   is
+      V_Type : O_Tnode;
+   begin
+      V_Type := Get_Enode_Type (Value);
+
+      if Flag_Debug_Assert then
+         Check_Ref (Value);
+         Check_Value_Type (Value, Get_Decl_Type (Cur_Subprg.D_Decl));
+      end if;
+
+      New_Enode_Stmt (OE_Ret, Get_Type_Mode (V_Type), Value, O_Enode_Null);
+      if not Flag_Debug_Hli then
+         New_Allocb_Jump (Cur_Subprg.Exit_Label);
+      end if;
+   end New_Return_Stmt;
+
+   procedure New_Return_Stmt is
+   begin
+      if Flag_Debug_Assert then
+         if Get_Decl_Kind (Cur_Subprg.D_Decl) /= OD_Procedure then
+            raise Syntax_Error;
+         end if;
+      end if;
+
+      if not Flag_Debug_Hli then
+         New_Allocb_Jump (Cur_Subprg.Exit_Label);
+      else
+         New_Enode_Stmt (OE_Ret, Mode_Nil, O_Enode_Null, O_Enode_Null);
+      end if;
+   end New_Return_Stmt;
+
+
+   procedure Start_If_Stmt (Block : out O_If_Block; Cond : O_Enode) is
+   begin
+      if Flag_Debug_Assert then
+         if Get_Expr_Mode (Cond) /= Mode_B2 then
+            --  COND must be a boolean.
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Cond);
+      end if;
+
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_If, Cond, O_Enode_Null);
+         Block := (Label_End => O_Enode_Null,
+                   Label_Next => Last_Stmt);
+      else
+         Block := (Label_End => O_Enode_Null,
+                   Label_Next => New_Label);
+         Emit_Jmp (OE_Jump_F, Cond, Block.Label_Next);
+         Start_BB;
+      end if;
+   end Start_If_Stmt;
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Else, O_Enode_Null, O_Enode_Null);
+      else
+         if Block.Label_End = O_Enode_Null then
+            Block.Label_End := New_Label;
+         end if;
+         Emit_Jmp (OE_Jump, O_Enode_Null, Block.Label_End);
+         Start_BB;
+         Link_Stmt (Block.Label_Next);
+         Block.Label_Next := O_Enode_Null;
+      end if;
+   end New_Else_Stmt;
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block) is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Endif, O_Enode_Null, O_Enode_Null);
+      else
+         --  Create a badic-block after the IF.
+         Start_BB;
+         if Block.Label_Next /= O_Enode_Null then
+            Link_Stmt (Block.Label_Next);
+         end if;
+         if Block.Label_End /= O_Enode_Null then
+            Link_Stmt (Block.Label_End);
+         end if;
+      end if;
+   end Finish_If_Stmt;
+
+   procedure Start_Loop_Stmt (Label : out O_Snode) is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Loop, O_Enode_Null, O_Enode_Null);
+         Label := (Label_Start => Last_Stmt,
+                   Label_End => O_Enode_Null);
+      else
+         --  Create a basic-block at the beginning of the loop.
+         Start_BB;
+         Label.Label_Start := New_Label;
+         Link_Stmt (Label.Label_Start);
+         Label.Label_End := New_Label;
+      end if;
+   end Start_Loop_Stmt;
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode)
+   is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Eloop, Label.Label_Start, O_Enode_Null);
+      else
+         Emit_Jmp (OE_Jump, O_Enode_Null, Label.Label_Start);
+         Start_BB;
+         Link_Stmt (Label.Label_End);
+      end if;
+   end Finish_Loop_Stmt;
+
+   procedure New_Exit_Stmt (L : O_Snode)
+   is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Exit, O_Enode_Null, L.Label_Start);
+      else
+         New_Allocb_Jump (L.Label_End);
+      end if;
+   end New_Exit_Stmt;
+
+   procedure New_Next_Stmt (L : O_Snode)
+   is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Next, O_Enode_Null, L.Label_Start);
+      else
+         New_Allocb_Jump (L.Label_Start);
+      end if;
+   end New_Next_Stmt;
+
+   procedure Start_Case_Stmt (Block : out O_Case_Block; Value : O_Enode)
+   is
+      V_Type : O_Tnode;
+      Mode : Mode_Type;
+      Start : O_Enode;
+   begin
+      V_Type := Get_Enode_Type (Value);
+      Mode := Get_Type_Mode (V_Type);
+
+      if Flag_Debug_Assert then
+         Check_Ref (Value);
+         case Mode is
+            when Mode_U8 .. Mode_U64
+              | Mode_I8 .. Mode_I64
+              | Mode_B2 =>
+               null;
+            when others =>
+               raise Syntax_Error;
+         end case;
+      end if;
+
+      New_Enode_Stmt (OE_Case, Mode, Value, O_Enode_Null);
+      Start := Enodes.Last;
+      if Flag_Debug_Hli then
+         Block := (Expr => Start,
+                   Expr_Type => V_Type,
+                   Last_Node => O_Enode_Null,
+                   Label_End => O_Enode_Null,
+                   Label_Branch => Start);
+      else
+         Block := (Expr => Start,
+                   Expr_Type => V_Type,
+                   Last_Node => Start,
+                   Label_End => New_Label,
+                   Label_Branch => O_Enode_Null);
+      end if;
+   end Start_Case_Stmt;
+
+   procedure Start_Choice (Block : in out O_Case_Block)
+   is
+      B : O_Enode;
+   begin
+      if Flag_Debug_Hli then
+         B := New_Enode (OE_Case_Branch, Mode_Nil, O_Tnode_Null,
+                         O_Enode_Null, O_Enode_Null);
+         Link_Stmt (B);
+         --  Link it.
+         Set_Case_Branch (Block.Label_Branch, B);
+         Block.Label_Branch := B;
+      else
+         --  Jump to the end of the case statement.
+         --  If there is already a branch open, this is ok
+         --   (do not fall-through).
+         --  If there is no branch open, then this is the default choice
+         --   (nothing to do).
+         Emit_Jmp (OE_Jump, O_Enode_Null, Block.Label_End);
+
+         --  Create a label for the code of this branch.
+         Block.Label_Branch := New_Label;
+      end if;
+   end Start_Choice;
+
+   procedure Insert_Choice_Stmt (Block : in out O_Case_Block; Stmt : O_Enode)
+   is
+      Prev : O_Enode;
+   begin
+      Prev := Get_Stmt_Link (Block.Last_Node);
+      Set_Stmt_Link (Block.Last_Node, Stmt);
+      Block.Last_Node := Stmt;
+      if Prev = O_Enode_Null then
+         Last_Stmt := Stmt;
+      else
+         Set_Stmt_Link (Stmt, Prev);
+      end if;
+   end Insert_Choice_Stmt;
+
+   procedure Emit_Choice_Jmp (Block : in out O_Case_Block;
+                              Code : OE_Kind; Expr : O_Enode; Label : O_Enode)
+   is
+      Jmp : O_Enode;
+   begin
+      Jmp := New_Enode (Code, Mode_Nil, O_Tnode_Null, Expr, Label);
+      Insert_Choice_Stmt (Block, Jmp);
+   end Emit_Choice_Jmp;
+
+   --  Create a node containing the value of the case expression.
+   function New_Case_Expr (Block : O_Case_Block) return O_Enode is
+   begin
+      return New_Enode (OE_Case_Expr, Block.Expr_Type,
+                        Block.Expr, O_Enode_Null);
+   end New_Case_Expr;
+
+   procedure New_Hli_Choice (Block : in out O_Case_Block;
+                             Hi, Lo : O_Enode)
+   is
+      Res : O_Enode;
+   begin
+      Res := New_Enode (OE_Case_Choice, Mode_Nil, O_Tnode_Null, Hi, Lo);
+      if Block.Label_End = O_Enode_Null then
+         Set_Case_Branch_Choice (Block.Label_Branch, Res);
+      else
+         Set_Case_Choice_Link (Block.Label_End, Res);
+      end if;
+      Block.Label_End := Res;
+   end New_Hli_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode)
+   is
+      Res : O_Enode;
+   begin
+      if Flag_Debug_Hli then
+         New_Hli_Choice (Block, New_Lit (Expr), O_Enode_Null);
+      else
+         Res := New_Enode (OE_Eq, Mode_B2, O_Tnode_Null,
+                           New_Case_Expr (Block), New_Lit (Expr));
+         Emit_Choice_Jmp (Block, OE_Jump_T, Res, Block.Label_Branch);
+      end if;
+   end New_Expr_Choice;
+
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode)
+   is
+      E1 : O_Enode;
+      E2 : O_Enode;
+      Label : O_Enode;
+   begin
+      if Flag_Debug_Hli then
+         New_Hli_Choice (Block, New_Lit (Low), New_Lit (High));
+      else
+         --  Internal label.
+         Label := New_Label;
+         E1 := New_Enode (OE_Lt, Mode_B2, O_Tnode_Null,
+                          New_Case_Expr (Block), New_Lit (Low));
+         Emit_Choice_Jmp (Block, OE_Jump_T, E1, Label);
+         E2 := New_Enode (OE_Le, Mode_B2, O_Tnode_Null,
+                          New_Case_Expr (Block), New_Lit (High));
+         Emit_Choice_Jmp (Block, OE_Jump_T, E2, Block.Label_Branch);
+         Insert_Choice_Stmt (Block, Label);
+      end if;
+   end New_Range_Choice;
+
+   procedure New_Default_Choice (Block : in out O_Case_Block) is
+   begin
+      if Flag_Debug_Hli then
+         New_Hli_Choice (Block, O_Enode_Null, O_Enode_Null);
+      else
+         --  Jump to the code.
+         Emit_Choice_Jmp (Block, OE_Jump, O_Enode_Null, Block.Label_Branch);
+      end if;
+   end New_Default_Choice;
+
+   procedure Finish_Choice (Block : in out O_Case_Block) is
+   begin
+      if Flag_Debug_Hli then
+         Block.Label_End := O_Enode_Null;
+      else
+         --  Put the label of the branch.
+         Start_BB;
+         Link_Stmt (Block.Label_Branch);
+      end if;
+   end Finish_Choice;
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block) is
+   begin
+      if Flag_Debug_Hli then
+         New_Enode_Stmt (OE_Case_End, O_Enode_Null, O_Enode_Null);
+      else
+         --  Jump to the end of the case statement.
+         --  Note: this is not required, since the next instruction is the
+         --   label.
+         --  Emit_Jmp (OE_Jump, O_Enode_Null, Block.Label_End);
+
+         --  Put the label of the end of the case.
+         Start_BB;
+         Link_Stmt (Block.Label_End);
+         Block.Label_End := O_Enode_Null;
+      end if;
+   end Finish_Case_Stmt;
+
+   procedure New_Debug_Line_Stmt (Line : Natural) is
+   begin
+      New_Enode_Stmt (OE_Line, O_Enode (Line), O_Enode_Null);
+   end New_Debug_Line_Stmt;
+
+   procedure Debug_Expr (N : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+      Indent : constant Count := Col;
+   begin
+      Put (Int32 (N), 0);
+      Set_Col (Indent + 7);
+      Disp_Mode (Get_Expr_Mode (N));
+      Put ("  ");
+      Put (OE_Kind'Image (Get_Expr_Kind (N)));
+      Set_Col (Indent + 28);
+--       Put (Abi.Image_Insn (Get_Expr_Insn (N)));
+--       Put ("  ");
+      Put (Abi.Image_Reg (Get_Expr_Reg (N)));
+      Put ("  ");
+      Put (Int32 (Enodes.Table (N).Arg1), 7);
+      Put (Int32 (Enodes.Table (N).Arg2), 7);
+      Put (Enodes.Table (N).Info, 7);
+      New_Line;
+   end Debug_Expr;
+
+   procedure Disp_Subprg_Body (Indent : Natural; Subprg : O_Enode)
+   is
+      use Ada.Text_IO;
+      N : O_Enode;
+      N_Indent : Natural;
+   begin
+      N := Subprg;
+      if Get_Expr_Kind (N) /= OE_Entry then
+         raise Program_Error;
+      end if;
+      --  Display the entry.
+      Set_Col (Count (Indent));
+      Debug_Expr (N);
+      --  Display the subprogram, binding.
+      N_Indent := Indent;-- + 1;
+      N := N + 1;
+      loop
+         case Get_Expr_Kind (N) is
+            when OE_Entry =>
+               N := Get_Entry_Leave (N) + 1;
+            when OE_Leave =>
+               Set_Col (Count (Indent));
+               Debug_Expr (N);
+               exit;
+            when others =>
+               Set_Col (Count (N_Indent));
+               Debug_Expr (N);
+               case Get_Expr_Kind (N) is
+                  when OE_Beg =>
+                     Disp_Block (N_Indent + 2,
+                                 O_Dnode (Enodes.Table (N).Arg2));
+                     N_Indent := N_Indent + 1;
+                  when OE_End =>
+                     N_Indent := N_Indent - 1;
+                  when others =>
+                     null;
+               end case;
+               N := N + 1;
+         end case;
+      end loop;
+   end Disp_Subprg_Body;
+
+   procedure Disp_All_Enode is
+   begin
+      for I in Enodes.First .. Enodes.Last loop
+         Debug_Expr (I);
+      end loop;
+   end Disp_All_Enode;
+
+   Max_Enode : O_Enode := O_Enode_Null;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Enode := Enodes.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Max_Enode := O_Enode'Max (Max_Enode, Enodes.Last);
+      Enodes.Set_Last (M.Enode);
+   end Release;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Max_Enode := O_Enode'Max (Max_Enode, Enodes.Last);
+      Put ("Number of Enodes:" & O_Enode'Image (Enodes.Last));
+      Put (", max:" & O_Enode'Image (Max_Enode));
+      New_Line;
+   end Disp_Stats;
+
+   procedure Free_Subprogram_Data (Data : in out Subprogram_Data_Acc)
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Subprogram_Data, Subprogram_Data_Acc);
+      Ch, N_Ch : Subprogram_Data_Acc;
+   begin
+      Ch := Data.First_Child;
+      while Ch /= null loop
+         N_Ch := Ch.Brother;
+         Free_Subprogram_Data (Ch);
+         Ch := N_Ch;
+      end loop;
+      Free (Data);
+   end Free_Subprogram_Data;
+
+   procedure Finish is
+   begin
+      Enodes.Free;
+      Free_Subprogram_Data (First_Subprg);
+   end Finish;
+end Ortho_Code.Exprs;
diff --git a/src/ortho/mcode/ortho_code-exprs.ads b/src/ortho/mcode/ortho_code-exprs.ads
new file mode 100644
index 000000000..9bd4596d7
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-exprs.ads
@@ -0,0 +1,600 @@
+--  Mcode back-end for ortho - Expressions and control handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Ortho_Code.Exprs is
+   type OE_Kind is
+     (
+      OE_Nil,
+
+      --  Dyadic operations.
+      --  ARG1 is left, ARG2 is right.
+      OE_Add_Ov,
+      OE_Sub_Ov,
+      OE_Mul_Ov,
+      OE_Div_Ov,
+      OE_Rem,
+      OE_Mod,
+
+      OE_And,
+      OE_Or,
+      OE_Xor,
+
+      --  Monadic operations.
+      --  ARG1 is expression.
+      OE_Not,
+      OE_Neg_Ov,
+      OE_Abs_Ov,
+
+      --  Comparaison.
+      --  ARG1 is left, ARG2 is right.
+      OE_Eq,
+      OE_Neq,
+      OE_Le,
+      OE_Lt,
+      OE_Ge,
+      OE_Gt,
+
+      --  Without checks, for addresses.
+      OE_Add,
+      OE_Mul,
+      OE_Shl, --  Left shift
+
+      --  A literal.
+      --  ARG1 is low part, ARG2 is high part.
+      OE_Const,
+
+      --  Address of a local variable/parameter.
+      --  ARG1 is object.
+      --  ARG2 is the frame pointer or O_Enode_Null for current frame pointer.
+      OE_Addrl,
+      --  Address of a global variable.
+      --  ARG1 is object.
+      OE_Addrg,
+
+      --  Pointer dereference.
+      --  ARG1 is operand.
+      OE_Indir,
+
+      --  Conversion.
+      --  ARG1 is expression.
+      --  ARG2: type
+      OE_Conv_Ptr,
+      OE_Conv,
+
+      --  Typed expression.
+      OE_Typed,
+
+      --  Local memory allocation.
+      --  ARG1 is size (in bytes).
+      OE_Alloca,
+
+      --  Statements.
+
+      --  Subrogram entry.
+      --  ARG1 is the corresponding Leave (used to skip inner subprograms).
+      --  ARG2 is unused.
+      OE_Entry,
+      --  Subprogram exit.
+      --  ARG1 and ARG2 are unused.
+      OE_Leave,
+
+      --  Declaration blocks.
+      --  ARG1: parent
+      --  ARG2: corresponding declarations.
+      OE_Beg,
+      --  ARG1: corresponding beg
+      --  ARG2: unsused.
+      OE_End,
+
+      --  Assignment.
+      --  ARG1 is value, ARG2 is target (address).
+      OE_Asgn,
+
+      --  Subprogram calls.
+      --  ARG1 is value
+      --  ARG2 is link to the next argument.
+      OE_Arg,
+      --  ARG1 is subprogram
+      --  ARG2 is arguments.
+      OE_Call,
+      --  ARG1 is intrinsic operation.
+      OE_Intrinsic,
+
+      --  Modify the stack pointer value, to align the stack before pushing
+      --  arguments, or to free the stack.
+      --  ARG1 is the signed offset.
+      OE_Stack_Adjust,
+
+      --  Return ARG1 (if not mode_nil) from current subprogram.
+      --  ARG1: expression.
+      OE_Ret,
+
+      --  Line number (for debugging).
+      --  ARG1: line number
+      OE_Line,
+
+      --  High level instructions.
+
+      --  Basic block.
+      --  ARG1: next BB
+      --  ARG2: number
+      OE_BB,
+
+      --  ARG1 is the literal.
+      OE_Lit,
+      --  ARG1: value
+      --  ARG2: first branch (HLI only).
+      OE_Case,
+      --  ARG1: the corresponding OE_Case
+      OE_Case_Expr,
+      --  ARG1: left bound
+      --  ARG2: right bound
+      --  LINK: choice link
+      OE_Case_Choice,
+      --  ARG1: choice link
+      --  ARG2: next branch
+      OE_Case_Branch,
+      --  End of case.
+      OE_Case_End,
+
+      --  ARG1: the condition
+      --  ARG2: the else/endif
+      OE_If,
+      OE_Else,
+      OE_Endif,
+
+      --  ARG1: loop level.
+      OE_Loop,
+      --  ARG1: loop.
+      OE_Eloop,
+      --  ARG2: loop.
+      OE_Next,
+      OE_Exit,
+
+      --  ARG1: the record
+      --  ARG2: the field
+      OE_Record_Ref,
+
+      --  ARG1: the expression.
+      OE_Access_Ref,
+
+      --  ARG1: the array
+      --  ARG2: the index
+      OE_Index_Ref,
+      OE_Slice_Ref,
+
+      --  Low level instructions.
+
+      --  Label.
+      --  ARG1: current block (used for alloca), only during tree building.
+      --  ARG2: user info (generally used to store symbol).
+      OE_Label,
+
+      --  Jump to ARG2.
+      OE_Jump,
+
+      --  Jump to ARG2 if ARG1 is true/false.
+      OE_Jump_T,
+      OE_Jump_F,
+
+      --  Used internally only.
+      --  ARG2 is info/target, ARG1 is expression (if any).
+      OE_Spill,
+      OE_Reload,
+      OE_Move,
+
+      --  Alloca/allocb handling.
+      OE_Get_Stack,
+      OE_Set_Stack,
+
+      --  Get current frame pointer.
+      OE_Get_Frame,
+
+      --  Additionnal reg
+      OE_Reg
+      );
+   for OE_Kind'Size use 8;
+
+   subtype OE_Kind_Dyadic is OE_Kind range OE_Add_Ov .. OE_Xor;
+   subtype OE_Kind_Cmp is OE_Kind range OE_Eq .. OE_Gt;
+
+
+   --  BE representation of an instruction.
+   type O_Insn is mod 256;
+
+   type Subprogram_Data;
+   type Subprogram_Data_Acc is access Subprogram_Data;
+
+   type Subprogram_Data is record
+      --  Parent or null if top-level subprogram.
+      Parent : Subprogram_Data_Acc;
+
+      --  Block in which this subprogram is declared, or o_dnode_null if
+      --  top-level subprogram.
+      --Parent_Block : O_Dnode;
+
+      --  First and last child, or null if no children.
+      First_Child : Subprogram_Data_Acc;
+      Last_Child : Subprogram_Data_Acc;
+
+      --  Next subprogram at the same depth level.
+      Brother : Subprogram_Data_Acc;
+
+      --  Depth of the subprogram.
+      Depth : O_Depth;
+
+      --  Dnode for the declaration.
+      D_Decl : O_Dnode;
+
+      --  Enode for the Entry.
+      E_Entry : O_Enode;
+
+      --  Dnode for the Body.
+      D_Body : O_Dnode;
+
+      --  Label just before leave.
+      Exit_Label : O_Enode;
+
+      --  Last statement of this subprogram.
+      Last_Stmt : O_Enode;
+
+      --  Static maximum stack use.
+      Stack_Max : Uns32;
+   end record;
+
+   --  Data for the current subprogram.
+   Cur_Subprg : Subprogram_Data_Acc := null;
+
+   --  First and last (top-level) subprogram.
+   First_Subprg : Subprogram_Data_Acc := null;
+   Last_Subprg : Subprogram_Data_Acc := null;
+
+   --  Type of the stack pointer - for OE_Get_Stack and OE_Set_Stack.
+   --  Can be set by back-ends.
+   Stack_Ptr_Type : O_Tnode := O_Tnode_Null;
+
+   --  Create a new node.
+   --  Should be used only by back-end to add internal nodes.
+   function New_Enode (Kind : OE_Kind;
+                       Mode : Mode_Type;
+                       Rtype : O_Tnode;
+                       Arg1 : O_Enode;
+                       Arg2 : O_Enode) return O_Enode;
+
+   --  Get the kind of ENODE.
+   function Get_Expr_Kind (Enode : O_Enode) return OE_Kind;
+   pragma Inline (Get_Expr_Kind);
+
+   --  Get the mode of ENODE.
+   function Get_Expr_Mode (Enode : O_Enode) return Mode_Type;
+   pragma Inline (Get_Expr_Mode);
+
+   --  Get/Set the register of ENODE.
+   function Get_Expr_Reg (Enode : O_Enode) return O_Reg;
+   procedure Set_Expr_Reg (Enode : O_Enode; Reg : O_Reg);
+   pragma Inline (Get_Expr_Reg);
+   pragma Inline (Set_Expr_Reg);
+
+   --  Get the operand of an unary expression.
+   function Get_Expr_Operand (Enode : O_Enode) return O_Enode;
+   procedure Set_Expr_Operand (Enode : O_Enode; Val : O_Enode);
+
+   --  Get left/right operand of a binary expression.
+   function Get_Expr_Left (Enode : O_Enode) return O_Enode;
+   function Get_Expr_Right (Enode : O_Enode) return O_Enode;
+   procedure Set_Expr_Left (Enode : O_Enode; Val : O_Enode);
+   procedure Set_Expr_Right (Enode : O_Enode; Val : O_Enode);
+
+   --  Get the low and high part of an OE_CONST node.
+   function Get_Expr_Low (Cst : O_Enode) return Uns32;
+   function Get_Expr_High (Cst : O_Enode) return Uns32;
+
+   --  Get target of the assignment.
+   function Get_Assign_Target (Enode : O_Enode) return O_Enode;
+   procedure Set_Assign_Target (Enode : O_Enode; Targ : O_Enode);
+
+   --  For OE_Lit: get the literal.
+   function Get_Expr_Lit (Lit : O_Enode) return O_Cnode;
+
+   --  Type of a OE_Conv/OE_Nop/OE_Typed/OE_Alloca
+   --  Used only for display/debugging purposes.
+   function Get_Conv_Type (Enode : O_Enode) return O_Tnode;
+
+   --  Leave node corresponding to the entry.
+   function Get_Entry_Leave (Enode : O_Enode) return O_Enode;
+
+   --  Get the label of a jump/ret
+   function Get_Jump_Label (Enode : O_Enode) return O_Enode;
+   procedure Set_Jump_Label (Enode : O_Enode; Label : O_Enode);
+
+   --  Get the object of addrl,addrp,addrg
+   function Get_Addr_Object (Enode : O_Enode) return O_Dnode;
+
+   --  Get the computed frame for the object.
+   --  If O_Enode_Null, then use current frame.
+   function Get_Addrl_Frame (Enode : O_Enode) return O_Enode;
+   procedure Set_Addrl_Frame (Enode : O_Enode; Frame : O_Enode);
+
+   --  Return the stack adjustment. For positive values, this is the amount of
+   --  bytes to allocate on the stack before pushing arguments, so that the
+   --  stack pointer stays aligned. For negtive values, this is the amount of
+   --  bytes to release on the stack.
+   function Get_Stack_Adjust (Enode : O_Enode) return Int32;
+
+   --  Get the subprogram called by ENODE.
+   function Get_Call_Subprg (Enode : O_Enode) return O_Dnode;
+
+   --  Get the first argument of a call, or the next argument of an arg.
+   function Get_Arg_Link (Enode : O_Enode) return O_Enode;
+
+   --  Get the declaration chain of a Beg statement.
+   function Get_Block_Decls (Blk : O_Enode) return O_Dnode;
+
+   --  Get the parent of the block.
+   function Get_Block_Parent (Blk : O_Enode) return O_Enode;
+
+   --  Get the corresponding beg.
+   function Get_End_Beg (Blk : O_Enode) return O_Enode;
+
+   --  True if the block contains an alloca insn.
+   function Get_Block_Has_Alloca (Blk : O_Enode) return Boolean;
+
+   --  Set the next branch of a case/case_branch.
+   procedure Set_Case_Branch (C : O_Enode; Branch : O_Enode);
+
+   --  Set the first choice of a case branch.
+   procedure Set_Case_Branch_Choice (Branch : O_Enode; Choice : O_Enode);
+   function Get_Case_Branch_Choice (Branch : O_Enode) return O_Enode;
+
+   --  Set the choice link of a case choice.
+   procedure Set_Case_Choice_Link (Choice : O_Enode; N_Choice : O_Enode);
+   function Get_Case_Choice_Link (Choice : O_Enode) return O_Enode;
+
+   --  Get/Set the max stack size for the end block BLKE.
+   --function Get_Block_Max_Stack (Blke : O_Enode) return Int32;
+   --procedure Set_Block_Max_Stack (Blke : O_Enode; Max : Int32);
+
+   --  Get the field of an o_record_ref node.
+   function Get_Ref_Field (Ref : O_Enode) return O_Fnode;
+
+   --  Get the index of an OE_Index_Ref or OE_Slice_Ref node.
+   function Get_Ref_Index (Ref : O_Enode) return O_Enode;
+
+   --  Get/Set the info field of a label.
+   function Get_Label_Info (Label : O_Enode) return Int32;
+   procedure Set_Label_Info (Label : O_Enode; Info : Int32);
+
+   --  Get the info of a spill.
+   function Get_Spill_Info (Spill : O_Enode) return Int32;
+   procedure Set_Spill_Info (Spill : O_Enode; Info : Int32);
+
+   --  Get the statement link.
+   function Get_Stmt_Link (Stmt : O_Enode) return O_Enode;
+   procedure Set_Stmt_Link (Stmt : O_Enode; Next : O_Enode);
+
+   --  Get the line number of an OE_Line statement.
+   function Get_Expr_Line_Number (Stmt : O_Enode) return Int32;
+
+   --  Get the operation of an intrinsic.
+   function Get_Intrinsic_Operation (Stmt : O_Enode) return Int32;
+
+   --  Get the basic block label (uniq number).
+   function Get_BB_Number (Stmt : O_Enode) return Int32;
+
+   --  For OE_Loop, set loop level (an integer).
+   --  Reserved for back-end in HLI mode only.
+   function Get_Loop_Level (Stmt : O_Enode) return Int32;
+   procedure Set_Loop_Level (Stmt : O_Enode; Level : Int32);
+
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+   --  Translate a scalar literal into an expression.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Translate an object (var, const or interface) into an lvalue.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+      --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Enode;
+
+   --  Returns the offset of FIELD in its record.  The result is a literal
+   --  of unsigned type RTYPE.
+   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   type O_Assoc_List is limited private;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   type O_If_Block is limited private;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   type O_Snode is private;
+   O_Snode_Null : constant O_Snode;
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   type O_Case_Block is limited private;
+   procedure Start_Case_Stmt (Block : out O_Case_Block; Value : O_Enode);
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   procedure Disp_Subprg_Body (Indent : Natural; Subprg : O_Enode);
+   procedure Disp_All_Enode;
+   procedure Disp_Stats;
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+   procedure Finish;
+private
+   type O_Assoc_List is record
+      --  Subprogram being called.
+      Subprg : O_Dnode;
+      --  First and last argument statement.
+      First_Arg : O_Enode;
+      Last_Arg : O_Enode;
+      --  Interface for the next association.
+      Next_Inter : O_Dnode;
+   end record;
+
+   type O_Case_Block is record
+      --  Expression for the selection.
+      Expr : O_Enode;
+
+      --  Type of expression.
+      --  Used to perform checks.
+      Expr_Type : O_Tnode;
+
+      --  Choice code and branch code is not mixed (anymore).
+      --  Therefore, code to perform choices is inserted.
+      --  Last node of the choice code.
+      Last_Node : O_Enode;
+
+      --  Label at the end of the case statement.
+      --  used to jump from the end of a branch to the end of the statement.
+      Label_End : O_Enode;
+
+      --  Label of the branch code.
+      Label_Branch : O_Enode;
+   end record;
+
+   type O_If_Block is record
+      Label_End : O_Enode;
+      Label_Next : O_Enode;
+   end record;
+
+   type O_Snode is record
+      Label_Start : O_Enode;
+      Label_End : O_Enode;
+   end record;
+   O_Snode_Null : constant O_Snode := (Label_Start => O_Enode_Null,
+                                       Label_End => O_Enode_Null);
+
+   type Mark_Type is record
+      Enode : O_Enode;
+   end record;
+end Ortho_Code.Exprs;
diff --git a/src/ortho/mcode/ortho_code-flags.ads b/src/ortho/mcode/ortho_code-flags.ads
new file mode 100644
index 000000000..805f3779b
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-flags.ads
@@ -0,0 +1,35 @@
+--  Compile flags for mcode.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Ortho_Code.Flags is
+   type Debug_Type is (Debug_None, Debug_Dwarf);
+
+   --  Debugging information generated.
+   Flag_Debug : Debug_Type := Debug_None;
+
+   --  If set, generate a map from type to type declaration.
+   Flag_Type_Name : Boolean := False;
+
+   --  If set, enable optimiztions.
+   Flag_Optimize : Boolean := False;
+
+   --  If set, create basic blocks during tree building.
+   Flag_Opt_BB : Boolean := False;
+
+   --  If set, add profiling calls.
+   Flag_Profile : Boolean := False;
+end Ortho_Code.Flags;
diff --git a/src/ortho/mcode/ortho_code-opts.adb b/src/ortho/mcode/ortho_code-opts.adb
new file mode 100644
index 000000000..0ea6b039b
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-opts.adb
@@ -0,0 +1,214 @@
+--  Mcode back-end for ortho - Optimization.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Flags;
+
+package body Ortho_Code.Opts is
+   procedure Relabel_Jump (Jmp : O_Enode)
+   is
+      Label : O_Enode;
+      Bb : O_Enode;
+   begin
+      Label := Get_Jump_Label (Jmp);
+      if Get_Expr_Kind (Label) = OE_Label then
+         Bb := O_Enode (Get_Label_Info (Label));
+         if Bb /= O_Enode_Null then
+            Set_Jump_Label (Jmp, Bb);
+         end if;
+      end if;
+   end Relabel_Jump;
+
+   procedure Jmp_To_Bb (Subprg : Subprogram_Data_Acc)
+   is
+      First : O_Enode;
+      Stmt : O_Enode;
+      Prev : O_Enode;
+      Cur_Bb : O_Enode;
+   begin
+      --  Get first statement after entry.
+      First := Get_Stmt_Link (Subprg.E_Entry);
+
+      --  First loop:
+      --  If a label belongs to a BB (ie, is at the beginning of a BB),
+      --  then link it to the BB.
+      Stmt := First;
+      Cur_Bb := O_Enode_Null;
+      loop
+         case Get_Expr_Kind (Stmt) is
+            when OE_Leave =>
+               exit;
+            when OE_BB =>
+               Cur_Bb := Stmt;
+            when OE_Label =>
+               if Cur_Bb /= O_Enode_Null then
+                  Set_Label_Info (Stmt, Int32 (Cur_Bb));
+               end if;
+            when OE_Jump
+              | OE_Jump_T
+              | OE_Jump_F =>
+               --  This handles backward jump.
+               Relabel_Jump (Stmt);
+            when others =>
+               Cur_Bb := O_Enode_Null;
+         end case;
+         Stmt := Get_Stmt_Link (Stmt);
+      end loop;
+
+      --  Second loop:
+      --  Transform jump to label to jump to BB.
+      Stmt := First;
+      Prev := O_Enode_Null;
+      loop
+         case Get_Expr_Kind (Stmt) is
+            when OE_Leave =>
+               exit;
+            when OE_Jump
+              | OE_Jump_T
+              | OE_Jump_F =>
+               --  This handles forward jump.
+               Relabel_Jump (Stmt);
+               --  Update PREV.
+               Prev := Stmt;
+            when OE_Label =>
+               --  Remove the Label.
+               --  Do not update PREV.
+               if Get_Label_Info (Stmt) /= 0 then
+                  Set_Stmt_Link (Prev, Get_Stmt_Link (Stmt));
+               end if;
+            when others =>
+               Prev := Stmt;
+         end case;
+         Stmt := Get_Stmt_Link (Stmt);
+      end loop;
+   end Jmp_To_Bb;
+
+   type Oe_Kind_Bool_Array is array (OE_Kind) of Boolean;
+   Is_Passive_Stmt : constant Oe_Kind_Bool_Array :=
+     (OE_Label | OE_BB | OE_End | OE_Beg => True,
+      others => False);
+
+   --  Return the next statement after STMT which really execute instructions.
+   function Get_Fall_Stmt (Stmt : O_Enode) return O_Enode
+   is
+      Res : O_Enode;
+   begin
+      Res := Stmt;
+      loop
+         Res := Get_Stmt_Link (Res);
+         case Get_Expr_Kind (Res) is
+            when OE_Label
+              | OE_BB
+              | OE_End
+              | OE_Beg =>
+               null;
+            when others =>
+               return Res;
+         end case;
+      end loop;
+   end Get_Fall_Stmt;
+   pragma Unreferenced (Get_Fall_Stmt);
+
+   procedure Thread_Jump (Subprg : Subprogram_Data_Acc)
+   is
+      First : O_Enode;
+      Stmt : O_Enode;
+      Prev, Next : O_Enode;
+      Kind : OE_Kind;
+   begin
+      --  Get first statement after entry.
+      First := Get_Stmt_Link (Subprg.E_Entry);
+
+      --  First loop:
+      --  If a label belongs to a BB (ie, is at the beginning of a BB),
+      --  then link it to the BB.
+      Stmt := First;
+      Prev := O_Enode_Null;
+      loop
+         Next := Get_Stmt_Link (Stmt);
+         Kind := Get_Expr_Kind (Stmt);
+         case Kind is
+            when OE_Leave =>
+               exit;
+            when OE_Jump =>
+               --  Remove the jump if followed by the label.
+               --    * For _T/_F: should convert to a ignore value.
+               --  Discard unreachable statements after the jump.
+               declare
+                  N_Stmt : O_Enode;
+                  P_Stmt : O_Enode;
+                  Label : O_Enode;
+                  Flag_Discard : Boolean;
+                  K_Stmt : OE_Kind;
+               begin
+                  N_Stmt := Next;
+                  P_Stmt := Stmt;
+                  Label := Get_Jump_Label (Stmt);
+                  Flag_Discard := True;
+                  loop
+                     if N_Stmt = Label then
+                        --  Remove STMT.
+                        Set_Stmt_Link (Prev, Next);
+                        exit;
+                     end if;
+                     K_Stmt := Get_Expr_Kind (N_Stmt);
+                     if K_Stmt = OE_Label then
+                        --  Do not discard anymore statements, since they are
+                        --  now reachable.
+                        Flag_Discard := False;
+                     end if;
+                     if not Is_Passive_Stmt (K_Stmt) then
+                        if not Flag_Discard then
+                           --  We have found the next statement.
+                           --  Keep the jump.
+                           Prev := Stmt;
+                           exit;
+                        else
+                           --  Delete insn.
+                           N_Stmt := Get_Stmt_Link (N_Stmt);
+                           Set_Stmt_Link (P_Stmt, N_Stmt);
+                        end if;
+                     else
+                        --  Iterate.
+                        P_Stmt := N_Stmt;
+                        N_Stmt := Get_Stmt_Link (N_Stmt);
+                     end if;
+                  end loop;
+               end;
+            when others =>
+               Prev := Stmt;
+         end case;
+         Stmt := Next;
+      end loop;
+   end Thread_Jump;
+
+   procedure Optimize_Subprg (Subprg : Subprogram_Data_Acc)
+   is
+   begin
+      --  Jump optimisation:
+      --  * discard insns after a OE_JUMP.
+      --  * Remove jump if followed by label
+      --    (through label, BB, comments, end, line)
+      --  * Redirect jump to jump (infinite loop !)
+      --  * Revert jump_t/f if expr is not (XXX)
+      --  * Jmp_t/f L:; jmp L2; L1:  ->  jmp_f/t L2
+      Thread_Jump (Subprg);
+      if Flags.Flag_Opt_BB then
+         Jmp_To_Bb (Subprg);
+      end if;
+   end Optimize_Subprg;
+end Ortho_Code.Opts;
+
diff --git a/src/ortho/mcode/ortho_code-opts.ads b/src/ortho/mcode/ortho_code-opts.ads
new file mode 100644
index 000000000..27a907c7b
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-opts.ads
@@ -0,0 +1,22 @@
+--  Mcode back-end for ortho - Optimization.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+package Ortho_Code.Opts is
+   procedure Optimize_Subprg (Subprg : Subprogram_Data_Acc);
+end Ortho_Code.Opts;
diff --git a/src/ortho/mcode/ortho_code-types.adb b/src/ortho/mcode/ortho_code-types.adb
new file mode 100644
index 000000000..e0c070c27
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-types.adb
@@ -0,0 +1,820 @@
+--  Mcode back-end for ortho - type handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO;
+with Ada.Unchecked_Conversion;
+with GNAT.Table;
+with Ortho_Code.Consts; use Ortho_Code.Consts;
+with Ortho_Code.Debug;
+with Ortho_Code.Abi; use Ortho_Code.Abi;
+with Ortho_Ident;
+
+package body Ortho_Code.Types is
+   type Bool_Array is array (Natural range <>) of Boolean;
+   pragma Pack (Bool_Array);
+
+   type Tnode_Common is record
+      Kind : OT_Kind; -- 4 bits.
+      Mode : Mode_Type; -- 4 bits.
+      Align : Small_Natural; -- 2 bits.
+      Deferred : Boolean; -- 1 bit (True if the type was incomplete at first)
+      Flag1 : Boolean;
+      Pad0 : Bool_Array (0 .. 19);
+      Size : Uns32;
+   end record;
+   pragma Pack (Tnode_Common);
+   for Tnode_Common'Size use 64;
+
+   type Tnode_Access is record
+      Dtype : O_Tnode;
+      Pad : Uns32;
+   end record;
+
+   type Tnode_Array is record
+      Element_Type : O_Tnode;
+      Index_Type : O_Tnode;
+   end record;
+
+   type Tnode_Subarray is record
+      Base_Type : O_Tnode;
+      Length : Uns32;
+   end record;
+
+   type Tnode_Record is record
+      Fields : O_Fnode;
+      Nbr_Fields : Uns32;
+   end record;
+
+   type Tnode_Enum is record
+      Lits : O_Cnode;
+      Nbr_Lits : Uns32;
+   end record;
+
+   type Tnode_Bool is record
+      Lit_False : O_Cnode;
+      Lit_True : O_Cnode;
+   end record;
+
+   package Tnodes is new GNAT.Table
+     (Table_Component_Type => Tnode_Common,
+      Table_Index_Type => O_Tnode,
+      Table_Low_Bound => O_Tnode_First,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   type Field_Type is record
+      Parent : O_Tnode;
+      Ident : O_Ident;
+      Ftype : O_Tnode;
+      Offset : Uns32;
+      Next : O_Fnode;
+   end record;
+
+   package Fnodes is new GNAT.Table
+     (Table_Component_Type => Field_Type,
+      Table_Index_Type => O_Fnode,
+      Table_Low_Bound => 2,
+      Table_Initial => 64,
+      Table_Increment => 100);
+
+   function Get_Type_Kind (Atype : O_Tnode) return OT_Kind is
+   begin
+      return Tnodes.Table (Atype).Kind;
+   end Get_Type_Kind;
+
+   function Get_Type_Size (Atype : O_Tnode) return Uns32 is
+   begin
+      return Tnodes.Table (Atype).Size;
+   end Get_Type_Size;
+
+   function Get_Type_Align (Atype : O_Tnode) return Small_Natural is
+   begin
+      return Tnodes.Table (Atype).Align;
+   end Get_Type_Align;
+
+   function Get_Type_Align_Bytes (Atype : O_Tnode) return Uns32 is
+   begin
+      return 2 ** Get_Type_Align (Atype);
+   end Get_Type_Align_Bytes;
+
+   function Get_Type_Mode (Atype : O_Tnode) return Mode_Type is
+   begin
+      return Tnodes.Table (Atype).Mode;
+   end Get_Type_Mode;
+
+   function Get_Type_Deferred (Atype : O_Tnode) return Boolean is
+   begin
+      return Tnodes.Table (Atype).Deferred;
+   end Get_Type_Deferred;
+
+   function Get_Type_Flag1 (Atype : O_Tnode) return Boolean is
+   begin
+      return Tnodes.Table (Atype).Flag1;
+   end Get_Type_Flag1;
+
+   procedure Set_Type_Flag1 (Atype : O_Tnode; Flag : Boolean) is
+   begin
+      Tnodes.Table (Atype).Flag1 := Flag;
+   end Set_Type_Flag1;
+
+   function To_Tnode_Access is new Ada.Unchecked_Conversion
+        (Source => Tnode_Common, Target => Tnode_Access);
+
+   function Get_Type_Access_Type (Atype : O_Tnode) return O_Tnode
+   is
+   begin
+      return To_Tnode_Access (Tnodes.Table (Atype + 1)).Dtype;
+   end Get_Type_Access_Type;
+
+
+   function To_Tnode_Array is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Array);
+
+   function Get_Type_Ucarray_Index (Atype : O_Tnode) return O_Tnode is
+   begin
+      return To_Tnode_Array (Tnodes.Table (Atype + 1)).Index_Type;
+   end Get_Type_Ucarray_Index;
+
+   function Get_Type_Ucarray_Element (Atype : O_Tnode) return O_Tnode is
+   begin
+      return To_Tnode_Array (Tnodes.Table (Atype + 1)).Element_Type;
+   end Get_Type_Ucarray_Element;
+
+
+   function To_Tnode_Subarray is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Subarray);
+
+   function Get_Type_Subarray_Base (Atype : O_Tnode) return O_Tnode is
+   begin
+      return To_Tnode_Subarray (Tnodes.Table (Atype + 1)).Base_Type;
+   end Get_Type_Subarray_Base;
+
+   function Get_Type_Subarray_Length (Atype : O_Tnode) return Uns32 is
+   begin
+      return To_Tnode_Subarray (Tnodes.Table (Atype + 1)).Length;
+   end Get_Type_Subarray_Length;
+
+
+   function To_Tnode_Record is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Record);
+
+   function Get_Type_Record_Fields (Atype : O_Tnode) return O_Fnode is
+   begin
+      return To_Tnode_Record (Tnodes.Table (Atype + 1)).Fields;
+   end Get_Type_Record_Fields;
+
+   function Get_Type_Record_Nbr_Fields (Atype : O_Tnode) return Uns32 is
+   begin
+      return To_Tnode_Record (Tnodes.Table (Atype + 1)).Nbr_Fields;
+   end Get_Type_Record_Nbr_Fields;
+
+   function To_Tnode_Enum is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Enum);
+
+   function Get_Type_Enum_Lits (Atype : O_Tnode) return O_Cnode is
+   begin
+      return To_Tnode_Enum (Tnodes.Table (Atype + 1)).Lits;
+   end Get_Type_Enum_Lits;
+
+   function Get_Type_Enum_Lit (Atype : O_Tnode; Pos : Uns32) return O_Cnode
+   is
+      F : O_Cnode;
+   begin
+      F := Get_Type_Enum_Lits (Atype);
+      return F + 2 * O_Cnode (Pos);
+   end Get_Type_Enum_Lit;
+
+   function Get_Type_Enum_Nbr_Lits (Atype : O_Tnode) return Uns32 is
+   begin
+      return To_Tnode_Enum (Tnodes.Table (Atype + 1)).Nbr_Lits;
+   end Get_Type_Enum_Nbr_Lits;
+
+
+   function To_Tnode_Bool is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Bool);
+
+   function Get_Type_Bool_False (Atype : O_Tnode) return O_Cnode is
+   begin
+      return To_Tnode_Bool (Tnodes.Table (Atype + 1)).Lit_False;
+   end Get_Type_Bool_False;
+
+   function Get_Type_Bool_True (Atype : O_Tnode) return O_Cnode is
+   begin
+      return To_Tnode_Bool (Tnodes.Table (Atype + 1)).Lit_True;
+   end Get_Type_Bool_True;
+
+   function Get_Field_Offset (Field : O_Fnode) return Uns32 is
+   begin
+      return Fnodes.Table (Field).Offset;
+   end Get_Field_Offset;
+
+   procedure Set_Field_Offset (Field : O_Fnode; Offset : Uns32) is
+   begin
+      Fnodes.Table (Field).Offset := Offset;
+   end Set_Field_Offset;
+
+   function Get_Field_Parent (Field : O_Fnode) return O_Tnode is
+   begin
+      return Fnodes.Table (Field).Parent;
+   end Get_Field_Parent;
+
+   function Get_Field_Type (Field : O_Fnode) return O_Tnode is
+   begin
+      return Fnodes.Table (Field).Ftype;
+   end Get_Field_Type;
+
+   function Get_Field_Ident (Field : O_Fnode) return O_Ident is
+   begin
+      return Fnodes.Table (Field).Ident;
+   end Get_Field_Ident;
+
+   function Get_Field_Chain (Field : O_Fnode) return O_Fnode is
+   begin
+      return Fnodes.Table (Field).Next;
+   end Get_Field_Chain;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode
+   is
+      Mode : Mode_Type;
+      Sz : Uns32;
+   begin
+      case Size is
+         when 8 =>
+            Mode := Mode_U8;
+            Sz := 1;
+         when 16 =>
+            Mode := Mode_U16;
+            Sz := 2;
+         when 32 =>
+            Mode := Mode_U32;
+            Sz := 4;
+         when 64 =>
+            Mode := Mode_U64;
+            Sz := 8;
+         when others =>
+            raise Program_Error;
+      end case;
+      Tnodes.Append (Tnode_Common'(Kind => OT_Unsigned,
+                                   Mode => Mode,
+                                   Align => Mode_Align (Mode),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => Sz));
+      return Tnodes.Last;
+   end New_Unsigned_Type;
+
+   function New_Signed_Type (Size : Natural) return O_Tnode
+   is
+      Mode : Mode_Type;
+      Sz : Uns32;
+   begin
+      case Size is
+         when 8 =>
+            Mode := Mode_I8;
+            Sz := 1;
+         when 16 =>
+            Mode := Mode_I16;
+            Sz := 2;
+         when 32 =>
+            Mode := Mode_I32;
+            Sz := 4;
+         when 64 =>
+            Mode := Mode_I64;
+            Sz := 8;
+         when others =>
+            raise Program_Error;
+      end case;
+      Tnodes.Append (Tnode_Common'(Kind => OT_Signed,
+                                   Mode => Mode,
+                                   Align => Mode_Align (Mode),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => Sz));
+      return Tnodes.Last;
+   end New_Signed_Type;
+
+   function New_Float_Type return O_Tnode is
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Float,
+                                   Mode => Mode_F64,
+                                   Align => Mode_Align (Mode_F64),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 8));
+      return Tnodes.Last;
+   end New_Float_Type;
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Enum, Target => Tnode_Common);
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+      Mode : Mode_Type;
+      Sz : Uns32;
+   begin
+      case Size is
+         when 8 =>
+            Mode := Mode_U8;
+            Sz := 1;
+         when 16 =>
+            Mode := Mode_U16;
+            Sz := 2;
+         when 32 =>
+            Mode := Mode_U32;
+            Sz := 4;
+         when 64 =>
+            Mode := Mode_U64;
+            Sz := 8;
+         when others =>
+            raise Program_Error;
+      end case;
+      Tnodes.Append (Tnode_Common'(Kind => OT_Enum,
+                                   Mode => Mode,
+                                   Align => Mode_Align (Mode),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => Sz));
+      List := (Res => Tnodes.Last,
+               First => O_Cnode_Null,
+               Last => O_Cnode_Null,
+               Nbr => 0);
+      Tnodes.Increment_Last;
+   end Start_Enum_Type;
+
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode)
+   is
+   begin
+      Res := New_Named_Literal (List.Res, Ident, List.Nbr, List.Last);
+      List.Nbr := List.Nbr + 1;
+      if List.Last = O_Cnode_Null then
+         List.First := Res;
+      end if;
+      List.Last := Res;
+   end New_Enum_Literal;
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := List.Res;
+      Tnodes.Table (List.Res + 1) := To_Tnode_Common
+        (Tnode_Enum'(Lits => List.First,
+                     Nbr_Lits => List.Nbr));
+   end Finish_Enum_Type;
+
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Bool, Target => Tnode_Common);
+
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode)
+   is
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Boolean,
+                                   Mode => Mode_B2,
+                                   Align => 0,
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 1));
+      Res := Tnodes.Last;
+      False_E := New_Named_Literal (Res, False_Id, 0, O_Cnode_Null);
+      True_E := New_Named_Literal (Res, True_Id, 1, False_E);
+      Tnodes.Append (To_Tnode_Common (Tnode_Bool'(Lit_False => False_E,
+                                                 Lit_True => True_E)));
+   end New_Boolean_Type;
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Array, Target => Tnode_Common);
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+                           return O_Tnode
+   is
+      Res : O_Tnode;
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Ucarray,
+                                   Mode => Mode_Blk,
+                                   Align => Get_Type_Align (El_Type),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 0));
+      Res := Tnodes.Last;
+      Tnodes.Append (To_Tnode_Common (Tnode_Array'(Element_Type => El_Type,
+                                                   Index_Type => Index_Type)));
+      return Res;
+   end New_Array_Type;
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Subarray, Target => Tnode_Common);
+
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : Uns32)
+                                       return O_Tnode
+   is
+      Res : O_Tnode;
+      Size : Uns32;
+   begin
+      Size := Get_Type_Size (Get_Type_Array_Element (Atype));
+      Tnodes.Append (Tnode_Common'(Kind => OT_Subarray,
+                                   Mode => Mode_Blk,
+                                   Align => Get_Type_Align (Atype),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => Size * Length));
+      Res := Tnodes.Last;
+      Tnodes.Append (To_Tnode_Common (Tnode_Subarray'(Base_Type => Atype,
+                                                      Length => Length)));
+      return Res;
+   end New_Constrained_Array_Type;
+
+   procedure Create_Completer (Atype : O_Tnode) is
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Complete,
+                                   Mode => Mode_Nil,
+                                   Align => 0,
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => To_Uns32 (Int32 (Atype))));
+   end Create_Completer;
+
+   function Get_Type_Complete_Type (Atype : O_Tnode) return O_Tnode is
+   begin
+      return O_Tnode (To_Int32 (Tnodes.Table (Atype).Size));
+   end Get_Type_Complete_Type;
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Access, Target => Tnode_Common);
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode
+   is
+      Res : O_Tnode;
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Access,
+                                   Mode => Mode_P32,
+                                   Align => Mode_Align (Mode_P32),
+                                   Deferred => Dtype = O_Tnode_Null,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 4));
+      Res := Tnodes.Last;
+      Tnodes.Append (To_Tnode_Common (Tnode_Access'(Dtype => Dtype,
+                                                    Pad => 0)));
+      return Res;
+   end New_Access_Type;
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) is
+   begin
+      if Get_Type_Access_Type (Atype) /= O_Tnode_Null then
+         raise Program_Error;
+      end if;
+      Tnodes.Table (Atype + 1) :=
+        To_Tnode_Common (Tnode_Access'(Dtype => Dtype,
+                                       Pad => 0));
+      if Flag_Type_Completer then
+         Create_Completer (Atype);
+      end if;
+   end Finish_Access_Type;
+
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Record, Target => Tnode_Common);
+
+   function Create_Record_Type (Deferred : Boolean) return O_Tnode
+   is
+      Res : O_Tnode;
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Record,
+                                   Mode => Mode_Blk,
+                                   Align => 0,
+                                   Deferred => Deferred,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 0));
+      Res := Tnodes.Last;
+      Tnodes.Append (To_Tnode_Common (Tnode_Record'(Fields => O_Fnode_Null,
+                                                    Nbr_Fields => 0)));
+      return Res;
+   end Create_Record_Type;
+
+   procedure Start_Record_Type (Elements : out O_Element_List)
+   is
+   begin
+      Elements := (Res => Create_Record_Type (False),
+                   First_Field => O_Fnode_Null,
+                   Last_Field => O_Fnode_Null,
+                   Off => 0,
+                   Align => 0,
+                   Nbr => 0);
+   end Start_Record_Type;
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      Res := Create_Record_Type (True);
+   end New_Uncomplete_Record_Type;
+
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List)
+   is
+   begin
+      Elements := (Res => Res,
+                   First_Field => O_Fnode_Null,
+                   Last_Field => O_Fnode_Null,
+                   Off => 0,
+                   Align => 0,
+                   Nbr => 0);
+   end Start_Uncomplete_Record_Type;
+
+   function Get_Mode_Size (Mode : Mode_Type) return Uns32 is
+   begin
+      case Mode is
+         when Mode_B2
+           | Mode_U8
+           | Mode_I8 =>
+            return 1;
+         when Mode_I16
+           | Mode_U16 =>
+            return 2;
+         when Mode_I32
+           | Mode_U32
+           | Mode_P32
+           | Mode_F32 =>
+            return 4;
+         when Mode_I64
+           | Mode_U64
+           | Mode_P64
+           | Mode_F64 =>
+            return 8;
+         when Mode_X1
+           | Mode_Nil
+           | Mode_Blk =>
+            raise Program_Error;
+      end case;
+   end Get_Mode_Size;
+
+   function Do_Align (Off : Uns32; Atype : O_Tnode) return Uns32
+   is
+      Msk : constant Uns32 := Get_Type_Align_Bytes (Atype) - 1;
+   begin
+      --  Align.
+      return (Off + Msk) and (not Msk);
+   end Do_Align;
+
+   function Do_Align (Off : Uns32; Mode : Mode_Type) return Uns32
+   is
+      Msk : constant Uns32 := (2 ** Mode_Align (Mode)) - 1;
+   begin
+      --  Align.
+      return (Off + Msk) and (not Msk);
+   end Do_Align;
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+   begin
+      Elements.Off := Do_Align (Elements.Off, Etype);
+
+      Fnodes.Append (Field_Type'(Parent => Elements.Res,
+                                 Ident => Ident,
+                                 Ftype => Etype,
+                                 Offset => Elements.Off,
+                                 Next => O_Fnode_Null));
+      El := Fnodes.Last;
+      Elements.Off := Elements.Off + Get_Type_Size (Etype);
+      if Get_Type_Align (Etype) > Elements.Align then
+         Elements.Align := Get_Type_Align (Etype);
+      end if;
+      if Elements.Last_Field /= O_Fnode_Null then
+         Fnodes.Table (Elements.Last_Field).Next := Fnodes.Last;
+      else
+         Elements.First_Field := Fnodes.Last;
+      end if;
+      Elements.Last_Field := Fnodes.Last;
+      Elements.Nbr := Elements.Nbr + 1;
+   end New_Record_Field;
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode)
+   is
+   begin
+      Tnodes.Table (Elements.Res).Size := Do_Align (Elements.Off,
+                                                    Elements.Res);
+      Tnodes.Table (Elements.Res).Align := Elements.Align;
+      Tnodes.Table (Elements.Res + 1) := To_Tnode_Common
+        (Tnode_Record'(Fields => Elements.First_Field,
+                       Nbr_Fields => Elements.Nbr));
+      Res := Elements.Res;
+      if Flag_Type_Completer
+        and then Tnodes.Table (Elements.Res).Deferred
+      then
+         Create_Completer (Elements.Res);
+      end if;
+   end Finish_Record_Type;
+
+   procedure Start_Union_Type (Elements : out O_Element_List)
+   is
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Union,
+                                   Mode => Mode_Blk,
+                                   Align => 0,
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 0));
+      Elements := (Res => Tnodes.Last,
+                   First_Field => O_Fnode_Null,
+                   Last_Field => O_Fnode_Null,
+                   Off => 0,
+                   Align => 0,
+                   Nbr => 0);
+      Tnodes.Append (To_Tnode_Common (Tnode_Record'(Fields => O_Fnode_Null,
+                                                   Nbr_Fields => 0)));
+   end Start_Union_Type;
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+      Off : Uns32;
+   begin
+      Off := Elements.Off;
+      Elements.Off := 0;
+      New_Record_Field (Elements, El, Ident, Etype);
+      if Off > Elements.Off then
+         Elements.Off := Off;
+      end if;
+   end New_Union_Field;
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode)
+   is
+   begin
+      Finish_Record_Type (Elements, Res);
+   end Finish_Union_Type;
+
+   function Get_Type_Array_Element (Atype : O_Tnode) return O_Tnode
+   is
+      Base : O_Tnode;
+   begin
+      case Get_Type_Kind (Atype) is
+         when OT_Ucarray =>
+            Base := Atype;
+         when OT_Subarray =>
+            Base := Get_Type_Subarray_Base (Atype);
+         when others =>
+            raise Program_Error;
+      end case;
+      return Get_Type_Ucarray_Element (Base);
+   end Get_Type_Array_Element;
+
+   procedure Debug_Type (Atype : O_Tnode)
+   is
+      use Ortho_Code.Debug.Int32_IO;
+      use Ada.Text_IO;
+      Kind : OT_Kind;
+   begin
+      Put (Int32 (Atype), 3);
+      Put (" ");
+      Kind := Get_Type_Kind (Atype);
+      Put (OT_Kind'Image (Get_Type_Kind (Atype)));
+      Put ("  ");
+      Put (Mode_Type'Image (Get_Type_Mode (Atype)));
+      Put (" D=");
+      Put (Boolean'Image (Get_Type_Deferred (Atype)));
+      Put (" F1=");
+      Put (Boolean'Image (Get_Type_Flag1 (Atype)));
+      New_Line;
+      case Kind is
+         when OT_Boolean =>
+            Put ("  false: ");
+            Put (Int32 (Get_Type_Bool_False (Atype)));
+            Put (", true: ");
+            Put (Int32 (Get_Type_Bool_True (Atype)));
+            New_Line;
+         when OT_Access =>
+            Put (" acc_type: ");
+            Put (Int32 (Get_Type_Access_Type (Atype)));
+            New_Line;
+         when OT_Record =>
+            Put ("  fields: ");
+            Put (Int32 (Get_Type_Record_Fields (Atype)));
+            Put (", nbr_fields: ");
+            Put (To_Int32 (Get_Type_Record_Nbr_Fields (Atype)));
+            New_Line;
+         when OT_Subarray =>
+            Put ("  base type: ");
+            Put (Int32 (Get_Type_Subarray_Base (Atype)));
+            Put (", length: ");
+            Put (To_Int32 (Get_Type_Subarray_Length (Atype)));
+            New_Line;
+         when others =>
+            null;
+      end case;
+   end Debug_Type;
+
+   procedure Debug_Field (Field : O_Fnode)
+   is
+      use Ortho_Code.Debug.Int32_IO;
+      use Ada.Text_IO;
+   begin
+      Put (Int32 (Field), 3);
+      Put (" ");
+      Put (" Offset=");
+      Put (To_Int32 (Get_Field_Offset (Field)), 0);
+      Put (", Ident=");
+      Put (Ortho_Ident.Get_String (Get_Field_Ident (Field)));
+      Put (", Type=");
+      Put (Int32 (Get_Field_Type (Field)), 0);
+      Put (", Chain=");
+      Put (Int32 (Get_Field_Chain (Field)), 0);
+      New_Line;
+   end Debug_Field;
+
+   function Get_Type_Limit return O_Tnode is
+   begin
+      return Tnodes.Last;
+   end Get_Type_Limit;
+
+   function Get_Type_Next (Atype : O_Tnode) return O_Tnode is
+   begin
+      case Tnodes.Table (Atype).Kind is
+         when OT_Unsigned
+           | OT_Signed
+           | OT_Float =>
+            return Atype + 1;
+         when OT_Boolean
+           | OT_Enum
+           | OT_Ucarray
+           | OT_Subarray
+           | OT_Access
+           | OT_Record
+           | OT_Union =>
+            return Atype + 2;
+         when OT_Complete =>
+            return Atype + 1;
+      end case;
+   end Get_Type_Next;
+
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode
+   is
+   begin
+      case Get_Type_Kind (Atype) is
+         when OT_Subarray =>
+            return Get_Type_Subarray_Base (Atype);
+         when others =>
+            return Atype;
+      end case;
+   end Get_Base_Type;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Tnode := Tnodes.Last;
+      M.Fnode := Fnodes.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Tnodes.Set_Last (M.Tnode);
+      Fnodes.Set_Last (M.Fnode);
+   end Release;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Tnodes: " & O_Tnode'Image (Tnodes.Last));
+      Put_Line ("Number of Fnodes: " & O_Fnode'Image (Fnodes.Last));
+   end Disp_Stats;
+
+   procedure Finish is
+   begin
+      Tnodes.Free;
+      Fnodes.Free;
+   end Finish;
+end Ortho_Code.Types;
diff --git a/src/ortho/mcode/ortho_code-types.ads b/src/ortho/mcode/ortho_code-types.ads
new file mode 100644
index 000000000..da6549841
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-types.ads
@@ -0,0 +1,240 @@
+--  Mcode back-end for ortho - type handling.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Ortho_Code.Types is
+   type OT_Kind is (OT_Unsigned, OT_Signed, OT_Boolean, OT_Enum, OT_Float,
+                    OT_Ucarray, OT_Subarray, OT_Access,
+                    OT_Record, OT_Union,
+
+                    --  Type completion.  Mark the completion of a type.
+                    --  Optionnal.
+                    OT_Complete);
+
+   --  Kind of ATYPE.
+   function Get_Type_Kind (Atype : O_Tnode) return OT_Kind;
+
+   --  Number of bytes of type ATYPE.
+   function Get_Type_Size (Atype : O_Tnode) return Uns32;
+
+   --  Same as Get_Type_Size but for modes.
+   --  Returns 0 in case of error.
+   function Get_Mode_Size (Mode : Mode_Type) return Uns32;
+
+   --  Alignment for ATYPE, in power of 2.
+   subtype Small_Natural is Natural range 0 .. 3;
+   type Mode_Align_Array is array (Mode_Type) of Small_Natural;
+   function Get_Type_Align (Atype : O_Tnode) return Small_Natural;
+
+   --  Alignment for ATYPE in bytes.
+   function Get_Type_Align_Bytes (Atype : O_Tnode) return Uns32;
+
+   --  Return true is the type was incomplete at creation.
+   --  (it may - or not - have been completed later).
+   function Get_Type_Deferred (Atype : O_Tnode) return Boolean;
+
+   --  A back-end reserved flag.
+   --  Initialized to False.
+   function Get_Type_Flag1 (Atype : O_Tnode) return Boolean;
+   procedure Set_Type_Flag1 (Atype : O_Tnode; Flag : Boolean);
+
+   --  Align OFF on ATYPE.
+   function Do_Align (Off : Uns32; Atype : O_Tnode) return Uns32;
+   function Do_Align (Off : Uns32; Mode : Mode_Type) return Uns32;
+
+   --  Get the mode for ATYPE.
+   function Get_Type_Mode (Atype : O_Tnode) return Mode_Type;
+
+   --  Get the type designated by access type ATYPE.
+   function Get_Type_Access_Type (Atype : O_Tnode) return O_Tnode;
+
+   --  Get the index type of array type ATYPE.
+   function Get_Type_Ucarray_Index (Atype : O_Tnode) return O_Tnode;
+
+   --  Get the element type of array type ATYPE.
+   function Get_Type_Ucarray_Element (Atype : O_Tnode) return O_Tnode;
+
+   --  Get the base type of array type ATYPE.
+   function Get_Type_Subarray_Base (Atype : O_Tnode) return O_Tnode;
+
+   --  Get number of element for array type ATYPE.
+   function Get_Type_Subarray_Length (Atype : O_Tnode) return Uns32;
+
+   --  Get the first field of record/union ATYPE.
+   function Get_Type_Record_Fields (Atype : O_Tnode) return O_Fnode;
+
+   --  Get the number of fields of record/union ATYPE.
+   function Get_Type_Record_Nbr_Fields (Atype : O_Tnode) return Uns32;
+
+   --  Get the first literal of enum type ATYPE.
+   function Get_Type_Enum_Lits (Atype : O_Tnode) return O_Cnode;
+
+   --  Get the POS th literal of enum type ATYPE.
+   --  The first is when POS = 0.
+   function Get_Type_Enum_Lit (Atype : O_Tnode; Pos : Uns32) return O_Cnode;
+
+   --  Get the number of literals of enum type ATYPE.
+   function Get_Type_Enum_Nbr_Lits (Atype : O_Tnode) return Uns32;
+
+   --  Get the false/true literal of boolean type ATYPE.
+   function Get_Type_Bool_False (Atype : O_Tnode) return O_Cnode;
+   function Get_Type_Bool_True (Atype : O_Tnode) return O_Cnode;
+
+   --  Return the union/record type which contains FIELD.
+   function Get_Field_Parent (Field : O_Fnode) return O_Tnode;
+
+   --  Get the offset of FIELD in its record/union.
+   function Get_Field_Offset (Field : O_Fnode) return Uns32;
+   procedure Set_Field_Offset (Field : O_Fnode; Offset : Uns32);
+
+   --  Get the type of FIELD.
+   function Get_Field_Type (Field : O_Fnode) return O_Tnode;
+
+   --  Get the name of FIELD.
+   function Get_Field_Ident (Field : O_Fnode) return O_Ident;
+
+   --  Get the next field.
+   function Get_Field_Chain (Field : O_Fnode) return O_Fnode;
+
+   --  Get the type that was completed.
+   function Get_Type_Complete_Type (Atype : O_Tnode) return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : Uns32)
+     return O_Tnode;
+
+   --  Return the base type of ATYPE: for a subarray this is the uc array,
+   --  otherwise this is the type.
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode;
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Non-primitives.
+
+   --  Type of an element of a ucarray or constrained array.
+   function Get_Type_Array_Element (Atype : O_Tnode) return O_Tnode;
+
+   --  Get a type number limit (an O_Tnode is a number).
+   --  There is no type whose number is beyond this limit.
+   --  Note: the limit may not be a type!
+   function Get_Type_Limit return O_Tnode;
+
+   --  Get the type which follows ATYPE.
+   --  User has to check that the result is valid (ie not beyond limit).
+   function Get_Type_Next (Atype : O_Tnode) return O_Tnode;
+
+   procedure Disp_Stats;
+
+   --  Free all the memory used.
+   procedure Finish;
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+   procedure Debug_Type (Atype : O_Tnode);
+   procedure Debug_Field (Field : O_Fnode);
+private
+   type O_Enum_List is record
+      Res : O_Tnode;
+      First : O_Cnode;
+      Last : O_Cnode;
+      Nbr : Uns32;
+   end record;
+
+   type O_Element_List is record
+      Res : O_Tnode;
+      Nbr : Uns32;
+      Off : Uns32;
+      Align : Small_Natural;
+      First_Field : O_Fnode;
+      Last_Field : O_Fnode;
+   end record;
+
+   type Mark_Type is record
+      Tnode : O_Tnode;
+      Fnode : O_Fnode;
+   end record;
+
+end Ortho_Code.Types;
+
diff --git a/src/ortho/mcode/ortho_code-x86-abi.adb b/src/ortho/mcode/ortho_code-x86-abi.adb
new file mode 100644
index 000000000..bb06d51d4
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-abi.adb
@@ -0,0 +1,762 @@
+--  X86 ABI definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+with Ortho_Code.Consts;
+with Ortho_Code.Debug;
+with Ortho_Code.Disps;
+with Ortho_Code.Flags;
+with Ortho_Code.Dwarf;
+with Ortho_Code.X86; use Ortho_Code.X86;
+with Ortho_Code.X86.Insns;
+with Ortho_Code.X86.Emits;
+with Ortho_Code.X86.Flags;
+with Binary_File;
+with Binary_File.Memory;
+with Ada.Text_IO;
+
+package body Ortho_Code.X86.Abi is
+   procedure Start_Subprogram (Subprg : O_Dnode; Abi : out O_Abi_Subprg)
+   is
+      pragma Unreferenced (Subprg);
+   begin
+      --  First argument is at %ebp + 8
+      Abi.Offset := 8;
+   end Start_Subprogram;
+
+   procedure New_Interface (Inter : O_Dnode; Abi : in out O_Abi_Subprg)
+   is
+      Itype : O_Tnode;
+      Size : Uns32;
+   begin
+      Itype := Get_Decl_Type (Inter);
+      Size := Get_Type_Size (Itype);
+      Size := (Size + 3) and not 3;
+      Set_Local_Offset (Inter, Abi.Offset);
+      Abi.Offset := Abi.Offset + Int32 (Size);
+   end New_Interface;
+
+   procedure Finish_Subprogram (Subprg : O_Dnode; Abi : in out O_Abi_Subprg)
+   is
+      use Binary_File;
+      function To_Int32 is new Ada.Unchecked_Conversion
+        (Source => Symbol, Target => Int32);
+   begin
+      Set_Decl_Info (Subprg,
+                     To_Int32 (Create_Symbol (Get_Decl_Ident (Subprg))));
+      --  Offset is 8 biased.
+      Set_Subprg_Stack (Subprg, Abi.Offset - 8);
+   end Finish_Subprogram;
+
+   procedure Link_Stmt (Stmt : O_Enode) is
+   begin
+      Set_Stmt_Link (Last_Link, Stmt);
+      Last_Link := Stmt;
+   end Link_Stmt;
+
+   procedure Disp_Subprg (Subprg : O_Dnode);
+
+
+   Exprs_Mark : Exprs.Mark_Type;
+   Decls_Mark : Decls.Mark_Type;
+   Consts_Mark : Consts.Mark_Type;
+   Types_Mark : Types.Mark_Type;
+   Dwarf_Mark : Dwarf.Mark_Type;
+
+   procedure Start_Body (Subprg : O_Dnode)
+   is
+      pragma Unreferenced (Subprg);
+   begin
+      if not Debug.Flag_Debug_Keep then
+         Mark (Exprs_Mark);
+         Mark (Decls_Mark);
+         Consts.Mark (Consts_Mark);
+         Mark (Types_Mark);
+      end if;
+   end Start_Body;
+
+   procedure Finish_Body (Subprg : Subprogram_Data_Acc)
+   is
+      use Ortho_Code.Flags;
+
+      Child : Subprogram_Data_Acc;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Disps.Disp_Subprg (Subprg);
+         return;
+      end if;
+
+      Insns.Gen_Subprg_Insns (Subprg);
+
+      if Ortho_Code.Debug.Flag_Debug_Body2 then
+         Disp_Subprg_Body (1, Subprg.E_Entry);
+      end if;
+
+      if Ortho_Code.Debug.Flag_Debug_Code then
+         Disp_Subprg (Subprg.D_Body);
+      end if;
+
+      Emits.Emit_Subprg (Subprg);
+
+      if Get_Decl_Depth (Subprg.D_Decl) = O_Toplevel
+        and then Flag_Debug = Debug_Dwarf
+      then
+         Dwarf.Emit_Decls_Until (Subprg.D_Body);
+         if not Debug.Flag_Debug_Keep then
+            Dwarf.Mark (Dwarf_Mark);
+         end if;
+      end if;
+
+      --  Recurse on nested subprograms.
+      Child := Subprg.First_Child;
+      while Child /= null loop
+         Finish_Body (Child);
+         Child := Child.Brother;
+      end loop;
+
+      if Get_Decl_Depth (Subprg.D_Decl) = O_Toplevel then
+         if Flag_Debug = Debug_Dwarf then
+            Dwarf.Emit_Subprg (Subprg.D_Body);
+         end if;
+
+         if not Debug.Flag_Debug_Keep then
+            Release (Exprs_Mark);
+            Release (Decls_Mark);
+            Consts.Release (Consts_Mark);
+            Release (Types_Mark);
+            Dwarf.Release (Dwarf_Mark);
+         end if;
+      end if;
+   end Finish_Body;
+
+   procedure Expand_Const_Decl (Decl : O_Dnode) is
+   begin
+      Emits.Emit_Const_Decl (Decl);
+   end Expand_Const_Decl;
+
+   procedure Expand_Var_Decl (Decl : O_Dnode) is
+   begin
+      Emits.Emit_Var_Decl (Decl);
+   end Expand_Var_Decl;
+
+   procedure Expand_Const_Value (Decl : O_Dnode; Val : O_Cnode) is
+   begin
+      Emits.Emit_Const_Value (Decl, Val);
+   end Expand_Const_Value;
+
+   procedure Disp_Label (Label : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+   begin
+      Put ("L");
+      Put (Int32 (Label), 0);
+   end Disp_Label;
+
+   procedure Disp_Reg (Reg : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+   begin
+      Put ("reg_");
+      Put (Int32 (Reg), 0);
+      Put ("{");
+      Put (Image_Reg (Get_Expr_Reg (Reg)));
+      Put ("}");
+   end Disp_Reg;
+
+   procedure Disp_Local (Stmt : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+      Obj : constant O_Dnode := Get_Addr_Object (Stmt);
+      Frame : constant O_Enode := Get_Addrl_Frame (Stmt);
+   begin
+      if Frame = O_Enode_Null then
+         Put ("fp");
+      else
+         Disp_Reg (Frame);
+      end if;
+      Put (",");
+      Put (Get_Local_Offset (Obj), 0);
+      Put (" {");
+      Disp_Decl_Name (Obj);
+      Put ("}");
+   end Disp_Local;
+
+   procedure Disp_Uns32 (Val : Uns32)
+   is
+      use Ada.Text_IO;
+      U2c : constant array (Uns32 range 0 .. 15) of Character
+        := "0123456789abcdef";
+      V : Uns32 := Val;
+   begin
+      for I in 0 .. 7 loop
+         Put (U2c (Shift_Right (V, 28)));
+         V := Shift_Left (V, 4);
+      end loop;
+   end Disp_Uns32;
+
+   procedure Disp_Const (Stmt : O_Enode)
+   is
+      use Ada.Text_IO;
+   begin
+      Put ("[");
+      case Get_Expr_Mode (Stmt) is
+         when Mode_U64
+           | Mode_I64
+           | Mode_F64 =>
+            Disp_Uns32 (Get_Expr_High (Stmt));
+            Put (",");
+         when others =>
+            null;
+      end case;
+      Disp_Uns32 (Get_Expr_Low (Stmt));
+      Put ("]");
+   end Disp_Const;
+
+   procedure Disp_Irm_Code (Stmt : O_Enode)
+   is
+      use Ortho_Code.Debug.Int32_IO;
+      use Ada.Text_IO;
+      Reg : O_Reg;
+      Kind : OE_Kind;
+   begin
+      Reg := Get_Expr_Reg (Stmt);
+      Kind := Get_Expr_Kind (Stmt);
+      case Reg is
+         when R_Mem =>
+            case Kind is
+               when OE_Indir =>
+                  Put ('(');
+                  Disp_Irm_Code (Get_Expr_Operand (Stmt));
+                  Put (')');
+--                 when OE_Lit =>
+--                    Put ("(&n)");
+               when others =>
+                  raise Program_Error;
+            end case;
+         when R_Imm =>
+            case Kind is
+               when OE_Const =>
+                  Disp_Const (Stmt);
+               when OE_Addrg =>
+                  Put ("&");
+                  Disp_Decl_Name (Get_Addr_Object (Stmt));
+               when OE_Add =>
+                  Disp_Irm_Code (Get_Expr_Left (Stmt));
+                  Put ("+");
+                  Disp_Irm_Code (Get_Expr_Right (Stmt));
+               when others =>
+                  raise Program_Error;
+            end case;
+         when Regs_R32
+           | R_Any32
+           | R_Any8
+           | Regs_R64
+           | R_Any64
+           | Regs_Cc
+           | Regs_Fp
+           | Regs_Xmm =>
+            Disp_Reg (Stmt);
+         when R_Spill =>
+            Disp_Reg (Stmt);
+            --Disp_Irm_Code (Get_Stmt_Link (Stmt));
+         when R_B_Off
+           | R_I_Off
+           | R_B_I
+           | R_Sib =>
+            case Kind is
+               when OE_Addrl =>
+                  Disp_Local (Stmt);
+               when OE_Add =>
+                  Disp_Irm_Code (Get_Expr_Left (Stmt));
+                  Put (" + ");
+                  Disp_Irm_Code (Get_Expr_Right (Stmt));
+               when others =>
+                  raise Program_Error;
+            end case;
+         when R_I =>
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (" * ");
+            case Get_Expr_Low (Get_Expr_Right (Stmt)) is
+               when 0 =>
+                  Put ('1');
+               when 1 =>
+                  Put ('2');
+               when 2 =>
+                  Put ('4');
+               when 3 =>
+                  Put ('8');
+               when others =>
+                  Put ('?');
+            end case;
+         when others =>
+            Ada.Text_IO.Put_Line
+              ("abi.disp_irm_code: unhandled reg=" & Image_Reg (Reg)
+               & ", stmt=" & O_Enode'Image (Stmt));
+            raise Program_Error;
+      end case;
+   end Disp_Irm_Code;
+
+   procedure Disp_Decls (Block : O_Dnode)
+   is
+      Decl : O_Dnode;
+      Last : O_Dnode;
+   begin
+      Last := Get_Block_Last (Block);
+      Disp_Decl (2, Block);
+      Decl := Block + 1;
+      while Decl <= Last loop
+         case Get_Decl_Kind (Decl) is
+            when OD_Local =>
+               Disp_Decl (2, Decl);
+            when OD_Block =>
+               --  Skip internal blocks.
+               Decl := Get_Block_Last (Decl);
+            when others =>
+               Disp_Decl (2, Decl);
+               null;
+         end case;
+         Decl := Decl + 1;
+      end loop;
+   end Disp_Decls;
+
+   procedure Disp_Stmt (Stmt : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Debug.Int32_IO;
+      Kind : OE_Kind;
+      Mode : Mode_Type;
+
+      procedure Disp_Op_Name (Name : String) is
+      begin
+         Put (Name);
+         Put (":");
+         Debug.Disp_Mode (Mode);
+         Put (" ");
+      end Disp_Op_Name;
+
+      procedure Disp_Reg_Op_Name (Name : String) is
+      begin
+         Put ("  ");
+         Disp_Reg (Stmt);
+         Put (" = ");
+         Disp_Op_Name (Name);
+      end Disp_Reg_Op_Name;
+
+   begin
+      Kind := Get_Expr_Kind (Stmt);
+      Mode := Get_Expr_Mode (Stmt);
+
+      case Kind is
+         when OE_Beg =>
+            Put ("  # block start");
+            if Get_Block_Has_Alloca (Stmt) then
+               Put (" [alloca]");
+            end if;
+            New_Line;
+            Disp_Decls (Get_Block_Decls (Stmt));
+         when OE_End =>
+            Put_Line ("  # block end");
+         when OE_Indir =>
+            Disp_Reg_Op_Name ("indir");
+            Put ("(");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            Put_Line (")");
+         when OE_Alloca =>
+            Disp_Reg_Op_Name ("alloca");
+            Put ("(");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            Put_Line (")");
+         when OE_Kind_Cmp
+           | OE_Kind_Dyadic =>
+            Disp_Reg_Op_Name ("op");
+            Put ("{");
+            Put (OE_Kind'Image (Kind));
+            Put ("} ");
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (", ");
+            Disp_Irm_Code (Get_Expr_Right (Stmt));
+            New_Line;
+         when OE_Abs_Ov
+           | OE_Neg_Ov
+           | OE_Not =>
+            Disp_Reg_Op_Name ("op");
+            Put ("{");
+            Put (OE_Kind'Image (Kind));
+            Put ("} ");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Const =>
+            Disp_Reg_Op_Name ("const");
+            Disp_Const (Stmt);
+            New_Line;
+         when OE_Jump_F =>
+            Put ("  jump_f ");
+            Disp_Reg (Get_Expr_Operand (Stmt));
+            Put (" ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            New_Line;
+         when OE_Jump_T =>
+            Put ("  jump_t ");
+            Disp_Reg (Get_Expr_Operand (Stmt));
+            Put (" ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            New_Line;
+         when OE_Jump =>
+            Put ("  jump ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            New_Line;
+         when OE_Label =>
+            Disp_Label (Stmt);
+            Put_Line (":");
+         when OE_Asgn =>
+            Put ("  assign:");
+            Debug.Disp_Mode (Mode);
+            Put (" (");
+            Disp_Irm_Code (Get_Assign_Target (Stmt));
+            Put (") <- ");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Set_Stack =>
+            Put ("  set_stack");
+            Put (" <- ");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Spill =>
+            Disp_Reg_Op_Name ("spill");
+            Disp_Reg (Get_Expr_Operand (Stmt));
+            Put (", offset=");
+            Put (Int32'Image (Get_Spill_Info (Stmt)));
+            New_Line;
+         when OE_Reload =>
+            Disp_Reg_Op_Name ("reload");
+            Disp_Reg (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Arg =>
+            Put ("  push ");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Call =>
+            if Get_Expr_Mode (Stmt) /= Mode_Nil then
+               Disp_Reg_Op_Name ("call");
+            else
+               Put ("  ");
+               Disp_Op_Name ("call");
+               Put (" ");
+            end if;
+            Disp_Decl_Name (Get_Call_Subprg (Stmt));
+            New_Line;
+         when OE_Stack_Adjust =>
+            Put ("  stack_adjust: ");
+            Put (Int32'Image (Get_Stack_Adjust (Stmt)));
+            New_Line;
+         when OE_Intrinsic =>
+            Disp_Reg_Op_Name ("intrinsic");
+            --Disp_Decl_Name (Get_Call_Subprg (Stmt));
+            New_Line;
+         when OE_Conv =>
+            Disp_Reg_Op_Name ("conv");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Move =>
+            Disp_Reg_Op_Name ("move");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Ret =>
+            Put ("  ret");
+            if Get_Expr_Mode (Stmt) /= Mode_Nil then
+               Put (" ");
+               Disp_Reg (Get_Expr_Operand (Stmt));
+            end if;
+            New_Line;
+         when OE_Case =>
+            Disp_Reg_Op_Name ("case");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Case_Expr =>
+            Disp_Reg_Op_Name ("case_expr");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Leave =>
+            Put_Line ("leave");
+         when OE_Entry =>
+            Put_Line ("entry");
+         when OE_Line =>
+            Put ("  # line #");
+            Put (Get_Expr_Line_Number (Stmt), 0);
+            New_Line;
+         when OE_Addrl =>
+            Disp_Reg_Op_Name ("lea{addrl}");
+            Put ("(");
+            Disp_Local (Stmt);
+            Put (")");
+            New_Line;
+         when OE_Addrg =>
+            Disp_Reg_Op_Name ("lea{addrg}");
+            Put ("&");
+            Disp_Decl_Name (Get_Addr_Object (Stmt));
+            New_Line;
+         when OE_Add =>
+            Disp_Reg_Op_Name ("lea{add}");
+            Put ("(");
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (" + ");
+            Disp_Irm_Code (Get_Expr_Right (Stmt));
+            Put (")");
+            New_Line;
+         when OE_Mul =>
+            Disp_Reg_Op_Name ("mul");
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (", ");
+            Disp_Irm_Code (Get_Expr_Right (Stmt));
+            New_Line;
+         when OE_Shl =>
+            Disp_Reg_Op_Name ("shl");
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (", ");
+            Disp_Irm_Code (Get_Expr_Right (Stmt));
+            New_Line;
+         when OE_Reg =>
+            Disp_Reg_Op_Name ("reg");
+            New_Line;
+         when others =>
+            Ada.Text_IO.Put_Line
+              ("abi.disp_stmt: unhandled enode " & OE_Kind'Image (Kind));
+            raise Program_Error;
+      end case;
+   end Disp_Stmt;
+
+   procedure Disp_Subprg_Decl (Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+      Arg : O_Dnode;
+   begin
+      Put ("subprogram ");
+      Disp_Decl_Name (Decl);
+      Put_Line (":");
+      Arg := Decl + 1;
+      while Get_Decl_Kind (Arg) = OD_Interface loop
+         Disp_Decl (2, Arg);
+         Arg := Arg + 1;
+      end loop;
+   end Disp_Subprg_Decl;
+
+   procedure Disp_Subprg (Subprg : O_Dnode)
+   is
+      use Ada.Text_IO;
+
+      Stmt : O_Enode;
+   begin
+      Disp_Subprg_Decl (Get_Body_Decl (Subprg));
+
+      Stmt := Get_Body_Stmt (Subprg);
+      loop
+         exit when Stmt = O_Enode_Null;
+         Disp_Stmt (Stmt);
+         exit when Get_Expr_Kind (Stmt) = OE_Leave;
+         Stmt := Get_Stmt_Link (Stmt);
+      end loop;
+   end Disp_Subprg;
+
+   procedure New_Debug_Filename_Decl (Filename : String)
+   is
+      use Ortho_Code.Flags;
+   begin
+      if Flag_Debug = Debug_Dwarf then
+         Dwarf.Set_Filename ("", Filename);
+      end if;
+   end New_Debug_Filename_Decl;
+
+   procedure Init
+   is
+      use Ortho_Code.Debug;
+   begin
+      --  Alignment of doubles is platform dependent.
+      Mode_Align (Mode_F64) := X86.Flags.Mode_F64_Align;
+
+      if Flag_Debug_Hli then
+         Disps.Init;
+      else
+         Emits.Init;
+      end if;
+   end Init;
+
+   procedure Finish
+   is
+      use Ortho_Code.Debug;
+   begin
+      if Flag_Debug_Hli then
+         Disps.Finish;
+      else
+         Emits.Finish;
+      end if;
+   end Finish;
+
+--    function Image_Insn (Insn : O_Insn) return String is
+--    begin
+--       case Insn is
+--          when Insn_Nil =>
+--             return "nil";
+--          when Insn_Imm =>
+--             return "imm";
+--          when Insn_Base_Off =>
+--             return "B+O";
+--          when Insn_Loadm =>
+--             return "ldm";
+--          when Insn_Loadi =>
+--             return "ldi";
+--          when Insn_Mem =>
+--             return "mem";
+--          when Insn_Cmp =>
+--             return "cmp";
+--          when Insn_Op =>
+--             return "op ";
+--          when Insn_Rop =>
+--             return "rop";
+--          when Insn_Call =>
+--             return "cal";
+--          when others =>
+--             return "???";
+--       end case;
+--    end Image_Insn;
+
+   function Image_Reg (Reg : O_Reg) return String is
+   begin
+      case Reg is
+         when R_Nil =>
+            return "nil ";
+         when R_None =>
+            return " -- ";
+         when R_Spill =>
+            return "spil";
+         when R_Mem =>
+            return "mem ";
+         when R_Imm =>
+            return "imm ";
+         when R_Irm =>
+            return "irm ";
+         when R_Rm =>
+            return "rm  ";
+         when R_Sib =>
+            return "sib ";
+         when R_B_Off =>
+            return "b+o ";
+         when R_B_I =>
+            return "b+i ";
+         when R_I =>
+            return "s*i ";
+         when R_Ir =>
+            return " ir ";
+         when R_I_Off =>
+            return "i+o ";
+         when R_Any32 =>
+            return "r32 ";
+         when R_Any_Cc =>
+            return "cc  ";
+         when R_Any8 =>
+            return "r8  ";
+         when R_Any64 =>
+            return "r64 ";
+
+         when R_St0 =>
+            return "st0 ";
+         when R_Ax =>
+            return "ax  ";
+         when R_Dx =>
+            return "dx  ";
+         when R_Cx =>
+            return "cx  ";
+         when R_Bx =>
+            return "bx  ";
+         when R_Si =>
+            return "si  ";
+         when R_Di =>
+            return "di  ";
+         when R_Sp =>
+            return "sp  ";
+         when R_Bp =>
+            return "bp  ";
+         when R_Edx_Eax =>
+            return "dxax";
+         when R_Ebx_Ecx =>
+            return "bxcx";
+         when R_Esi_Edi =>
+            return "sidi";
+         when R_Eq =>
+            return "eq? ";
+         when R_Ne =>
+            return "ne? ";
+         when R_Uge =>
+            return "uge?";
+         when R_Sge =>
+            return "sge?";
+         when R_Ugt =>
+            return "ugt?";
+         when R_Sgt =>
+            return "sgt?";
+         when R_Ule =>
+            return "ule?";
+         when R_Sle =>
+            return "sle?";
+         when R_Ult =>
+            return "ult?";
+         when R_Slt =>
+            return "slt?";
+         when R_Xmm0 =>
+            return "xmm0";
+         when R_Xmm1 =>
+            return "xmm1";
+         when R_Xmm2 =>
+            return "xmm2";
+         when R_Xmm3 =>
+            return "xmm3";
+         when others =>
+            return "????";
+      end case;
+   end Image_Reg;
+
+   --  From GCC.
+   --  FIXME: these don't handle overflow!
+   function Divdi3 (A, B : Long_Integer) return Long_Integer;
+   pragma Import (C, Divdi3, "__divdi3");
+
+   function Muldi3 (A, B : Long_Integer) return Long_Integer;
+   pragma Import (C, Muldi3, "__muldi3");
+
+   procedure Chkstk (Sz : Integer);
+   pragma Import (C, Chkstk, "__chkstk");
+
+   procedure Link_Intrinsics
+   is
+   begin
+      Binary_File.Memory.Set_Symbol_Address
+        (Ortho_Code.X86.Emits.Intrinsics_Symbol
+         (Ortho_Code.X86.Intrinsic_Mul_Ov_I64),
+         Muldi3'Address);
+      Binary_File.Memory.Set_Symbol_Address
+        (Ortho_Code.X86.Emits.Intrinsics_Symbol
+         (Ortho_Code.X86.Intrinsic_Div_Ov_I64),
+         Divdi3'Address);
+      if X86.Flags.Flag_Alloca_Call then
+         Binary_File.Memory.Set_Symbol_Address
+           (Ortho_Code.X86.Emits.Chkstk_Symbol, Chkstk'Address);
+      end if;
+   end Link_Intrinsics;
+end Ortho_Code.X86.Abi;
diff --git a/src/ortho/mcode/ortho_code-x86-abi.ads b/src/ortho/mcode/ortho_code-x86-abi.ads
new file mode 100644
index 000000000..7b166dad8
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-abi.ads
@@ -0,0 +1,76 @@
+--  X86 ABI definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Types; use Ortho_Code.Types;
+
+package Ortho_Code.X86.Abi is
+   type O_Abi_Subprg is private;
+
+   procedure Init;
+   procedure Finish;
+
+   Mode_Align : Mode_Align_Array :=
+     (Mode_U8 | Mode_I8 => 0,
+      Mode_U16 | Mode_I16 => 1,
+      Mode_U32 | Mode_I32 | Mode_F32 | Mode_P32 => 2,
+      Mode_U64 | Mode_I64 => 2,
+      Mode_F64 => 2, -- 2 for SVR4-ABI and Darwin, 3 for Windows.
+      Mode_Blk | Mode_X1 | Mode_Nil | Mode_P64 => 0,
+      Mode_B2 => 0);
+
+   Mode_Ptr : constant Mode_Type := Mode_P32;
+
+   Flag_Type_Completer : constant Boolean := False;
+   Flag_Lower_Stmt : constant Boolean := True;
+
+   Flag_Sse2 : Boolean := False;
+
+   --  Procedures to layout a subprogram declaration.
+   procedure Start_Subprogram (Subprg : O_Dnode; Abi : out O_Abi_Subprg);
+   procedure New_Interface (Inter : O_Dnode; Abi : in out O_Abi_Subprg);
+   procedure Finish_Subprogram (Subprg : O_Dnode; Abi : in out O_Abi_Subprg);
+
+   --  Only called for top-level subprograms.
+   procedure Start_Body (Subprg : O_Dnode);
+   --  Finish compilation of a body.
+   procedure Finish_Body (Subprg : Subprogram_Data_Acc);
+
+   procedure Expand_Const_Decl (Decl : O_Dnode);
+   procedure Expand_Var_Decl (Decl : O_Dnode);
+   procedure Expand_Const_Value (Decl : O_Dnode; Val : O_Cnode);
+
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   Last_Link : O_Enode;
+   procedure Link_Stmt (Stmt : O_Enode);
+
+   --  Disp SUBPRG (subprg declaration) as a declaration (name and interfaces).
+   procedure Disp_Subprg_Decl (Decl : O_Dnode);
+
+   procedure Disp_Stmt (Stmt : O_Enode);
+
+   --function Image_Insn (Insn : O_Insn) return String;
+   function Image_Reg (Reg : O_Reg) return String;
+
+   --  Link in memory intrinsics symbols.
+   procedure Link_Intrinsics;
+private
+   type O_Abi_Subprg is record
+      --  For x86: offset of the next argument.
+      Offset : Int32 := 0;
+   end record;
+end Ortho_Code.X86.Abi;
diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb
new file mode 100644
index 000000000..ad1ef559b
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-emits.adb
@@ -0,0 +1,2322 @@
+--  Mcode back-end for ortho - Binary X86 instructions generator.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Abi;
+with Ortho_Code.Decls;
+with Ortho_Code.Types;
+with Ortho_Code.Consts;
+with Ortho_Code.Debug;
+with Ortho_Code.X86.Insns;
+with Ortho_Code.X86.Flags;
+with Ortho_Code.Flags;
+with Ortho_Code.Dwarf;
+with Ortho_Code.Binary; use Ortho_Code.Binary;
+with Ortho_Ident;
+with Ada.Text_IO;
+with Interfaces; use Interfaces;
+
+package body Ortho_Code.X86.Emits is
+   type Insn_Size is (Sz_8, Sz_16, Sz_32l, Sz_32h);
+
+   type Fp_Size is (Fp_32, Fp_64);
+
+   Sect_Text : Binary_File.Section_Acc;
+   Sect_Rodata : Binary_File.Section_Acc;
+   Sect_Bss : Binary_File.Section_Acc;
+
+   Reg_Helper : O_Reg;
+
+   Subprg_Pc : Pc_Type;
+
+   procedure Error_Emit (Msg : String; Insn : O_Enode)
+   is
+      use Ada.Text_IO;
+   begin
+      Put ("error_emit: ");
+      Put (Msg);
+      Put (", insn=");
+      Put (O_Enode'Image (Insn));
+      Put (" (");
+      Put (OE_Kind'Image (Get_Expr_Kind (Insn)));
+      Put (")");
+      New_Line;
+      raise Program_Error;
+   end Error_Emit;
+
+
+   procedure Gen_Insn_Sz (B : Byte; Sz : Insn_Size) is
+   begin
+      case Sz is
+         when Sz_8 =>
+            Gen_B8 (B);
+         when Sz_16 =>
+            Gen_B8 (16#66#);
+            Gen_B8 (B + 1);
+         when Sz_32l
+           | Sz_32h =>
+            Gen_B8 (B + 1);
+      end case;
+   end Gen_Insn_Sz;
+
+   procedure Gen_Insn_Sz_S8 (B : Byte; Sz : Insn_Size) is
+   begin
+      case Sz is
+         when Sz_8 =>
+            Gen_B8 (B);
+         when Sz_16 =>
+            Gen_B8 (16#66#);
+            Gen_B8 (B + 3);
+         when Sz_32l
+           | Sz_32h =>
+            Gen_B8 (B + 3);
+      end case;
+   end Gen_Insn_Sz_S8;
+
+   function Get_Const_Val (C : O_Enode; Sz : Insn_Size) return Uns32 is
+   begin
+      case Sz is
+         when Sz_8
+           | Sz_16
+           | Sz_32l =>
+            return Get_Expr_Low (C);
+         when Sz_32h =>
+            return Get_Expr_High (C);
+      end case;
+   end Get_Const_Val;
+
+   function Is_Imm8 (N : O_Enode; Sz : Insn_Size) return Boolean is
+   begin
+      if Get_Expr_Kind (N) /= OE_Const then
+         return False;
+      end if;
+      return Get_Const_Val (N, Sz) <= 127;
+   end Is_Imm8;
+
+   procedure Gen_Imm8 (N : O_Enode; Sz : Insn_Size) is
+   begin
+      Gen_B8 (Byte (Get_Const_Val (N, Sz)));
+   end Gen_Imm8;
+
+--     procedure Gen_Imm32 (N : O_Enode; Sz : Insn_Size)
+--     is
+--        use Interfaces;
+--     begin
+--        case Get_Expr_Kind (N) is
+--           when OE_Const =>
+--              Gen_Le32 (Unsigned_32 (Get_Const_Val (N, Sz)));
+--           when OE_Addrg =>
+--              Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (N)), 0);
+--           when others =>
+--              raise Program_Error;
+--        end case;
+--     end Gen_Imm32;
+
+   procedure Gen_Imm (N : O_Enode; Sz : Insn_Size) is
+   begin
+      case Get_Expr_Kind (N) is
+         when OE_Const =>
+            case Sz is
+               when Sz_8 =>
+                  Gen_B8 (Byte (Get_Expr_Low (N) and 16#FF#));
+               when Sz_16 =>
+                  Gen_Le16 (Unsigned_32 (Get_Expr_Low (N) and 16#FF_FF#));
+               when Sz_32l =>
+                  Gen_Le32 (Unsigned_32 (Get_Expr_Low (N)));
+               when Sz_32h =>
+                  Gen_Le32 (Unsigned_32 (Get_Expr_High (N)));
+            end case;
+         when OE_Addrg =>
+            if Sz /= Sz_32l then
+               raise Program_Error;
+            end if;
+            Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (N)), 0);
+         when OE_Add =>
+            declare
+               P : O_Enode;
+               L, R : O_Enode;
+               S, C : O_Enode;
+               Off : Int32;
+            begin
+               Off := 0;
+               P := N;
+               if Sz /= Sz_32l then
+                  raise Program_Error;
+               end if;
+               loop
+                  L := Get_Expr_Left (P);
+                  R := Get_Expr_Right (P);
+
+                  --  Extract the const node.
+                  if Get_Expr_Kind (R) = OE_Const then
+                     S := L;
+                     C := R;
+                  elsif Get_Expr_Kind (L) = OE_Const then
+                     S := R;
+                     C := L;
+                  else
+                     raise Program_Error;
+                  end if;
+                  if Get_Expr_Mode (C) /= Mode_U32 then
+                     raise Program_Error;
+                  end if;
+                  Off := Off + To_Int32 (Get_Expr_Low (C));
+
+                  exit when Get_Expr_Kind (S) = OE_Addrg;
+                  P := S;
+                  if Get_Expr_Kind (P) /= OE_Add then
+                     raise Program_Error;
+                  end if;
+               end loop;
+               Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (S)),
+                           Integer_32 (Off));
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Imm;
+
+   Rm_Base : O_Reg;
+   Rm_Index : O_Reg;
+   Rm_Offset : Int32;
+   Rm_Sym : Symbol;
+   Rm_Scale : Byte;
+
+   procedure Fill_Sib (N : O_Enode)
+   is
+      use Ortho_Code.Decls;
+      Reg : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (N);
+      if Reg in Regs_R32 then
+         if Rm_Base = R_Nil then
+            Rm_Base := Reg;
+         elsif Rm_Index = R_Nil then
+            Rm_Index := Reg;
+         else
+            raise Program_Error;
+         end if;
+         return;
+      end if;
+      case Get_Expr_Kind (N) is
+         when OE_Indir =>
+            Fill_Sib (Get_Expr_Operand (N));
+         when OE_Addrl =>
+            declare
+               Frame : O_Enode;
+            begin
+               Frame := Get_Addrl_Frame (N);
+               if Frame = O_Enode_Null then
+                  Rm_Base := R_Bp;
+               else
+                  Rm_Base := Get_Expr_Reg (Frame);
+               end if;
+            end;
+            Rm_Offset := Rm_Offset + Get_Local_Offset (Get_Addr_Object (N));
+         when OE_Addrg =>
+            if Rm_Sym /= Null_Symbol then
+               raise Program_Error;
+            end if;
+            Rm_Sym := Get_Decl_Symbol (Get_Addr_Object (N));
+         when OE_Add =>
+            Fill_Sib (Get_Expr_Left (N));
+            Fill_Sib (Get_Expr_Right (N));
+         when OE_Const =>
+            Rm_Offset := Rm_Offset + To_Int32 (Get_Expr_Low (N));
+         when OE_Shl =>
+            if Rm_Index /= R_Nil then
+               raise Program_Error;
+            end if;
+            Rm_Index := Get_Expr_Reg (Get_Expr_Left (N));
+            Rm_Scale := Byte (Get_Expr_Low (Get_Expr_Right (N)));
+         when others =>
+            Error_Emit ("fill_sib", N);
+      end case;
+   end Fill_Sib;
+
+   function To_Reg32 (R : O_Reg) return Byte is
+   begin
+      return O_Reg'Pos (R) - O_Reg'Pos (R_Ax);
+   end To_Reg32;
+   pragma Inline (To_Reg32);
+
+   function To_Reg_Xmm (R : O_Reg) return Byte is
+   begin
+      return O_Reg'Pos (R) - O_Reg'Pos (R_Xmm0);
+   end To_Reg_Xmm;
+   pragma Inline (To_Reg_Xmm);
+
+   function To_Reg32 (R : O_Reg; Sz : Insn_Size) return Byte is
+   begin
+      case Sz is
+         when Sz_8 =>
+            if R in Regs_R8 then
+               return O_Reg'Pos (R) - O_Reg'Pos (R_Ax);
+            else
+               raise Program_Error;
+            end if;
+         when Sz_16 =>
+            if R in Regs_R32 then
+               return O_Reg'Pos (R) - O_Reg'Pos (R_Ax);
+            else
+               raise Program_Error;
+            end if;
+         when Sz_32l =>
+            case R is
+               when Regs_R32 =>
+                  return O_Reg'Pos (R) - O_Reg'Pos (R_Ax);
+               when R_Edx_Eax =>
+                  return 2#000#;
+               when R_Ebx_Ecx =>
+                  return 2#001#;
+               when R_Esi_Edi =>
+                  return 2#111#;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when Sz_32h =>
+            case R is
+               when R_Edx_Eax =>
+                  return 2#010#;
+               when R_Ebx_Ecx =>
+                  return 2#011#;
+               when R_Esi_Edi =>
+                  return 2#110#;
+               when others =>
+                  raise Program_Error;
+            end case;
+      end case;
+   end To_Reg32;
+
+   function To_Cond (R : O_Reg) return Byte is
+   begin
+      return O_Reg'Pos (R) - O_Reg'Pos (R_Ov);
+   end To_Cond;
+   pragma Inline (To_Cond);
+
+   procedure Gen_Sib is
+   begin
+      if Rm_Base = R_Nil then
+         Gen_B8 (Rm_Scale * 2#1_000_000#
+                 + To_Reg32 (Rm_Index) * 2#1_000#
+                 + 2#101#);
+      else
+         Gen_B8 (Rm_Scale * 2#1_000_000#
+                 + To_Reg32 (Rm_Index) * 2#1_000#
+                 + To_Reg32 (Rm_Base));
+      end if;
+   end Gen_Sib;
+
+   --  Generate an R/M (+ SIB) byte.
+   --  R is added to the R/M byte.
+   procedure Gen_Rm_Mem (R : Byte; N : O_Enode; Sz : Insn_Size)
+   is
+      Reg : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (N);
+      Rm_Base := R_Nil;
+      Rm_Index := R_Nil;
+      if Sz = Sz_32h then
+         Rm_Offset := 4;
+      else
+         Rm_Offset := 0;
+      end if;
+      Rm_Scale := 0;
+      Rm_Sym := Null_Symbol;
+      case Reg is
+         when R_Mem
+           | R_Imm
+           | R_Eq
+           | R_B_Off
+           | R_B_I
+           | R_I_Off
+           | R_Sib =>
+            Fill_Sib (N);
+         when Regs_R32 =>
+            Rm_Base := Reg;
+         when R_Spill =>
+            Rm_Base := R_Bp;
+            Rm_Offset := Rm_Offset + Get_Spill_Info (N);
+         when others =>
+            Error_Emit ("gen_rm_mem: unhandled reg", N);
+      end case;
+      if Rm_Index /= R_Nil then
+         --  SIB.
+         if Rm_Base = R_Nil then
+            Gen_B8 (2#00_000_100# + R);
+            Rm_Base := R_Bp;
+            Gen_Sib;
+            Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset));
+         elsif Rm_Sym = Null_Symbol and Rm_Offset = 0 and Rm_Base /= R_Bp then
+            Gen_B8 (2#00_000_100# + R);
+            Gen_Sib;
+         elsif Rm_Sym = Null_Symbol and Rm_Offset <= 127 and Rm_Offset >= -128
+         then
+            Gen_B8 (2#01_000_100# + R);
+            Gen_Sib;
+            Gen_B8 (Byte (To_Uns32 (Rm_Offset) and 16#Ff#));
+         else
+            Gen_B8 (2#10_000_100# + R);
+            Gen_Sib;
+            Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset));
+         end if;
+         return;
+      end if;
+      case Rm_Base is
+         when R_Sp =>
+            raise Program_Error;
+         when R_Nil =>
+            Gen_B8 (2#00_000_101# + R);
+            Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset));
+         when R_Ax
+            | R_Bx
+            | R_Cx
+            | R_Dx
+            | R_Bp
+            | R_Si
+            | R_Di =>
+            if Rm_Offset = 0 and Rm_Sym = Null_Symbol and Rm_Base /= R_Bp then
+               Gen_B8 (2#00_000_000# + R + To_Reg32 (Rm_Base));
+            elsif Rm_Sym = Null_Symbol
+               and Rm_Offset <= 127 and Rm_Offset >= -128
+            then
+               Gen_B8 (2#01_000_000# + R + To_Reg32 (Rm_Base));
+               Gen_B8 (Byte (To_Uns32 (Rm_Offset) and 16#Ff#));
+            else
+               Gen_B8 (2#10_000_000# + R + To_Reg32 (Rm_Base));
+               Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset));
+            end if;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Rm_Mem;
+
+   procedure Gen_Rm (R : Byte; N : O_Enode; Sz : Insn_Size)
+   is
+      Reg : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (N);
+      if Reg in Regs_R32 or Reg in Regs_R64 then
+         Gen_B8 (2#11_000_000# + R + To_Reg32 (Reg, Sz));
+         return;
+      else
+         Gen_Rm_Mem (R, N, Sz);
+      end if;
+   end Gen_Rm;
+
+   procedure Emit_Op (Op : Byte; Stmt : O_Enode; Sz : Insn_Size)
+   is
+      L, R : O_Enode;
+      Lr, Rr : O_Reg;
+   begin
+      L := Get_Expr_Left (Stmt);
+      R := Get_Expr_Right (Stmt);
+      Lr := Get_Expr_Reg (L);
+      Rr := Get_Expr_Reg (R);
+      Start_Insn;
+      case Rr is
+         when R_Imm =>
+            if Is_Imm8 (R, Sz) then
+               Gen_Insn_Sz_S8 (16#80#, Sz);
+               Gen_Rm (Op, L, Sz);
+               Gen_Imm8 (R, Sz);
+            elsif Lr = R_Ax then
+               Gen_Insn_Sz (2#000_000_100# + Op, Sz);
+               Gen_Imm (R, Sz);
+            else
+               Gen_Insn_Sz (16#80#, Sz);
+               Gen_Rm (Op, L, Sz);
+               Gen_Imm (R, Sz);
+            end if;
+         when R_Mem
+           | R_Spill
+           | Regs_R32
+           | Regs_R64 =>
+            Gen_Insn_Sz (2#00_000_010# + Op, Sz);
+            Gen_Rm (To_Reg32 (Lr, Sz) * 8, R, Sz);
+         when others =>
+            Error_Emit ("emit_op", Stmt);
+      end case;
+      End_Insn;
+   end Emit_Op;
+
+   procedure Gen_Into is
+   begin
+      Start_Insn;
+      Gen_B8 (2#1100_1110#);
+      End_Insn;
+   end Gen_Into;
+
+   procedure Gen_Cdq is
+   begin
+      Start_Insn;
+      Gen_B8 (2#1001_1001#);
+      End_Insn;
+   end Gen_Cdq;
+
+   procedure Gen_Mono_Op (Op : Byte; Val : O_Enode; Sz : Insn_Size) is
+   begin
+      Start_Insn;
+      Gen_Insn_Sz (2#1111_011_0#, Sz);
+      Gen_Rm (Op, Val, Sz);
+      End_Insn;
+   end Gen_Mono_Op;
+
+   procedure Emit_Mono_Op_Stmt (Op : Byte; Stmt : O_Enode; Sz : Insn_Size)
+   is
+   begin
+      Gen_Mono_Op (Op, Get_Expr_Operand (Stmt), Sz);
+   end Emit_Mono_Op_Stmt;
+
+   procedure Emit_Load_Imm (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      Tr : O_Reg;
+   begin
+      Tr := Get_Expr_Reg (Stmt);
+      Start_Insn;
+      --  FIXME: handle 0.
+      case Sz is
+         when Sz_8 =>
+            Gen_B8 (2#1011_0_000# + To_Reg32 (Tr, Sz));
+         when Sz_16 =>
+            Gen_B8 (16#66#);
+            Gen_B8 (2#1011_1_000# + To_Reg32 (Tr, Sz));
+         when Sz_32l
+           | Sz_32h =>
+            Gen_B8 (2#1011_1_000# + To_Reg32 (Tr, Sz));
+      end case;
+      Gen_Imm (Stmt, Sz);
+      End_Insn;
+   end Emit_Load_Imm;
+
+   function Fp_Size_To_Mf (Sz : Fp_Size) return Byte is
+   begin
+      case Sz is
+         when Fp_32 =>
+            return 2#00_0#;
+         when Fp_64 =>
+            return 2#10_0#;
+      end case;
+   end Fp_Size_To_Mf;
+
+   procedure Emit_Load_Fp (Stmt : O_Enode; Sz : Fp_Size)
+   is
+      Sym : Symbol;
+      R : O_Reg;
+   begin
+      Set_Current_Section (Sect_Rodata);
+      Gen_Pow_Align (3);
+      Prealloc (8);
+      Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Sym, False);
+      Gen_Le32 (Unsigned_32 (Get_Expr_Low (Stmt)));
+      if Sz = Fp_64 then
+         Gen_Le32 (Unsigned_32 (Get_Expr_High (Stmt)));
+      end if;
+      Set_Current_Section (Sect_Text);
+
+      R := Get_Expr_Reg (Stmt);
+      case R is
+         when R_St0 =>
+            Start_Insn;
+            Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz));
+            Gen_B8 (2#00_000_101#);
+            Gen_X86_32 (Sym, 0);
+            End_Insn;
+         when Regs_Xmm =>
+            Start_Insn;
+            case Sz is
+               when Fp_32 =>
+                  Gen_B8 (16#F3#);
+               when Fp_64 =>
+                  Gen_B8 (16#F2#);
+            end case;
+            Gen_B8 (16#0f#);
+            Gen_B8 (16#10#);
+            Gen_B8 (2#00_000_101# + To_Reg_Xmm (R) * 2#1_000#);
+            Gen_X86_32 (Sym, 0);
+            End_Insn;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Emit_Load_Fp;
+
+   procedure Emit_Load_Fp_Mem (Stmt : O_Enode; Sz : Fp_Size)
+   is
+   begin
+      Start_Insn;
+      Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz));
+      Gen_Rm_Mem (2#000_000#, Get_Expr_Operand (Stmt), Sz_32l);
+      End_Insn;
+   end Emit_Load_Fp_Mem;
+
+   procedure Emit_Load_Mem (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      Tr : O_Reg;
+      Val : O_Enode;
+   begin
+      Tr := Get_Expr_Reg (Stmt);
+      Val := Get_Expr_Operand (Stmt);
+      case Tr is
+         when Regs_R32
+           | Regs_R64 =>
+            --  mov REG, OP
+            Start_Insn;
+            Gen_Insn_Sz (2#1000_101_0#, Sz);
+            Gen_Rm_Mem (To_Reg32 (Tr, Sz) * 8, Val, Sz);
+            End_Insn;
+         when R_Eq =>
+            --  Cmp OP, 1
+            Start_Insn;
+            Gen_Insn_Sz_S8 (2#1000_000_0#, Sz);
+            Gen_Rm_Mem (2#111_000#, Val, Sz);
+            Gen_B8 (1);
+            End_Insn;
+         when others =>
+            Error_Emit ("emit_load_mem", Stmt);
+      end case;
+   end Emit_Load_Mem;
+
+
+   procedure Emit_Store (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      T, R : O_Enode;
+      Tr, Rr : O_Reg;
+      B : Byte;
+   begin
+      T := Get_Assign_Target (Stmt);
+      R := Get_Expr_Operand (Stmt);
+      Tr := Get_Expr_Reg (T);
+      Rr := Get_Expr_Reg (R);
+      Start_Insn;
+      case Rr is
+         when R_Imm =>
+            if False and (Tr in Regs_R32 or Tr in Regs_R64) then
+               B := 2#1011_1_000#;
+               case Sz is
+                  when Sz_8 =>
+                     B := B and not 2#0000_1_000#;
+                  when Sz_16 =>
+                     Gen_B8 (16#66#);
+                  when Sz_32l
+                    | Sz_32h =>
+                     null;
+               end case;
+               Gen_B8 (B + To_Reg32 (Tr, Sz));
+            else
+               Gen_Insn_Sz (2#1100_011_0#, Sz);
+               Gen_Rm_Mem (16#00#, T, Sz);
+            end if;
+            Gen_Imm (R, Sz);
+         when Regs_R32
+           | Regs_R64 =>
+            Gen_Insn_Sz (2#1000_100_0#, Sz);
+            Gen_Rm_Mem (To_Reg32 (Rr, Sz) * 8, T, Sz);
+         when others =>
+            Error_Emit ("emit_store", Stmt);
+      end case;
+      End_Insn;
+   end Emit_Store;
+
+   procedure Emit_Store_Fp (Stmt : O_Enode; Sz : Fp_Size)
+   is
+   begin
+      -- fstp
+      Start_Insn;
+      Gen_B8 (2#11011_00_1# + Fp_Size_To_Mf (Sz));
+      Gen_Rm_Mem (2#011_000#, Get_Assign_Target (Stmt), Sz_32l);
+      End_Insn;
+   end Emit_Store_Fp;
+
+   procedure Emit_Push_32 (Val : O_Enode; Sz : Insn_Size)
+   is
+      R : O_Reg;
+   begin
+      R := Get_Expr_Reg (Val);
+      Start_Insn;
+      case R is
+         when R_Imm =>
+            if Is_Imm8 (Val, Sz) then
+               Gen_B8 (2#0110_1010#);
+               Gen_Imm8 (Val, Sz);
+            else
+               Gen_B8 (2#0110_1000#);
+               Gen_Imm (Val, Sz);
+            end if;
+         when Regs_R32
+           | Regs_R64 =>
+            Gen_B8 (2#01010_000# + To_Reg32 (R, Sz));
+         when others =>
+            Gen_B8 (2#1111_1111#);
+            Gen_Rm (2#110_000#, Val, Sz);
+      end case;
+      End_Insn;
+   end Emit_Push_32;
+
+   procedure Emit_Pop_32 (Val : O_Enode; Sz : Insn_Size)
+   is
+      R : O_Reg;
+   begin
+      R := Get_Expr_Reg (Val);
+      Start_Insn;
+      case R is
+         when Regs_R32
+           | Regs_R64 =>
+            Gen_B8 (2#01011_000# + To_Reg32 (R, Sz));
+         when others =>
+            Gen_B8 (2#1000_1111#);
+            Gen_Rm (2#000_000#, Val, Sz);
+      end case;
+      End_Insn;
+   end Emit_Pop_32;
+
+   procedure Emit_Push_Fp (Op : O_Enode; Sz : Fp_Size)
+   is
+      pragma Unreferenced (Op);
+   begin
+      Start_Insn;
+      --  subl esp, val
+      Gen_B8 (2#100000_11#);
+      Gen_B8 (2#11_101_100#);
+      case Sz is
+         when Fp_32 =>
+            Gen_B8 (4);
+         when Fp_64 =>
+            Gen_B8 (8);
+      end case;
+      End_Insn;
+      --  fstp st, (esp)
+      Start_Insn;
+      Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz));
+      Gen_B8 (2#00_011_100#);
+      Gen_B8 (2#00_100_100#);
+      End_Insn;
+   end Emit_Push_Fp;
+
+   function Prepare_Label (Label : O_Enode) return Symbol
+   is
+      Sym : Symbol;
+   begin
+      Sym := Get_Label_Symbol (Label);
+      if Sym = Null_Symbol then
+         Sym := Create_Local_Symbol;
+         Set_Label_Symbol (Label, Sym);
+      end if;
+      return Sym;
+   end Prepare_Label;
+
+   procedure Emit_Jmp_T (Stmt : O_Enode; Reg : O_Reg)
+   is
+      Sym : Symbol;
+      Val : Pc_Type;
+      Opc : Byte;
+   begin
+      Sym := Prepare_Label (Get_Jump_Label (Stmt));
+      Val := Get_Symbol_Value (Sym);
+      Start_Insn;
+      Opc := To_Cond (Reg);
+      if Val = 0 then
+         --  Assume long jmp.
+         Gen_B8 (16#0f#);
+         Gen_B8 (16#80# + Opc);
+         Gen_X86_Pc32 (Sym);
+      else
+         if Val + 128 < Get_Current_Pc + 4 then
+            --  Long jmp.
+            Gen_B8 (16#0f#);
+            Gen_B8 (16#80# + Opc);
+            Gen_Le32 (Unsigned_32 (Val - (Get_Current_Pc + 4)));
+         else
+            --  short jmp.
+            Gen_B8 (16#70# + Opc);
+            Gen_B8 (Byte (Val - (Get_Current_Pc + 1)));
+         end if;
+      end if;
+      End_Insn;
+   end Emit_Jmp_T;
+
+   procedure Emit_Jmp (Stmt : O_Enode)
+   is
+      Sym : Symbol;
+      Val : Pc_Type;
+   begin
+      Sym := Prepare_Label (Get_Jump_Label (Stmt));
+      Val := Get_Symbol_Value (Sym);
+      Start_Insn;
+      if Val = 0 then
+         --  Assume long jmp.
+         Gen_B8 (16#e9#);
+         Gen_X86_Pc32 (Sym);
+      else
+         if Val + 128 < Get_Current_Pc + 4 then
+            --  Long jmp.
+            Gen_B8 (16#e9#);
+            Gen_Le32 (Unsigned_32 (Val - (Get_Current_Pc + 4)));
+         else
+            --  short jmp.
+            Gen_B8 (16#eb#);
+            Gen_B8 (Byte ((Val - (Get_Current_Pc + 1)) and 16#Ff#));
+         end if;
+      end if;
+      End_Insn;
+   end Emit_Jmp;
+
+   procedure Emit_Label (Stmt : O_Enode)
+   is
+      Sym : Symbol;
+   begin
+      Sym := Prepare_Label (Stmt);
+      Set_Symbol_Pc (Sym, False);
+   end Emit_Label;
+
+   procedure Gen_Call (Sym : Symbol) is
+   begin
+      Start_Insn;
+      Gen_B8 (16#E8#);
+      Gen_X86_Pc32 (Sym);
+      End_Insn;
+   end Gen_Call;
+
+   procedure Emit_Setup_Frame (Stmt : O_Enode)
+   is
+      Val : constant Int32 := Get_Stack_Adjust (Stmt);
+   begin
+      if Val > 0 then
+         Start_Insn;
+         --  subl esp, val
+         Gen_B8 (2#100000_11#);
+         Gen_B8 (2#11_101_100#);
+         Gen_B8 (Byte (Val));
+         End_Insn;
+      elsif Val < 0 then
+         Start_Insn;
+         if -Val <= 127 then
+            --  addl esp, val
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_000_100#);
+            Gen_B8 (Byte (-Val));
+         else
+            --  addl esp, val
+            Gen_B8 (2#100000_01#);
+            Gen_B8 (2#11_000_100#);
+            Gen_Le32 (Unsigned_32 (-Val));
+         end if;
+         End_Insn;
+      end if;
+   end Emit_Setup_Frame;
+
+   procedure Emit_Call (Stmt : O_Enode)
+   is
+      use Ortho_Code.Decls;
+      Subprg : O_Dnode;
+      Sym : Symbol;
+   begin
+      Subprg := Get_Call_Subprg (Stmt);
+      Sym := Get_Decl_Symbol (Subprg);
+      Gen_Call (Sym);
+   end Emit_Call;
+
+   procedure Emit_Intrinsic (Stmt : O_Enode)
+   is
+      Op : Int32;
+   begin
+      Op := Get_Intrinsic_Operation (Stmt);
+      Start_Insn;
+      Gen_B8 (16#E8#);
+      Gen_X86_Pc32 (Intrinsics_Symbol (Op));
+      End_Insn;
+
+      Start_Insn;
+      --  addl esp, val
+      Gen_B8 (2#100000_11#);
+      Gen_B8 (2#11_000_100#);
+      Gen_B8 (16);
+      End_Insn;
+   end Emit_Intrinsic;
+
+   procedure Emit_Setcc (Dest : O_Enode; Cond : O_Reg)
+   is
+   begin
+      if Cond not in Regs_Cc then
+         raise Program_Error;
+      end if;
+      Start_Insn;
+      Gen_B8 (16#0f#);
+      Gen_B8 (16#90# + To_Cond (Cond));
+      Gen_Rm (2#000_000#, Dest, Sz_8);
+      End_Insn;
+   end Emit_Setcc;
+
+   procedure Emit_Setcc_Reg (Reg : O_Reg; Cond : O_Reg)
+   is
+   begin
+      if Cond not in Regs_Cc then
+         raise Program_Error;
+      end if;
+      Start_Insn;
+      Gen_B8 (16#0f#);
+      Gen_B8 (16#90# + To_Cond (Cond));
+      Gen_B8 (2#11_000_000# + To_Reg32 (Reg, Sz_8));
+      End_Insn;
+   end Emit_Setcc_Reg;
+
+   procedure Emit_Tst (Reg : O_Reg; Sz : Insn_Size)
+   is
+   begin
+      Start_Insn;
+      Gen_Insn_Sz (2#1000_0100#, Sz);
+      Gen_B8 (2#11_000_000# + To_Reg32 (Reg, Sz) * 9);
+      End_Insn;
+   end Emit_Tst;
+
+   procedure Gen_Cmp_Imm (Reg : O_Reg; Val : Int32; Sz : Insn_Size)
+   is
+      B : Byte;
+   begin
+      Start_Insn;
+      if Val <= 127 and Val >= -128 then
+         B := 2#10#;
+      else
+         B := 0;
+      end if;
+      Gen_Insn_Sz (2#1000_0000# + B, Sz);
+      Gen_B8 (2#11_111_000# + To_Reg32 (Reg));
+      if B = 0 then
+         Gen_Le32 (Unsigned_32 (To_Uns32 (Val)));
+      else
+         Gen_B8 (Byte (To_Uns32 (Val) and 16#Ff#));
+      end if;
+      End_Insn;
+   end Gen_Cmp_Imm;
+
+   procedure Emit_Spill (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      Reg : O_Reg;
+      Expr : O_Enode;
+   begin
+      Expr := Get_Expr_Operand (Stmt);
+      Reg := Get_Expr_Reg (Expr);
+      if Reg = R_Spill then
+         if Get_Expr_Kind (Expr) = OE_Conv then
+            return;
+         else
+            raise Program_Error;
+         end if;
+      end if;
+      Start_Insn;
+      Gen_Insn_Sz (2#1000_1000#, Sz);
+      Gen_Rm (To_Reg32 (Reg, Sz) * 8, Stmt, Sz);
+      End_Insn;
+   end Emit_Spill;
+
+   procedure Emit_Load (Reg : O_Reg; Val : O_Enode; Sz : Insn_Size)
+   is
+   begin
+      Start_Insn;
+      Gen_Insn_Sz (2#1000_1010#, Sz);
+      Gen_Rm (To_Reg32 (Reg, Sz) * 8, Val, Sz);
+      End_Insn;
+   end Emit_Load;
+
+   procedure Emit_Lea (Stmt : O_Enode)
+   is
+      Reg : O_Reg;
+   begin
+      --  Hack: change the register to use the real address instead of it.
+      Reg := Get_Expr_Reg (Stmt);
+      Set_Expr_Reg (Stmt, R_Mem);
+
+      Start_Insn;
+      Gen_B8 (2#10001101#);
+      Gen_Rm_Mem (To_Reg32 (Reg) * 8, Stmt, Sz_32l);
+      End_Insn;
+      Set_Expr_Reg (Stmt, Reg);
+   end Emit_Lea;
+
+   procedure Gen_Umul (Stmt : O_Enode; Sz : Insn_Size)
+   is
+   begin
+      if Get_Expr_Reg (Get_Expr_Left (Stmt)) /= R_Ax then
+         raise Program_Error;
+      end if;
+      Start_Insn;
+      Gen_Insn_Sz (16#F6#, Sz);
+      Gen_Rm (2#100_000#, Get_Expr_Right (Stmt), Sz);
+      End_Insn;
+   end Gen_Umul;
+
+   procedure Gen_Mul (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      Reg : O_Reg;
+      Right : O_Enode;
+      Reg_R : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (Stmt);
+      Right := Get_Expr_Right (Stmt);
+      if Get_Expr_Reg (Get_Expr_Left (Stmt)) /= Reg
+        or Sz /= Sz_32l
+      then
+         raise Program_Error;
+      end if;
+      Start_Insn;
+      if Reg = R_Ax then
+         Gen_Insn_Sz (16#F6#, Sz);
+         Gen_Rm (2#100_000#, Right, Sz);
+      else
+         Reg_R := Get_Expr_Reg (Right);
+         case Reg_R is
+            when R_Imm =>
+               if Is_Imm8 (Right, Sz) then
+                  Gen_B8 (16#6B#);
+                  Gen_B8 (To_Reg32 (Reg, Sz) * 9 or 2#11_000_000#);
+                  Gen_Imm8 (Right, Sz);
+               else
+                  Gen_B8 (16#69#);
+                  Gen_B8 (To_Reg32 (Reg, Sz) * 9 or 2#11_000_000#);
+                  Gen_Imm (Right, Sz);
+               end if;
+            when R_Mem
+              | R_Spill
+              | Regs_R32 =>
+               Gen_B8 (16#0F#);
+               Gen_B8 (16#AF#);
+               Gen_Rm (To_Reg32 (Reg, Sz) * 8, Right, Sz);
+            when others =>
+               Error_Emit ("gen_mul", Stmt);
+         end case;
+      end if;
+      End_Insn;
+   end Gen_Mul;
+
+   --  Do not trap if COND is true.
+   procedure Gen_Ov_Check (Cond : O_Reg) is
+   begin
+      --  JXX +2
+      Start_Insn;
+      Gen_B8 (16#70# + To_Cond (Cond));
+      Gen_B8 (16#02#);
+      End_Insn;
+      --  INT 4 (overflow).
+      Start_Insn;
+      Gen_B8 (16#CD#);
+      Gen_B8 (16#04#);
+      End_Insn;
+   end Gen_Ov_Check;
+
+   procedure Emit_Abs (Val : O_Enode; Mode : Mode_Type)
+   is
+      Szh : Insn_Size;
+      Pc_Jmp : Pc_Type;
+   begin
+      case Mode is
+         when Mode_I32 =>
+            Szh := Sz_32l;
+         when Mode_I64 =>
+            Szh := Sz_32h;
+         when others =>
+            raise Program_Error;
+      end case;
+      Emit_Tst (Get_Expr_Reg (Val), Szh);
+      --  JXX +
+      Start_Insn;
+      Gen_B8 (16#70# + To_Cond (R_Sge));
+      Gen_B8 (0);
+      End_Insn;
+      Pc_Jmp := Get_Current_Pc;
+      --  NEG
+      Gen_Mono_Op (2#011_000#, Val, Sz_32l);
+      if Mode = Mode_I64 then
+         --  Propagate carray.
+         --  Adc reg,0
+         --  neg reg
+         Start_Insn;
+         Gen_B8 (2#100000_11#);
+         Gen_Rm (2#010_000#, Val, Sz_32h);
+         Gen_B8 (0);
+         End_Insn;
+         Gen_Mono_Op (2#011_000#, Val, Sz_32h);
+      end if;
+      Gen_Into;
+      Patch_B8 (Pc_Jmp - 1, Unsigned_8 (Get_Current_Pc - Pc_Jmp));
+   end Emit_Abs;
+
+   procedure Gen_Alloca (Stmt : O_Enode)
+   is
+      Reg : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt));
+      if Reg not in Regs_R32 or else Reg /= Get_Expr_Reg (Stmt) then
+         raise Program_Error;
+      end if;
+      --  Align stack on word.
+      --  Add reg, (stack_boundary - 1)
+      Start_Insn;
+      Gen_B8 (2#1000_0011#);
+      Gen_B8 (2#11_000_000# + To_Reg32 (Reg));
+      Gen_B8 (Byte (X86.Flags.Stack_Boundary - 1));
+      End_Insn;
+      --  and reg, ~(stack_boundary - 1)
+      Start_Insn;
+      Gen_B8 (2#1000_0001#);
+      Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
+      Gen_Le32 (not (X86.Flags.Stack_Boundary - 1));
+      End_Insn;
+      if X86.Flags.Flag_Alloca_Call then
+         Gen_Call (Chkstk_Symbol);
+      else
+         --  subl esp, reg
+         Start_Insn;
+         Gen_B8 (2#0001_1011#);
+         Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
+         End_Insn;
+      end if;
+      --  movl reg, esp
+      Start_Insn;
+      Gen_B8 (2#1000_1001#);
+      Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
+      End_Insn;
+   end Gen_Alloca;
+
+   --  Byte/word to long.
+   procedure Gen_Movzx (Reg : Regs_R32; Op : O_Enode; Sz : Insn_Size)
+   is
+      B : Byte;
+   begin
+      Start_Insn;
+      Gen_B8 (16#0f#);
+      case Sz is
+         when Sz_8 =>
+            B := 0;
+         when Sz_16 =>
+            B := 1;
+         when Sz_32l
+           | Sz_32h =>
+            raise Program_Error;
+      end case;
+      Gen_B8 (2#1011_0110# + B);
+      Gen_Rm (To_Reg32 (Reg) * 8, Op, Sz_8);
+      End_Insn;
+   end Gen_Movzx;
+
+   --  Convert U32 to xx.
+   procedure Gen_Conv_U32 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+      Reg_Op : O_Reg;
+      Reg_Res : O_Reg;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      Reg_Op := Get_Expr_Reg (Op);
+      Reg_Res := Get_Expr_Reg (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_I32 =>
+            if Reg_Res not in Regs_R32 then
+               raise Program_Error;
+            end if;
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            Emit_Tst (Reg_Res, Sz_32l);
+            Gen_Ov_Check (R_Sge);
+         when Mode_U8
+           | Mode_B2 =>
+            if Reg_Res not in Regs_R32 then
+               raise Program_Error;
+            end if;
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            --  cmpl VAL, 0xff
+            Start_Insn;
+            Gen_B8 (2#1000_0001#);
+            Gen_Rm (2#111_000#, Op, Sz_32l);
+            Gen_Le32 (16#00_00_00_Ff#);
+            End_Insn;
+            Gen_Ov_Check (R_Ule);
+         when others =>
+            Error_Emit ("gen_conv_u32", Stmt);
+      end case;
+   end Gen_Conv_U32;
+
+   --  Convert I32 to xxx
+   procedure Gen_Conv_I32 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+      Reg_Op : O_Reg;
+      Reg_Res : O_Reg;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      Reg_Op := Get_Expr_Reg (Op);
+      Reg_Res := Get_Expr_Reg (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_I64 =>
+            if Reg_Res /= R_Edx_Eax or Reg_Op /= R_Ax then
+               raise Program_Error;
+            end if;
+            Gen_Cdq;
+         when Mode_U32 =>
+            if Reg_Res not in Regs_R32 then
+               raise Program_Error;
+            end if;
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            Emit_Tst (Reg_Res, Sz_32l);
+            Gen_Ov_Check (R_Sge);
+         when Mode_B2 =>
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            Gen_Cmp_Imm (Reg_Res, 1, Sz_32l);
+            Gen_Ov_Check (R_Ule);
+         when Mode_U8 =>
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            Gen_Cmp_Imm (Reg_Res, 16#Ff#, Sz_32l);
+            Gen_Ov_Check (R_Ule);
+         when Mode_F64 =>
+            Emit_Push_32 (Op, Sz_32l);
+            --  fild (%esp)
+            Start_Insn;
+            Gen_B8 (2#11011_011#);
+            Gen_B8 (2#00_000_100#);
+            Gen_B8 (2#00_100_100#);
+            End_Insn;
+            --  addl %esp, 4
+            Start_Insn;
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_000_100#);
+            Gen_B8 (4);
+            End_Insn;
+         when others =>
+            Error_Emit ("gen_conv_i32", Stmt);
+      end case;
+   end Gen_Conv_I32;
+
+   --  Convert U8 to xxx
+   procedure Gen_Conv_U8 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+      Reg_Res : O_Reg;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      Reg_Res := Get_Expr_Reg (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_U32
+           | Mode_I32
+           | Mode_U16
+           | Mode_I16 =>
+            if Reg_Res not in Regs_R32 then
+               raise Program_Error;
+            end if;
+            Gen_Movzx (Reg_Res, Op, Sz_8);
+         when others =>
+            Error_Emit ("gen_conv_U8", Stmt);
+      end case;
+   end Gen_Conv_U8;
+
+   --  Convert B2 to xxx
+   procedure Gen_Conv_B2 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+      Reg_Res : O_Reg;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      Reg_Res := Get_Expr_Reg (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_U32
+           | Mode_I32
+           | Mode_U16
+           | Mode_I16 =>
+            Gen_Movzx (Reg_Res, Op, Sz_8);
+         when others =>
+            Error_Emit ("gen_conv_B2", Stmt);
+      end case;
+   end Gen_Conv_B2;
+
+   --  Convert I64 to xxx
+   procedure Gen_Conv_I64 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_I32 =>
+            --  move dx to reg_helper
+            Start_Insn;
+            Gen_B8 (2#1000_1001#);
+            Gen_B8 (2#11_010_000# + To_Reg32 (Reg_Helper));
+            End_Insn;
+            Gen_Cdq;
+            --  cmp reg_helper, dx
+            Start_Insn;
+            Gen_B8 (2#0011_1001#);
+            Gen_B8 (2#11_010_000# + To_Reg32 (Reg_Helper));
+            End_Insn;
+            Gen_Ov_Check (R_Eq);
+         when Mode_F64 =>
+            Emit_Push_32 (Op, Sz_32h);
+            Emit_Push_32 (Op, Sz_32l);
+            --  fild (%esp)
+            Start_Insn;
+            Gen_B8 (2#11011_111#);
+            Gen_B8 (2#00_101_100#);
+            Gen_B8 (2#00_100_100#);
+            End_Insn;
+            --  addl %esp, 8
+            Start_Insn;
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_000_100#);
+            Gen_B8 (8);
+            End_Insn;
+         when others =>
+            Error_Emit ("gen_conv_I64", Stmt);
+      end case;
+   end Gen_Conv_I64;
+
+   --  Convert FP to xxx.
+   procedure Gen_Conv_Fp (Stmt : O_Enode) is
+   begin
+      case Get_Expr_Mode (Stmt) is
+         when Mode_I32 =>
+            --  subl %esp, 4
+            Start_Insn;
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_101_100#);
+            Gen_B8 (4);
+            End_Insn;
+            --  fistp (%esp)
+            Start_Insn;
+            Gen_B8 (2#11011_011#);
+            Gen_B8 (2#00_011_100#);
+            Gen_B8 (2#00_100_100#);
+            End_Insn;
+            Emit_Pop_32 (Stmt, Sz_32l);
+         when Mode_I64 =>
+            --  subl %esp, 8
+            Start_Insn;
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_101_100#);
+            Gen_B8 (8);
+            End_Insn;
+            --  fistp (%esp)
+            Start_Insn;
+            Gen_B8 (2#11011_111#);
+            Gen_B8 (2#00_111_100#);
+            Gen_B8 (2#00_100_100#);
+            End_Insn;
+            Emit_Pop_32 (Stmt, Sz_32l);
+            Emit_Pop_32 (Stmt, Sz_32h);
+         when others =>
+            Error_Emit ("gen_conv_fp", Stmt);
+      end case;
+   end Gen_Conv_Fp;
+
+   procedure Gen_Emit_Op (Stmt : O_Enode; Cl : Byte; Ch : Byte) is
+   begin
+      case Get_Expr_Mode (Stmt) is
+         when Mode_U32
+           | Mode_I32
+           | Mode_P32 =>
+            Emit_Op (Cl, Stmt, Sz_32l);
+         when Mode_I64
+           | Mode_U64 =>
+            Emit_Op (Cl, Stmt, Sz_32l);
+            Emit_Op (Ch, Stmt, Sz_32h);
+         when Mode_B2
+           | Mode_I8
+           | Mode_U8 =>
+            Emit_Op (Cl, Stmt, Sz_8);
+         when others =>
+            Error_Emit ("gen_emit_op", Stmt);
+      end case;
+   end Gen_Emit_Op;
+
+   procedure Gen_Check_Overflow (Mode : Mode_Type) is
+   begin
+      case Mode is
+         when Mode_I32
+           | Mode_I64
+           | Mode_I8 =>
+            Gen_Into;
+         when Mode_U64
+           | Mode_U32
+           | Mode_U8 =>
+            --  FIXME: check no carry.
+            null;
+         when Mode_B2 =>
+            null;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Check_Overflow;
+
+   procedure Gen_Emit_Fp_Op (Stmt : O_Enode; B_St1 : Byte; B_Mem : Byte)
+   is
+      Right : O_Enode;
+      Reg : O_Reg;
+      B_Size : Byte;
+   begin
+      Right := Get_Expr_Right (Stmt);
+      Reg := Get_Expr_Reg (Right);
+      Start_Insn;
+      case Reg is
+         when R_St0 =>
+            Gen_B8 (2#11011_110#);
+            Gen_B8 (2#11_000_001# or B_St1);
+         when R_Mem =>
+            case Get_Expr_Mode (Stmt) is
+               when Mode_F32 =>
+                  B_Size := 0;
+               when Mode_F64 =>
+                  B_Size := 2#100#;
+               when others =>
+                  raise Program_Error;
+            end case;
+            Gen_B8 (2#11011_000# or B_Size);
+            Gen_Rm_Mem (B_Mem, Right, Sz_32l);
+         when others =>
+            raise Program_Error;
+      end case;
+      End_Insn;
+   end Gen_Emit_Fp_Op;
+
+   procedure Emit_Mod (Stmt : O_Enode)
+   is
+      Right : O_Enode;
+      Pc1, Pc2, Pc3: Pc_Type;
+   begin
+      --  a : EAX
+      --  d : EDX
+      --  b : Rm
+
+      --  d := Rm
+      --  d := d ^ a
+      --  cltd
+      --  if cc < 0 then
+      --    idiv b
+      --    if edx /= 0 then
+      --      edx := edx + b
+      --    end if
+      --  else
+      --    idiv b
+      --  end if
+      Right := Get_Expr_Right (Stmt);
+      --  %edx <- right
+      Emit_Load (R_Dx, Right, Sz_32l);
+      --  xorl %eax -> %edx
+      Start_Insn;
+      Gen_B8 (2#0011_0011#);
+      Gen_B8 (2#11_010_000#);
+      End_Insn;
+      Gen_Cdq;
+      --  js
+      Start_Insn;
+      Gen_B8 (2#0111_1000#);
+      Gen_B8 (0);
+      End_Insn;
+      Pc1 := Get_Current_Pc;
+      --  idiv
+      Gen_Mono_Op (2#111_000#, Right, Sz_32l);
+      --  jmp
+      Start_Insn;
+      Gen_B8 (2#1110_1011#);
+      Gen_B8 (0);
+      End_Insn;
+      Pc2 := Get_Current_Pc;
+      Patch_B8 (Pc1 - 1, Unsigned_8 (Get_Current_Pc - Pc1));
+      --  idiv
+      Gen_Mono_Op (2#111_000#, Right, Sz_32l);
+      --  tstl %edx,%edx
+      Start_Insn;
+      Gen_B8 (2#1000_0101#);
+      Gen_B8 (2#11_010_010#);
+      End_Insn;
+      --  jz
+      Start_Insn;
+      Gen_B8 (2#0111_0100#);
+      Gen_B8 (0);
+      End_Insn;
+      Pc3 := Get_Current_Pc;
+      --  addl b, %edx
+      Start_Insn;
+      Gen_B8 (2#00_000_011#);
+      Gen_Rm (2#010_000#, Right, Sz_32l);
+      End_Insn;
+      Patch_B8 (Pc2 - 1, Unsigned_8 (Get_Current_Pc - Pc2));
+      Patch_B8 (Pc3 - 1, Unsigned_8 (Get_Current_Pc - Pc3));
+   end Emit_Mod;
+
+   procedure Emit_Insn (Stmt : O_Enode)
+   is
+      use Ortho_Code.Flags;
+      Kind : OE_Kind;
+      Mode : Mode_Type;
+      Reg : O_Reg;
+   begin
+      Kind := Get_Expr_Kind (Stmt);
+      Mode := Get_Expr_Mode (Stmt);
+      case Kind is
+         when OE_Beg =>
+            if Flag_Debug /= Debug_None then
+               Decls.Set_Block_Info1 (Get_Block_Decls (Stmt),
+                                      Int32 (Get_Current_Pc - Subprg_Pc));
+            end if;
+         when OE_End =>
+            if Flag_Debug /= Debug_None then
+               Decls.Set_Block_Info2 (Get_Block_Decls (Get_End_Beg (Stmt)),
+                                      Int32 (Get_Current_Pc - Subprg_Pc));
+            end if;
+         when OE_Leave =>
+            null;
+         when OE_BB =>
+            null;
+         when OE_Add_Ov =>
+            if Mode in Mode_Fp then
+               Gen_Emit_Fp_Op (Stmt, 2#000_000#, 2#000_000#);
+            else
+               Gen_Emit_Op (Stmt, 2#000_000#, 2#010_000#);
+               Gen_Check_Overflow (Mode);
+            end if;
+         when OE_Or =>
+            Gen_Emit_Op (Stmt, 2#001_000#, 2#001_000#);
+         when OE_And =>
+            Gen_Emit_Op (Stmt, 2#100_000#, 2#100_000#);
+         when OE_Xor =>
+            Gen_Emit_Op (Stmt, 2#110_000#, 2#110_000#);
+         when OE_Sub_Ov =>
+            if Mode in Mode_Fp then
+               Gen_Emit_Fp_Op (Stmt, 2#100_000#, 2#100_000#);
+            else
+               Gen_Emit_Op (Stmt, 2#101_000#, 2#011_000#);
+               Gen_Check_Overflow (Mode);
+            end if;
+         when OE_Mul_Ov
+           | OE_Mul =>
+            case Mode is
+               when Mode_U8 =>
+                  Gen_Umul (Stmt, Sz_8);
+               when Mode_U16 =>
+                  Gen_Umul (Stmt, Sz_16);
+               when Mode_U32 =>
+                  Gen_Mul (Stmt, Sz_32l);
+               when Mode_I32 =>
+                  Gen_Mono_Op (2#101_000#, Get_Expr_Right (Stmt), Sz_32l);
+               when Mode_F32
+                 | Mode_F64 =>
+                  Gen_Emit_Fp_Op (Stmt, 2#001_000#, 2#001_000#);
+               when others =>
+                  Error_Emit ("emit_insn: mul_ov", Stmt);
+            end case;
+         when OE_Shl =>
+            declare
+               Right : O_Enode;
+               Sz : Insn_Size;
+               Val : Uns32;
+            begin
+               case Mode is
+                  when Mode_U32 =>
+                     Sz := Sz_32l;
+                  when others =>
+                     Error_Emit ("emit_insn: shl", Stmt);
+               end case;
+               Right := Get_Expr_Right (Stmt);
+               if Get_Expr_Kind (Right) = OE_Const then
+                  Val := Get_Expr_Low (Right);
+                  Start_Insn;
+                  if Val = 1 then
+                     Gen_Insn_Sz (2#1101000_0#, Sz);
+                     Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz);
+                  else
+                     Gen_Insn_Sz (2#1100000_0#, Sz);
+                     Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz);
+                     Gen_B8 (Byte (Val and 31));
+                  end if;
+                  End_Insn;
+               else
+                  if Get_Expr_Reg (Right) /= R_Cx then
+                     raise Program_Error;
+                  end if;
+                  Start_Insn;
+                  Gen_Insn_Sz (2#1101001_0#, Sz);
+                  Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz);
+                  End_Insn;
+               end if;
+            end;
+         when OE_Mod
+           | OE_Rem
+           | OE_Div_Ov =>
+            case Mode is
+               when Mode_U32 =>
+                  --  Xorl edx, edx
+                  Start_Insn;
+                  Gen_B8 (2#0011_0001#);
+                  Gen_B8 (2#11_010_010#);
+                  End_Insn;
+                  Gen_Mono_Op (2#110_000#, Get_Expr_Right (Stmt), Sz_32l);
+               when Mode_I32 =>
+                  if Kind = OE_Mod then
+                     Emit_Mod (Stmt);
+                  else
+                     Gen_Cdq;
+                     Gen_Mono_Op (2#111_000#, Get_Expr_Right (Stmt), Sz_32l);
+                  end if;
+               when Mode_F32
+                 | Mode_F64 =>
+                  if Kind = OE_Div_Ov then
+                     Gen_Emit_Fp_Op (Stmt, 2#111_000#, 2#110_000#);
+                  else
+                     raise Program_Error;
+                  end if;
+               when others =>
+                  Error_Emit ("emit_insn: mod_ov", Stmt);
+            end case;
+
+         when OE_Not =>
+            case Mode is
+               when Mode_B2 =>
+                  --  Xor VAL, $1
+                  Start_Insn;
+                  Gen_B8 (2#1000_0011#);
+                  Gen_Rm (2#110_000#, Stmt, Sz_8);
+                  Gen_B8 (16#01#);
+                  End_Insn;
+               when Mode_U8 =>
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_8);
+               when Mode_U16 =>
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_16);
+               when Mode_U32 =>
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32l);
+               when Mode_U64 =>
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32l);
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32h);
+               when others =>
+                  Error_Emit ("emit_insn: not", Stmt);
+            end case;
+
+         when OE_Neg_Ov =>
+            case Mode is
+               when Mode_I8 =>
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_8);
+                  --Gen_Into;
+               when Mode_I16 =>
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_16);
+                  --Gen_Into;
+               when Mode_I32 =>
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32l);
+                  --Gen_Into;
+               when Mode_I64 =>
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32l);
+                  -- adcl 0, high
+                  Start_Insn;
+                  Gen_B8 (2#100000_11#);
+                  Gen_Rm (2#010_000#, Get_Expr_Operand (Stmt), Sz_32h);
+                  Gen_B8 (0);
+                  End_Insn;
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32h);
+                  --Gen_Into;
+               when Mode_F32
+                 | Mode_F64 =>
+                  --  fchs
+                  Start_Insn;
+                  Gen_B8 (2#11011_001#);
+                  Gen_B8 (2#1110_0000#);
+                  End_Insn;
+               when others =>
+                  Error_Emit ("emit_insn: neg_ov", Stmt);
+            end case;
+
+         when OE_Abs_Ov =>
+            case Mode is
+               when Mode_I32
+                  | Mode_I64 =>
+                  Emit_Abs (Get_Expr_Operand (Stmt), Mode);
+               when Mode_F32
+                 | Mode_F64 =>
+                  --  fabs
+                  Start_Insn;
+                  Gen_B8 (2#11011_001#);
+                  Gen_B8 (2#1110_0001#);
+                  End_Insn;
+               when others =>
+                  Error_Emit ("emit_insn: abs_ov", Stmt);
+            end case;
+
+         when OE_Kind_Cmp =>
+            case Get_Expr_Mode (Get_Expr_Left (Stmt)) is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Op (2#111_000#, Stmt, Sz_32l);
+               when Mode_B2
+                 | Mode_I8
+                 | Mode_U8 =>
+                  Emit_Op (2#111_000#, Stmt, Sz_8);
+               when Mode_U64 =>
+                  declare
+                     Pc : Pc_Type;
+                  begin
+                     Emit_Op (2#111_000#, Stmt, Sz_32h);
+                     --  jne
+                     Start_Insn;
+                     Gen_B8 (2#0111_0101#);
+                     Gen_B8 (0);
+                     End_Insn;
+                     Pc := Get_Current_Pc;
+                     Emit_Op (2#111_000#, Stmt, Sz_32l);
+                     Patch_B8 (Pc - 1, Unsigned_8 (Get_Current_Pc - Pc));
+                  end;
+               when Mode_I64 =>
+                  declare
+                     Pc : Pc_Type;
+                  begin
+                     Reg := Get_Expr_Reg (Stmt);
+                     Emit_Op (2#111_000#, Stmt, Sz_32h);
+                     --  Note: this does not clobber a reg due to care in
+                     --  insns.
+                     Emit_Setcc_Reg (Reg, Ekind_Signed_To_Cc (Kind));
+                     --  jne
+                     Start_Insn;
+                     Gen_B8 (2#0111_0101#);
+                     Gen_B8 (0);
+                     End_Insn;
+                     Pc := Get_Current_Pc;
+                     Emit_Op (2#111_000#, Stmt, Sz_32l);
+                     Emit_Setcc_Reg (Reg, Ekind_Unsigned_To_Cc (Kind));
+                     Patch_B8 (Pc - 1, Unsigned_8 (Get_Current_Pc - Pc));
+                     return;
+                  end;
+               when Mode_F32
+                 | Mode_F64 =>
+                  --  fcomip st, st(1)
+                  Start_Insn;
+                  Gen_B8 (2#11011_111#);
+                  Gen_B8 (2#1111_0001#);
+                  End_Insn;
+                  --  fstp st, st (0)
+                  Start_Insn;
+                  Gen_B8 (2#11011_101#);
+                  Gen_B8 (2#11_011_000#);
+                  End_Insn;
+               when others =>
+                  Error_Emit ("emit_insn: cmp", Stmt);
+            end case;
+            Reg := Get_Expr_Reg (Stmt);
+            if Reg not in Regs_Cc then
+               Error_Emit ("emit_insn/cmp: not cc", Stmt);
+            end if;
+         when OE_Const
+           | OE_Addrg =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Load_Imm (Stmt, Sz_32l);
+               when Mode_B2
+                 | Mode_U8
+                 | Mode_I8 =>
+                  Emit_Load_Imm (Stmt, Sz_8);
+               when Mode_I64
+                 | Mode_U64 =>
+                  Emit_Load_Imm (Stmt, Sz_32l);
+                  Emit_Load_Imm (Stmt, Sz_32h);
+               when Mode_F32 =>
+                  Emit_Load_Fp (Stmt, Fp_32);
+               when Mode_F64 =>
+                  Emit_Load_Fp (Stmt, Fp_64);
+               when others =>
+                  Error_Emit ("emit_insn: const", Stmt);
+            end case;
+         when OE_Indir =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Load_Mem (Stmt, Sz_32l);
+               when Mode_B2
+                 | Mode_U8
+                 | Mode_I8 =>
+                  Emit_Load_Mem (Stmt, Sz_8);
+               when Mode_U64
+                 | Mode_I64 =>
+                  Emit_Load_Mem (Stmt, Sz_32l);
+                  Emit_Load_Mem (Stmt, Sz_32h);
+               when Mode_F32 =>
+                  Emit_Load_Fp_Mem (Stmt, Fp_32);
+               when Mode_F64 =>
+                  Emit_Load_Fp_Mem (Stmt, Fp_64);
+               when others =>
+                  Error_Emit ("emit_insn: indir", Stmt);
+            end case;
+
+         when OE_Conv =>
+            case Get_Expr_Mode (Get_Expr_Operand (Stmt)) is
+               when Mode_U32 =>
+                  Gen_Conv_U32 (Stmt);
+               when Mode_I32 =>
+                  Gen_Conv_I32 (Stmt);
+               when Mode_U8 =>
+                  Gen_Conv_U8 (Stmt);
+               when Mode_B2 =>
+                  Gen_Conv_B2 (Stmt);
+               when Mode_I64 =>
+                  Gen_Conv_I64 (Stmt);
+               when Mode_F32
+                 | Mode_F64 =>
+                  Gen_Conv_Fp (Stmt);
+               when others =>
+                  Error_Emit ("emit_insn: conv", Stmt);
+            end case;
+
+         when OE_Asgn =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Store (Stmt, Sz_32l);
+               when Mode_B2
+                 | Mode_U8
+                 | Mode_I8 =>
+                  Emit_Store (Stmt, Sz_8);
+               when Mode_U64
+                 | Mode_I64 =>
+                  Emit_Store (Stmt, Sz_32l);
+                  Emit_Store (Stmt, Sz_32h);
+               when Mode_F32 =>
+                  Emit_Store_Fp (Stmt, Fp_32);
+               when Mode_F64 =>
+                  Emit_Store_Fp (Stmt, Fp_64);
+               when others =>
+                  Error_Emit ("emit_insn: move", Stmt);
+            end case;
+
+         when OE_Jump_F =>
+            Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt));
+            if Reg not in Regs_Cc then
+               Error_Emit ("emit_insn/jmp_f: not cc", Stmt);
+            end if;
+            Emit_Jmp_T (Stmt, Inverse_Cc (Reg));
+         when OE_Jump_T =>
+            Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt));
+            if Reg not in Regs_Cc then
+               Error_Emit ("emit_insn/jmp_t: not cc", Stmt);
+            end if;
+            Emit_Jmp_T (Stmt, Reg);
+         when OE_Jump =>
+            Emit_Jmp (Stmt);
+         when OE_Label =>
+            Emit_Label (Stmt);
+
+         when OE_Ret =>
+            --  Value already set.
+            null;
+
+         when OE_Arg =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32l);
+               when Mode_U64
+                 | Mode_I64 =>
+                  Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32h);
+                  Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32l);
+               when Mode_F32 =>
+                  Emit_Push_Fp (Get_Expr_Operand (Stmt), Fp_32);
+               when Mode_F64 =>
+                  Emit_Push_Fp (Get_Expr_Operand (Stmt), Fp_64);
+               when others =>
+                  Error_Emit ("emit_insn: oe_arg", Stmt);
+            end case;
+         when OE_Stack_Adjust =>
+            Emit_Setup_Frame (Stmt);
+         when OE_Call =>
+            Emit_Call (Stmt);
+         when OE_Intrinsic =>
+            Emit_Intrinsic (Stmt);
+
+         when OE_Move =>
+            declare
+               Operand : O_Enode;
+               Op_Reg : O_Reg;
+            begin
+               Reg := Get_Expr_Reg (Stmt);
+               Operand := Get_Expr_Operand (Stmt);
+               Op_Reg := Get_Expr_Reg (Operand);
+               case Mode is
+                  when Mode_B2 =>
+                     if Reg in Regs_R32 and then Op_Reg in Regs_Cc then
+                        Emit_Setcc (Stmt, Op_Reg);
+                     elsif (Reg = R_Eq or Reg = R_Ne)
+                       and then Op_Reg in Regs_R32
+                     then
+                        Emit_Tst (Op_Reg, Sz_8);
+                     else
+                        Error_Emit ("emit_insn: move/b2", Stmt);
+                     end if;
+                  when Mode_U32
+                    | Mode_I32 =>
+                     --  mov REG, OP
+                     Start_Insn;
+                     Gen_Insn_Sz (2#1000_101_0#, Sz_32l);
+                     Gen_Rm (To_Reg32 (Reg, Sz_32l) * 8, Operand, Sz_32l);
+                     End_Insn;
+                  when others =>
+                     Error_Emit ("emit_insn: move", Stmt);
+               end case;
+            end;
+
+         when OE_Alloca =>
+            if Mode /= Mode_P32 then
+               raise Program_Error;
+            end if;
+            Gen_Alloca (Stmt);
+
+         when OE_Set_Stack =>
+            Emit_Load_Mem (Stmt, Sz_32l);
+
+         when OE_Add
+           | OE_Addrl =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Lea (Stmt);
+               when others =>
+                  Error_Emit ("emit_insn: oe_add", Stmt);
+            end case;
+
+         when OE_Spill =>
+            case Mode is
+               when Mode_B2
+                 | Mode_U8
+                 | Mode_I8 =>
+                  Emit_Spill (Stmt, Sz_8);
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Spill (Stmt, Sz_32l);
+               when Mode_U64
+                 | Mode_I64 =>
+                  Emit_Spill (Stmt, Sz_32l);
+                  Emit_Spill (Stmt, Sz_32h);
+               when others =>
+                  Error_Emit ("emit_insn: spill", Stmt);
+            end case;
+
+         when OE_Reload =>
+            declare
+               Expr : O_Enode;
+            begin
+               Reg := Get_Expr_Reg (Stmt);
+               Expr := Get_Expr_Operand (Stmt);
+               case Mode is
+                  when Mode_B2
+                    | Mode_U8
+                    | Mode_I8 =>
+                     Emit_Load (Reg, Expr, Sz_8);
+                  when Mode_U32
+                    | Mode_I32
+                    | Mode_P32 =>
+                     Emit_Load (Reg, Expr, Sz_32l);
+                  when Mode_U64
+                    | Mode_I64 =>
+                     Emit_Load (Reg, Expr, Sz_32l);
+                     Emit_Load (Reg, Expr, Sz_32h);
+                  when others =>
+                     Error_Emit ("emit_insn: reload", Stmt);
+               end case;
+            end;
+
+         when OE_Reg =>
+            Reg_Helper := Get_Expr_Reg (Stmt);
+
+         when OE_Case_Expr
+           | OE_Case =>
+            null;
+
+         when OE_Line =>
+            if Flag_Debug = Debug_Dwarf then
+               Dwarf.Set_Line_Stmt (Get_Expr_Line_Number (Stmt));
+               Set_Current_Section (Sect_Text);
+            end if;
+         when others =>
+            Error_Emit ("cannot handle insn", Stmt);
+      end case;
+   end Emit_Insn;
+
+   procedure Push_Reg_If_Used (Reg : Regs_R32)
+   is
+      use Ortho_Code.X86.Insns;
+   begin
+      if Reg_Used (Reg) then
+         Start_Insn;
+         Gen_B8 (2#01010_000# + To_Reg32 (Reg, Sz_32l));
+         End_Insn;
+      end if;
+   end Push_Reg_If_Used;
+
+   procedure Pop_Reg_If_Used (Reg : Regs_R32)
+   is
+      use Ortho_Code.X86.Insns;
+   begin
+      if Reg_Used (Reg) then
+         Start_Insn;
+         Gen_B8 (2#01011_000# + To_Reg32 (Reg, Sz_32l));
+         End_Insn;
+      end if;
+   end Pop_Reg_If_Used;
+
+   procedure Emit_Prologue (Subprg : Subprogram_Data_Acc)
+   is
+      use Ortho_Code.Decls;
+      use Ortho_Code.Flags;
+      use Ortho_Code.X86.Insns;
+      Sym : Symbol;
+      Subprg_Decl : O_Dnode;
+      Is_Global : Boolean;
+      Frame_Size : Unsigned_32;
+      Saved_Regs_Size : Unsigned_32;
+   begin
+      --  Switch to .text section and align the function (to avoid the nested
+      --  function trick and for performance).
+      Set_Current_Section (Sect_Text);
+      Gen_Pow_Align (2);
+
+      Subprg_Decl := Subprg.D_Decl;
+      Sym := Get_Decl_Symbol (Subprg_Decl);
+      case Get_Decl_Storage (Subprg_Decl) is
+         when O_Storage_Public
+           | O_Storage_External =>
+            --  FIXME: should not accept the external case.
+            Is_Global := True;
+         when others =>
+            Is_Global := False;
+      end case;
+      Set_Symbol_Pc (Sym, Is_Global);
+      Subprg_Pc := Get_Current_Pc;
+
+      Saved_Regs_Size := Boolean'Pos(Reg_Used (R_Di)) * 4
+        + Boolean'Pos(Reg_Used (R_Si)) * 4
+        + Boolean'Pos(Reg_Used (R_Bx)) * 4;
+
+      --  Compute frame size.
+      --  8 bytes are used by return address and saved frame pointer.
+      Frame_Size := Unsigned_32 (Subprg.Stack_Max) + 8 + Saved_Regs_Size;
+      --  Align.
+      Frame_Size := (Frame_Size + X86.Flags.Stack_Boundary - 1)
+        and not (X86.Flags.Stack_Boundary - 1);
+      --  The 8 bytes are already allocated.
+      Frame_Size := Frame_Size - 8 - Saved_Regs_Size;
+
+      --  Emit prolog.
+      --  push %ebp
+      Start_Insn;
+      Gen_B8 (2#01010_101#);
+      End_Insn;
+      --  movl %esp, %ebp
+      Start_Insn;
+      Gen_B8 (2#1000100_1#);
+      Gen_B8 (2#11_100_101#);
+      End_Insn;
+      --  subl XXX, %esp
+      if Frame_Size /= 0 then
+         if not X86.Flags.Flag_Alloca_Call
+            or else Frame_Size <= 4096
+         then
+            Start_Insn;
+            if Frame_Size < 128 then
+               Gen_B8 (2#100000_11#);
+               Gen_B8 (2#11_101_100#);
+               Gen_B8 (Byte (Frame_Size));
+            else
+               Gen_B8 (2#100000_01#);
+               Gen_B8 (2#11_101_100#);
+               Gen_Le32 (Frame_Size);
+            end if;
+            End_Insn;
+         else
+            --  mov stack_size,%eax
+            Start_Insn;
+            Gen_B8 (2#1011_1_000#);
+            Gen_Le32 (Frame_Size);
+            End_Insn;
+            Gen_Call (Chkstk_Symbol);
+         end if;
+      end if;
+
+      if Flag_Profile then
+         Gen_Call (Mcount_Symbol);
+      end if;
+
+      --  Save registers.
+      Push_Reg_If_Used (R_Di);
+      Push_Reg_If_Used (R_Si);
+      Push_Reg_If_Used (R_Bx);
+   end Emit_Prologue;
+
+   procedure Emit_Epilogue (Subprg : Subprogram_Data_Acc)
+   is
+      use Ortho_Code.Decls;
+      use Ortho_Code.Types;
+      use Ortho_Code.Flags;
+      Decl : O_Dnode;
+   begin
+      --  Restore registers.
+      Pop_Reg_If_Used (R_Bx);
+      Pop_Reg_If_Used (R_Si);
+      Pop_Reg_If_Used (R_Di);
+
+      Decl := Subprg.D_Decl;
+      if Get_Decl_Kind (Decl) = OD_Function then
+         case Get_Type_Mode (Get_Decl_Type (Decl)) is
+            when Mode_U8
+              | Mode_B2 =>
+               --  movzx %al,%eax
+               Start_Insn;
+               Gen_B8 (16#0f#);
+               Gen_B8 (2#1011_0110#);
+               Gen_B8 (2#11_000_000#);
+               End_Insn;
+            when Mode_U32
+              | Mode_I32
+              | Mode_U64
+              | Mode_I64
+              | Mode_F32
+              | Mode_F64
+              | Mode_P32 =>
+               null;
+            when others =>
+               raise Program_Error;
+         end case;
+      end if;
+
+      --  leave
+      Start_Insn;
+      Gen_B8 (2#1100_1001#);
+      End_Insn;
+
+      --  ret
+      Start_Insn;
+      Gen_B8 (2#1100_0011#);
+      End_Insn;
+
+      if Flag_Debug = Debug_Dwarf then
+         Set_Body_Info (Subprg.D_Body, Int32 (Get_Current_Pc - Subprg_Pc));
+      end if;
+   end Emit_Epilogue;
+
+   procedure Emit_Subprg (Subprg : Subprogram_Data_Acc)
+   is
+      Stmt : O_Enode;
+   begin
+      if Debug.Flag_Debug_Code2 then
+         Abi.Disp_Subprg_Decl (Subprg.D_Decl);
+      end if;
+
+      Emit_Prologue (Subprg);
+
+      Stmt := Subprg.E_Entry;
+      loop
+         Stmt := Get_Stmt_Link (Stmt);
+
+         if Debug.Flag_Debug_Code2 then
+            Abi.Disp_Stmt (Stmt);
+         end if;
+
+         Emit_Insn (Stmt);
+         exit when Get_Expr_Kind (Stmt) = OE_Leave;
+      end loop;
+
+      Emit_Epilogue (Subprg);
+   end Emit_Subprg;
+
+   procedure Emit_Var_Decl (Decl : O_Dnode)
+   is
+      use Decls;
+      use Types;
+      Sym : Symbol;
+      Storage : O_Storage;
+      Dtype : O_Tnode;
+   begin
+      Set_Current_Section (Sect_Bss);
+      Sym := Create_Symbol (Get_Decl_Ident (Decl));
+      Set_Decl_Info (Decl, To_Int32 (Uns32 (Sym)));
+      Storage := Get_Decl_Storage (Decl);
+      Dtype := Get_Decl_Type (Decl);
+      case Storage is
+         when O_Storage_External =>
+            null;
+         when O_Storage_Public
+           | O_Storage_Private =>
+            Gen_Pow_Align (Get_Type_Align (Dtype));
+            Set_Symbol_Pc (Sym, Storage = O_Storage_Public);
+            Gen_Space (Integer_32 (Get_Type_Size (Dtype)));
+         when O_Storage_Local =>
+            raise Program_Error;
+      end case;
+      Set_Current_Section (Sect_Text);
+   end Emit_Var_Decl;
+
+   procedure Emit_Const_Decl (Decl : O_Dnode)
+   is
+      use Decls;
+      use Types;
+      Sym : Symbol;
+   begin
+      Set_Current_Section (Sect_Rodata);
+      Sym := Create_Symbol (Get_Decl_Ident (Decl));
+      Set_Decl_Info (Decl, To_Int32 (Uns32 (Sym)));
+      Set_Current_Section (Sect_Text);
+   end Emit_Const_Decl;
+
+   procedure Emit_Const (Val : O_Cnode)
+   is
+      use Consts;
+      use Types;
+      H, L : Uns32;
+   begin
+      case Get_Const_Kind (Val) is
+         when OC_Signed
+           | OC_Unsigned
+           | OC_Float
+           | OC_Null
+           | OC_Lit =>
+            Get_Const_Bytes (Val, H, L);
+            case Get_Type_Mode (Get_Const_Type (Val)) is
+               when Mode_U8
+                 | Mode_I8
+                 | Mode_B2 =>
+                  Gen_B8 (Byte (L));
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_F32
+                 | Mode_P32 =>
+                  Gen_Le32 (Unsigned_32 (L));
+               when Mode_F64
+                 | Mode_I64
+                 | Mode_U64 =>
+                  Gen_Le32 (Unsigned_32 (L));
+                  Gen_Le32 (Unsigned_32 (H));
+               when others =>
+                  raise Program_Error;
+            end case;
+         when OC_Address
+           | OC_Subprg_Address =>
+            Gen_X86_32 (Get_Decl_Symbol (Get_Const_Decl (Val)), 0);
+         when OC_Array =>
+            for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop
+               Emit_Const (Get_Const_Aggr_Element (Val, I));
+            end loop;
+         when OC_Record =>
+            declare
+               E : O_Cnode;
+            begin
+               for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop
+                  E := Get_Const_Aggr_Element (Val, I);
+                  Gen_Pow_Align (Get_Type_Align (Get_Const_Type (E)));
+                  Emit_Const (E);
+               end loop;
+            end;
+         when OC_Sizeof
+           | OC_Alignof
+           | OC_Union =>
+            raise Program_Error;
+      end case;
+   end Emit_Const;
+
+   procedure Emit_Const_Value (Decl : O_Dnode; Val : O_Cnode)
+   is
+      use Decls;
+      use Types;
+      Sym : Symbol;
+      Dtype : O_Tnode;
+   begin
+      Set_Current_Section (Sect_Rodata);
+      Sym := Get_Decl_Symbol (Decl);
+
+      Dtype := Get_Decl_Type (Decl);
+      Gen_Pow_Align (Get_Type_Align (Dtype));
+      Set_Symbol_Pc (Sym, Get_Decl_Storage (Decl) = O_Storage_Public);
+      Prealloc (Pc_Type (Get_Type_Size (Dtype)));
+      Emit_Const (Val);
+
+      Set_Current_Section (Sect_Text);
+   end Emit_Const_Value;
+
+   procedure Init
+   is
+      use Ortho_Ident;
+      use Ortho_Code.Flags;
+   begin
+      Arch := Arch_X86;
+
+      Create_Section (Sect_Text, ".text", Section_Exec + Section_Read);
+      Create_Section (Sect_Rodata, ".rodata", Section_Read);
+      Create_Section (Sect_Bss, ".bss",
+                      Section_Read + Section_Write + Section_Zero);
+
+      Set_Current_Section (Sect_Text);
+
+      if Flag_Profile then
+         Mcount_Symbol := Create_Symbol (Get_Identifier ("mcount"));
+      end if;
+
+      if X86.Flags.Flag_Alloca_Call then
+         Chkstk_Symbol := Create_Symbol (Get_Identifier ("___chkstk"));
+      end if;
+
+      Intrinsics_Symbol (Intrinsic_Mul_Ov_U64) :=
+        Create_Symbol (Get_Identifier ("__muldi3"));
+      Intrinsics_Symbol (Intrinsic_Div_Ov_U64) :=
+        Create_Symbol (Get_Identifier ("__mcode_div_ov_u64"));
+      Intrinsics_Symbol (Intrinsic_Mod_Ov_U64) :=
+        Create_Symbol (Get_Identifier ("__mcode_mod_ov_u64"));
+      Intrinsics_Symbol (Intrinsic_Mul_Ov_I64) :=
+        Create_Symbol (Get_Identifier ("__muldi3"));
+      Intrinsics_Symbol (Intrinsic_Div_Ov_I64) :=
+        Create_Symbol (Get_Identifier ("__divdi3"));
+      Intrinsics_Symbol (Intrinsic_Mod_Ov_I64) :=
+        Create_Symbol (Get_Identifier ("__mcode_mod_ov_i64"));
+      Intrinsics_Symbol (Intrinsic_Rem_Ov_I64) :=
+        Create_Symbol (Get_Identifier ("__mcode_rem_ov_i64"));
+
+      if Debug.Flag_Debug_Asm then
+         Dump_Asm := True;
+      end if;
+      if Debug.Flag_Debug_Hex then
+         Debug_Hex := True;
+      end if;
+
+      if Flag_Debug = Debug_Dwarf then
+         Dwarf.Init;
+         Set_Current_Section (Sect_Text);
+      end if;
+   end Init;
+
+   procedure Finish
+   is
+      use Ortho_Code.Flags;
+   begin
+      if Flag_Debug = Debug_Dwarf then
+         Set_Current_Section (Sect_Text);
+         Dwarf.Finish;
+      end if;
+   end Finish;
+
+end Ortho_Code.X86.Emits;
+
diff --git a/src/ortho/mcode/ortho_code-x86-emits.ads b/src/ortho/mcode/ortho_code-x86-emits.ads
new file mode 100644
index 000000000..9ddb43ee5
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-emits.ads
@@ -0,0 +1,36 @@
+--  Mcode back-end for ortho - Binary X86 instructions generator.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Binary_File; use Binary_File;
+
+package Ortho_Code.X86.Emits is
+   procedure Init;
+   procedure Finish;
+
+   procedure Emit_Subprg (Subprg : Subprogram_Data_Acc);
+
+   procedure Emit_Var_Decl (Decl : O_Dnode);
+   procedure Emit_Const_Decl (Decl : O_Dnode);
+   procedure Emit_Const_Value (Decl : O_Dnode; Val : O_Cnode);
+
+   type Intrinsic_Symbols_Map is array (Intrinsics_X86) of Symbol;
+   Intrinsics_Symbol : Intrinsic_Symbols_Map;
+
+   Mcount_Symbol : Symbol;
+   Chkstk_Symbol : Symbol;
+end Ortho_Code.X86.Emits;
+
diff --git a/src/ortho/mcode/ortho_code-x86-flags_linux.ads b/src/ortho/mcode/ortho_code-x86-flags_linux.ads
new file mode 100644
index 000000000..30bc7f7b3
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-flags_linux.ads
@@ -0,0 +1,31 @@
+--  X86 ABI flags.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+
+package Ortho_Code.X86.Flags_Linux is
+   --  If true, OE_Alloca calls __chkstk (Windows), otherwise OE_Alloc
+   --  modifies ESP directly.
+   Flag_Alloca_Call : constant Boolean := False;
+
+   --  Prefered stack alignment.
+   --  Must be a power of 2.
+   Stack_Boundary : constant Unsigned_32 := 2 ** 3;
+
+   --  Alignment for double (64 bit float).
+   Mode_F64_Align : constant Natural := 2;
+end Ortho_Code.X86.Flags_Linux;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_macosx.ads b/src/ortho/mcode/ortho_code-x86-flags_macosx.ads
new file mode 100644
index 000000000..a33085294
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-flags_macosx.ads
@@ -0,0 +1,31 @@
+--  X86 ABI flags.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+
+package Ortho_Code.X86.Flags_Macosx is
+   --  If true, OE_Alloca calls __chkstk (Windows), otherwise OE_Alloc
+   --  modifies ESP directly.
+   Flag_Alloca_Call : constant Boolean := False;
+
+   --  Prefered stack alignment.
+   --  Must be a power of 2.
+   Stack_Boundary : constant Unsigned_32 := 2 ** 4;
+
+   --  Alignment for double (64 bit float).
+   Mode_F64_Align : constant Natural := 2;
+end Ortho_Code.X86.Flags_Macosx;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_windows.ads b/src/ortho/mcode/ortho_code-x86-flags_windows.ads
new file mode 100644
index 000000000..3296aaf2c
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-flags_windows.ads
@@ -0,0 +1,31 @@
+--  X86 ABI flags.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+
+package Ortho_Code.X86.Flags_Windows is
+   --  If true, OE_Alloca calls __chkstk (Windows), otherwise OE_Alloc
+   --  modifies ESP directly.
+   Flag_Alloca_Call : constant Boolean := True;
+
+   --  Prefered stack alignment.
+   --  Must be a power of 2.
+   Stack_Boundary : constant Unsigned_32 := 2 ** 3;
+
+   --  Alignment for double (64 bit float).
+   Mode_F64_Align : constant Natural := 3;
+end Ortho_Code.X86.Flags_Windows;
diff --git a/src/ortho/mcode/ortho_code-x86-insns.adb b/src/ortho/mcode/ortho_code-x86-insns.adb
new file mode 100644
index 000000000..c218a9ae0
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-insns.adb
@@ -0,0 +1,2068 @@
+--  Mcode back-end for ortho - mcode to X86 instructions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces;
+with Ada.Text_IO;
+with Ortho_Code.Abi;
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Debug;
+with Ortho_Code.X86.Flags;
+
+package body Ortho_Code.X86.Insns is
+   procedure Link_Stmt (Stmt : O_Enode)
+   is
+      use Ortho_Code.Abi;
+   begin
+      Set_Stmt_Link (Last_Link, Stmt);
+      Last_Link := Stmt;
+      if Debug.Flag_Debug_Insn then
+         Disp_Stmt (Stmt);
+      end if;
+   end Link_Stmt;
+
+   function Get_Reg_Any (Mode : Mode_Type) return O_Reg is
+   begin
+      case Mode is
+         when Mode_I16 .. Mode_I32
+           | Mode_U16 .. Mode_U32
+           | Mode_P32 =>
+            return R_Any32;
+         when Mode_I8
+           | Mode_U8
+           | Mode_B2 =>
+            return R_Any8;
+         when Mode_U64
+           | Mode_I64 =>
+            return R_Any64;
+         when Mode_F32
+           | Mode_F64 =>
+            if Abi.Flag_Sse2 then
+               return R_Any_Xmm;
+            else
+               return R_St0;
+            end if;
+         when Mode_P64
+           | Mode_X1
+           | Mode_Nil
+           | Mode_Blk =>
+            raise Program_Error;
+      end case;
+   end Get_Reg_Any;
+
+   function Get_Reg_Any (Stmt : O_Enode) return O_Reg is
+   begin
+      return Get_Reg_Any (Get_Expr_Mode (Stmt));
+   end Get_Reg_Any;
+
+   --  Stack slot management.
+   Stack_Offset : Uns32 := 0;
+   Stack_Max : Uns32 := 0;
+
+   --  Count how many bytes have been pushed on the stack, during a call. This
+   --  is used to correctly align the stack for nested calls.
+   Push_Offset : Uns32 := 0;
+
+   --  STMT is an OE_END statement.
+   --  Swap Stack_Offset with Max_Stack of STMT.
+   procedure Swap_Stack_Offset (Blk : O_Dnode)
+   is
+      Prev_Offset : Uns32;
+   begin
+      Prev_Offset := Get_Block_Max_Stack (Blk);
+      Set_Block_Max_Stack (Blk, Stack_Offset);
+      Stack_Offset := Prev_Offset;
+   end Swap_Stack_Offset;
+
+   procedure Expand_Decls (Block : O_Dnode)
+   is
+      Last : O_Dnode;
+      Decl : O_Dnode;
+      Decl_Type : O_Tnode;
+   begin
+      if Get_Decl_Kind (Block) /= OD_Block then
+         raise Program_Error;
+      end if;
+      Last := Get_Block_Last (Block);
+      Decl := Block + 1;
+      while Decl <= Last loop
+         case Get_Decl_Kind (Decl) is
+            when OD_Local =>
+               Decl_Type := Get_Decl_Type (Decl);
+               Stack_Offset := Do_Align (Stack_Offset, Decl_Type);
+               Stack_Offset := Stack_Offset + Get_Type_Size (Decl_Type);
+               Set_Local_Offset (Decl, -Int32 (Stack_Offset));
+               if Stack_Offset > Stack_Max then
+                  Stack_Max := Stack_Offset;
+               end if;
+            when OD_Type
+              | OD_Const
+              | OD_Const_Val
+              | OD_Var
+              | OD_Function
+              | OD_Procedure
+              | OD_Interface
+              | OD_Body
+              | OD_Subprg_Ext =>
+               null;
+            when OD_Block =>
+               Decl := Get_Block_Last (Decl);
+         end case;
+         Decl := Decl + 1;
+      end loop;
+   end Expand_Decls;
+
+   function Ekind_To_Cc (Stmt : O_Enode; Mode : Mode_Type) return O_Reg
+   is
+      Kind : OE_Kind;
+   begin
+      Kind := Get_Expr_Kind (Stmt);
+      case Mode is
+         when Mode_U8 .. Mode_U64
+           | Mode_F32 .. Mode_F64
+           | Mode_P32
+           | Mode_P64
+           | Mode_B2 =>
+            return Ekind_Unsigned_To_Cc (Kind);
+         when Mode_I8 .. Mode_I64 =>
+            return Ekind_Signed_To_Cc (Kind);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Ekind_To_Cc;
+
+   --  CC is the result of A CMP B.
+   --  Returns the condition for B CMP A.
+   function Reverse_Cc (Cc : O_Reg) return O_Reg is
+   begin
+      case Cc is
+         when R_Ult =>
+            return R_Ugt;
+         when R_Uge =>
+            return R_Ule;
+         when R_Eq =>
+            return R_Eq;
+         when R_Ne =>
+            return R_Ne;
+         when R_Ule =>
+            return R_Uge;
+         when R_Ugt =>
+            return R_Ult;
+         when R_Slt =>
+            return R_Sgt;
+         when R_Sge =>
+            return R_Sle;
+         when R_Sle =>
+            return R_Sge;
+         when R_Sgt =>
+            return R_Slt;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Reverse_Cc;
+
+   --  Get the register in which a result of MODE is returned.
+   function Get_Call_Register (Mode : Mode_Type) return O_Reg is
+   begin
+      case Mode is
+         when Mode_U8 .. Mode_U32
+           | Mode_I8 .. Mode_I32
+           | Mode_P32
+           | Mode_B2 =>
+            return R_Ax;
+         when Mode_U64
+           | Mode_I64 =>
+            return R_Edx_Eax;
+         when Mode_F32
+           | Mode_F64 =>
+            if Abi.Flag_Sse2 and True then
+               --  Note: this shouldn't be enabled as the svr4 ABI specifies
+               --  ST0.
+               return R_Xmm0;
+            else
+               return R_St0;
+            end if;
+         when Mode_Nil =>
+            return R_None;
+         when Mode_X1
+           | Mode_Blk
+           | Mode_P64 =>
+            raise Program_Error;
+      end case;
+   end Get_Call_Register;
+
+--    function Ensure_Rm (Stmt : O_Enode) return O_Enode
+--    is
+--    begin
+--       case Get_Expr_Reg (Stmt) is
+--          when R_Mem
+--            | Regs_Any32 =>
+--             return Stmt;
+--          when others =>
+--             raise Program_Error;
+--       end case;
+--    end Ensure_Rm;
+
+--    function Ensure_Ireg (Stmt : O_Enode) return O_Enode
+--    is
+--       Reg : O_Reg;
+--    begin
+--       Reg := Get_Expr_Reg (Stmt);
+--       case Reg is
+--          when Regs_Any32
+--            | R_Imm =>
+--             return Stmt;
+--          when others =>
+--             raise Program_Error;
+--       end case;
+--    end Ensure_Ireg;
+
+   function Insert_Move (Expr : O_Enode; Dest : O_Reg) return O_Enode
+   is
+      N : O_Enode;
+   begin
+      N := New_Enode (OE_Move, Get_Expr_Mode (Expr), O_Tnode_Null,
+                      Expr, O_Enode_Null);
+      Set_Expr_Reg (N, Dest);
+      Link_Stmt (N);
+      return N;
+   end Insert_Move;
+
+--     function Insert_Spill (Expr : O_Enode) return O_Enode
+--     is
+--        N : O_Enode;
+--     begin
+--        N := New_Enode (OE_Spill, Get_Expr_Mode (Expr), O_Tnode_Null,
+--                        Expr, O_Enode_Null);
+--        Set_Expr_Reg (N, R_Spill);
+--        Link_Stmt (N);
+--        return N;
+--     end Insert_Spill;
+
+   procedure Error_Gen_Insn (Stmt : O_Enode; Reg : O_Reg)
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("gen_insn error: cannot match reg " & Abi.Image_Reg (Reg)
+                & " with stmt " & OE_Kind'Image (Get_Expr_Kind (Stmt)));
+      raise Program_Error;
+   end Error_Gen_Insn;
+
+   procedure Error_Gen_Insn (Stmt : O_Enode; Mode : Mode_Type)
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("gen_insn error: cannot match mode " & Mode_Type'Image (Mode)
+                & " with stmt " & OE_Kind'Image (Get_Expr_Kind (Stmt))
+                & " of mode " & Mode_Type'Image (Get_Expr_Mode (Stmt)));
+      raise Program_Error;
+   end Error_Gen_Insn;
+
+   pragma No_Return (Error_Gen_Insn);
+
+   Cur_Block : O_Enode;
+
+   type O_Inum is new Int32;
+   O_Free : constant O_Inum := 0;
+   O_Iroot : constant O_Inum := 1;
+
+
+   Insn_Num : O_Inum;
+
+   function Get_Insn_Num return O_Inum is
+   begin
+      Insn_Num := Insn_Num + 1;
+      return Insn_Num;
+   end Get_Insn_Num;
+
+
+   type Reg_Info_Type is record
+      --  Statement number which use this register.
+      --  This is a distance.
+      Num : O_Inum;
+
+      --  Statement which produces this value.
+      --  Used to have more info on this register (such as mode to allocate
+      --   a spill location).
+      Stmt : O_Enode;
+
+      --  If set, this register has been used.
+      --  All callee-saved registers marked must be saved.
+      Used : Boolean;
+   end record;
+
+   Init_Reg_Info : constant Reg_Info_Type := (Num => O_Free,
+                                              Stmt => O_Enode_Null,
+                                              Used => False);
+   type Reg32_Info_Array is array (Regs_R32) of Reg_Info_Type;
+   Regs : Reg32_Info_Array := (others => Init_Reg_Info);
+
+   Reg_Cc : Reg_Info_Type := Init_Reg_Info;
+
+   type Fp_Stack_Type is mod 8;
+   type RegFp_Info_Array is array (Fp_Stack_Type) of Reg_Info_Type;
+   Fp_Top : Fp_Stack_Type := 0;
+   Fp_Regs : RegFp_Info_Array;
+
+   type Reg_Xmm_Info_Array is array (Regs_Xmm) of Reg_Info_Type;
+   Info_Regs_Xmm : Reg_Xmm_Info_Array := (others => Init_Reg_Info);
+
+   function Reg_Used (Reg : Regs_R32) return Boolean is
+   begin
+      return Regs (Reg).Used;
+   end Reg_Used;
+
+   procedure Dump_Reg32_Info (Reg : Regs_R32)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+      use Abi;
+   begin
+      Put (Image_Reg (Reg));
+      Put (": ");
+      Put (Int32 (Regs (Reg).Stmt), 0);
+      Put (", num: ");
+      Put (Int32 (Regs (Reg).Num), 0);
+      --Put (", twin: ");
+      --Put (Image_Reg (Regs (Reg).Twin_Reg));
+      --Put (", link: ");
+      --Put (Image_Reg (Regs (Reg).Link));
+      New_Line;
+   end Dump_Reg32_Info;
+
+   procedure Dump_Regs
+   is
+      use Ada.Text_IO;
+      use Debug.Int32_IO;
+   begin
+--        Put ("free_regs: ");
+--        Put (Image_Reg (Free_Regs));
+--        Put (", to_free_regs: ");
+--        Put (Image_Reg (To_Free_Regs));
+--        New_Line;
+
+      for I in Regs_R32 loop
+         Dump_Reg32_Info (I);
+      end loop;
+      for I in Fp_Stack_Type loop
+         Put ("fp" & Fp_Stack_Type'Image (I));
+         Put (": ");
+         Put (Int32 (Fp_Regs (I).Stmt), 0);
+         New_Line;
+      end loop;
+   end Dump_Regs;
+
+   pragma Unreferenced (Dump_Regs);
+
+   procedure Error_Reg (Msg : String; Stmt : O_Enode; Reg : O_Reg)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+   begin
+      Put ("error reg: ");
+      Put (Msg);
+      New_Line;
+      Put (" stmt: ");
+      Put (Int32 (Stmt), 0);
+      Put (", reg: ");
+      Put (Abi.Image_Reg (Reg));
+      New_Line;
+      --Dump_Regs;
+      raise Program_Error;
+   end Error_Reg;
+   pragma No_Return (Error_Reg);
+
+   --  Free_XX
+   --  Mark a register as unused.
+   procedure Free_R32 (Reg : O_Reg) is
+   begin
+      if Regs (Reg).Num = O_Free then
+         raise Program_Error;
+      end if;
+      Regs (Reg).Num := O_Free;
+   end Free_R32;
+
+   procedure Free_Fp is
+   begin
+      if Fp_Regs (Fp_Top).Stmt = O_Enode_Null then
+         raise Program_Error;
+      end if;
+      Fp_Regs (Fp_Top).Stmt := O_Enode_Null;
+      Fp_Top := Fp_Top + 1;
+   end Free_Fp;
+
+   procedure Free_Cc is
+   begin
+      if Reg_Cc.Num = O_Free then
+         raise Program_Error;
+      end if;
+      Reg_Cc.Num := O_Free;
+   end Free_Cc;
+
+   procedure Free_Xmm (Reg : O_Reg) is
+   begin
+      if Info_Regs_Xmm (Reg).Num = O_Free then
+         raise Program_Error;
+      end if;
+      Info_Regs_Xmm (Reg).Num := O_Free;
+   end Free_Xmm;
+
+   --  Allocate a stack slot for spilling.
+   procedure Alloc_Spill (N : O_Enode)
+   is
+      Mode : Mode_Type;
+   begin
+      Mode := Get_Expr_Mode (N);
+      --  Allocate on the stack.
+      Stack_Offset := Types.Do_Align (Stack_Offset, Mode);
+      Stack_Offset := Stack_Offset + Types.Get_Mode_Size (Mode);
+      if Stack_Offset > Stack_Max then
+         Stack_Max := Stack_Offset;
+      end if;
+      Set_Spill_Info (N, -Int32 (Stack_Offset));
+   end Alloc_Spill;
+
+   --  Insert a spill statement after ORIG: will save register(s) allocated by
+   --  ORIG.
+   --  Return the register(s) spilt (There might be several registers if
+   --   ORIG uses a R64 register).
+   function Insert_Spill (Orig : O_Enode) return O_Reg
+   is
+      N : O_Enode;
+      Mode : Mode_Type;
+      Reg_Orig : O_Reg;
+   begin
+      --  Add a spill statement.
+      Mode := Get_Expr_Mode (Orig);
+      N := New_Enode (OE_Spill, Mode, O_Tnode_Null, Orig, O_Enode_Null);
+      Alloc_Spill (N);
+
+      --  Insert the statement after the one that set the register
+      --  being spilled.
+      --  That's very important to be able to easily find the spill location,
+      --  when it will be reloaded.
+      if Orig = Abi.Last_Link then
+         Link_Stmt (N);
+      else
+         Set_Stmt_Link (N, Get_Stmt_Link (Orig));
+         Set_Stmt_Link (Orig, N);
+      end if;
+      Reg_Orig := Get_Expr_Reg (Orig);
+      Set_Expr_Reg (N, Reg_Orig);
+      Set_Expr_Reg (Orig, R_Spill);
+      return Reg_Orig;
+   end Insert_Spill;
+
+   procedure Spill_R32 (Reg : Regs_R32)
+   is
+      Reg_Orig : O_Reg;
+   begin
+      if Regs (Reg).Num = O_Free then
+         --  This register was not allocated.
+         raise Program_Error;
+      end if;
+
+      Reg_Orig := Insert_Spill (Regs (Reg).Stmt);
+
+      --  Free the register.
+      case Reg_Orig is
+         when Regs_R32 =>
+            if Reg_Orig /= Reg then
+               raise Program_Error;
+            end if;
+            Free_R32 (Reg);
+         when Regs_R64 =>
+            Free_R32 (Get_R64_High (Reg_Orig));
+            Free_R32 (Get_R64_Low (Reg_Orig));
+         when others =>
+            raise Program_Error;
+      end case;
+   end Spill_R32;
+
+   procedure Alloc_R32 (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) is
+   begin
+      if Regs (Reg).Num /= O_Free then
+         Spill_R32 (Reg);
+      end if;
+      Regs (Reg) := (Num => Num, Stmt => Stmt, Used => True);
+   end Alloc_R32;
+
+   procedure Clobber_R32 (Reg : O_Reg) is
+   begin
+      if Regs (Reg).Num /= O_Free then
+         Spill_R32 (Reg);
+      end if;
+   end Clobber_R32;
+
+   procedure Alloc_Fp (Stmt : O_Enode)
+   is
+   begin
+      Fp_Top := Fp_Top - 1;
+
+      if Fp_Regs (Fp_Top).Stmt /= O_Enode_Null then
+         --  Must spill-out.
+         raise Program_Error;
+      end if;
+      Fp_Regs (Fp_Top).Stmt := Stmt;
+   end Alloc_Fp;
+
+   procedure Alloc_R64 (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum)
+   is
+      Rh, Rl : O_Reg;
+   begin
+      Rl := Get_R64_Low (Reg);
+      Rh := Get_R64_High (Reg);
+      if Regs (Rl).Num /= O_Free
+        or Regs (Rh).Num /= O_Free
+      then
+         Spill_R32 (Rl);
+      end if;
+      Regs (Rh) := (Num => Num, Stmt => Stmt, Used => True);
+      Regs (Rl) := (Num => Num, Stmt => Stmt, Used => True);
+   end Alloc_R64;
+
+   procedure Alloc_Cc (Stmt : O_Enode; Num : O_Inum) is
+   begin
+      if Reg_Cc.Num /= O_Free then
+         raise Program_Error;
+      end if;
+      Reg_Cc := (Num => Num, Stmt => Stmt, Used => True);
+   end Alloc_Cc;
+
+   procedure Spill_Xmm (Reg : Regs_Xmm)
+   is
+      Reg_Orig : O_Reg;
+   begin
+      if Info_Regs_Xmm (Reg).Num = O_Free then
+         --  This register was not allocated.
+         raise Program_Error;
+      end if;
+
+      Reg_Orig := Insert_Spill (Info_Regs_Xmm (Reg).Stmt);
+
+      --  Free the register.
+      if Reg_Orig /= Reg then
+         raise Program_Error;
+      end if;
+      Free_Xmm (Reg);
+   end Spill_Xmm;
+
+   procedure Alloc_Xmm (Reg : Regs_Xmm; Stmt : O_Enode; Num : O_Inum) is
+   begin
+      if Info_Regs_Xmm (Reg).Num /= O_Free then
+         Spill_Xmm (Reg);
+      end if;
+      Info_Regs_Xmm (Reg) := (Num => Num, Stmt => Stmt, Used => True);
+   end Alloc_Xmm;
+
+   procedure Clobber_Xmm (Reg : Regs_Xmm) is
+   begin
+      if Info_Regs_Xmm (Reg).Num /= O_Free then
+         Spill_Xmm (Reg);
+      end if;
+   end Clobber_Xmm;
+   pragma Unreferenced (Clobber_Xmm);
+
+   function Alloc_Reg (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) return O_Reg
+   is
+      Best_Reg : O_Reg;
+      Best_Num : O_Inum;
+   begin
+      case Reg is
+         when Regs_R32 =>
+            Alloc_R32 (Reg, Stmt, Num);
+            return Reg;
+         when Regs_R64 =>
+            Alloc_R64 (Reg, Stmt, Num);
+            return Reg;
+         when R_St0 =>
+            Alloc_Fp (Stmt);
+            return Reg;
+         when Regs_Xmm =>
+            Alloc_Xmm (Reg, Stmt, Num);
+            return Reg;
+         when R_Any32 =>
+            Best_Num := O_Inum'Last;
+            Best_Reg := R_None;
+            for I in Regs_R32 loop
+               if I not in R_Sp .. R_Bp then
+                  if Regs (I).Num = O_Free then
+                     Alloc_R32 (I, Stmt, Num);
+                     return I;
+                  elsif Regs (I).Num <= Best_Num then
+                     Best_Reg := I;
+                     Best_Num := Regs (I).Num;
+                  end if;
+               end if;
+            end loop;
+            Alloc_R32 (Best_Reg, Stmt, Num);
+            return Best_Reg;
+         when R_Any8 =>
+            Best_Num := O_Inum'Last;
+            Best_Reg := R_None;
+            for I in Regs_R8 loop
+               if Regs (I).Num = O_Free then
+                  Alloc_R32 (I, Stmt, Num);
+                  return I;
+               elsif Regs (I).Num <= Best_Num then
+                  Best_Reg := I;
+                  Best_Num := Regs (I).Num;
+               end if;
+            end loop;
+            Alloc_R32 (Best_Reg, Stmt, Num);
+            return Best_Reg;
+         when R_Any64 =>
+            declare
+               Rh, Rl : O_Reg;
+            begin
+               Best_Num := O_Inum'Last;
+               Best_Reg := R_None;
+               for I in Regs_R64 loop
+                  Rh := Get_R64_High (I);
+                  Rl := Get_R64_Low (I);
+                  if Regs (Rh).Num = O_Free
+                    and then Regs (Rl).Num = O_Free
+                  then
+                     Alloc_R64 (I, Stmt, Num);
+                     return I;
+                  elsif Regs (Rh).Num <= Best_Num
+                    and Regs (Rl).Num <= Best_Num
+                  then
+                     Best_Reg := I;
+                     Best_Num := O_Inum'Max (Regs (Rh).Num,
+                                             Regs (Rl).Num);
+                  end if;
+               end loop;
+               Alloc_R64 (Best_Reg, Stmt, Num);
+               return Best_Reg;
+            end;
+         when R_Any_Xmm =>
+            Best_Num := O_Inum'Last;
+            Best_Reg := R_None;
+            for I in Regs_X86_Xmm loop
+               if Info_Regs_Xmm (I).Num = O_Free then
+                  Alloc_Xmm (I, Stmt, Num);
+                  return I;
+               elsif Info_Regs_Xmm (I).Num <= Best_Num then
+                  Best_Reg := I;
+                  Best_Num := Info_Regs_Xmm (I).Num;
+               end if;
+            end loop;
+            Alloc_Xmm (Best_Reg, Stmt, Num);
+            return Best_Reg;
+         when others =>
+            Error_Reg ("alloc_reg: unknown reg", O_Enode_Null, Reg);
+            raise Program_Error;
+      end case;
+   end Alloc_Reg;
+
+   function Gen_Reload (Spill : O_Enode; Reg : O_Reg; Num : O_Inum)
+                       return O_Enode
+   is
+      N : O_Enode;
+      Mode : Mode_Type;
+   begin
+      --  Add a reload node.
+      Mode := Get_Expr_Mode (Spill);
+      N := New_Enode (OE_Reload, Mode, O_Tnode_Null, Spill, O_Enode_Null);
+      --  Note: this does not use a just-freed register, since
+      --  this case only occurs at the first call.
+      Set_Expr_Reg (N, Alloc_Reg (Reg, N, Num));
+      Link_Stmt (N);
+      return N;
+   end Gen_Reload;
+
+   function Reload (Expr : O_Enode; Dest : O_Reg; Num : O_Inum) return O_Enode
+   is
+      Reg : O_Reg;
+      Spill : O_Enode;
+   begin
+      Reg := Get_Expr_Reg (Expr);
+      case Reg is
+         when R_Spill =>
+            --  Restore the register between the statement and the spill.
+            Spill := Get_Stmt_Link (Expr);
+            Set_Expr_Reg (Expr, Get_Expr_Reg (Spill));
+            Set_Expr_Reg (Spill, R_Spill);
+            case Dest is
+               when R_Mem
+                 | R_Irm
+                 | R_Rm =>
+                  return Spill;
+               when Regs_R32
+                 | R_Any32
+                 | Regs_R64
+                 | R_Any64
+                 | R_Any8 =>
+                  return Gen_Reload (Spill, Dest, Num);
+               when R_Sib =>
+                  return Gen_Reload (Spill, R_Any32, Num);
+               when R_Ir =>
+                  return Gen_Reload (Spill, Get_Reg_Any (Expr), Num);
+               when others =>
+                  Error_Reg ("reload: unhandled dest in spill", Expr, Dest);
+            end case;
+         when Regs_R32 =>
+            case Dest is
+               when R_Irm
+                 | R_Rm
+                 | R_Ir
+                 | R_Any32
+                 | R_Any8
+                 | R_Sib =>
+                  return Expr;
+               when Regs_R32 =>
+                  if Dest = Reg then
+                     return Expr;
+                  end if;
+                  Free_R32 (Reg);
+                  Spill := Insert_Move (Expr, Dest);
+                  Alloc_R32 (Dest, Spill, Num);
+                  return Spill;
+               when others =>
+                  Error_Reg ("reload: unhandled dest in R32", Expr, Dest);
+            end case;
+         when Regs_R64 =>
+            return Expr;
+         when R_St0 =>
+            return Expr;
+         when Regs_Xmm =>
+            return Expr;
+         when R_Mem =>
+            if Get_Expr_Kind (Expr) = OE_Indir then
+               Set_Expr_Operand (Expr,
+                                 Reload (Get_Expr_Operand (Expr), R_Sib, Num));
+               return Expr;
+            else
+               raise Program_Error;
+            end if;
+         when R_B_Off
+           | R_B_I
+           | R_I_Off
+           | R_Sib =>
+            case Get_Expr_Kind (Expr) is
+               when OE_Add =>
+                  Set_Expr_Left
+                    (Expr, Reload (Get_Expr_Left (Expr), R_Any32, Num));
+                  Set_Expr_Right
+                    (Expr, Reload (Get_Expr_Right (Expr), R_Any32, Num));
+                  return Expr;
+               when OE_Addrl =>
+                  Spill := Get_Addrl_Frame (Expr);
+                  if Spill /= O_Enode_Null then
+                     Set_Addrl_Frame (Expr, Reload (Spill, R_Any32, Num));
+                  end if;
+                  return Expr;
+               when others =>
+                  Error_Reg ("reload: unhandle expr in b_off", Expr, Dest);
+            end case;
+         when R_I =>
+            Set_Expr_Left (Expr, Reload (Get_Expr_Left (Expr), R_Any32, Num));
+            return Expr;
+         when R_Imm =>
+            return Expr;
+         when others =>
+            Error_Reg ("reload: unhandled reg", Expr, Reg);
+      end case;
+   end Reload;
+
+   procedure Renum_Reg (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) is
+   begin
+      case Reg is
+         when Regs_R32 =>
+            Regs (Reg).Num := Num;
+            Regs (Reg).Stmt := Stmt;
+         when Regs_Cc =>
+            Reg_Cc.Num := Num;
+            Reg_Cc.Stmt := Stmt;
+         when R_St0 =>
+            null;
+         when Regs_R64 =>
+            declare
+               L, H : O_Reg;
+            begin
+               L := Get_R64_Low (Reg);
+               Regs (L).Num := Num;
+               Regs (L).Stmt := Stmt;
+               H := Get_R64_High (Reg);
+               Regs (H).Num := Num;
+               Regs (H).Stmt := Stmt;
+            end;
+         when others =>
+            Error_Reg ("renum_reg", Stmt, Reg);
+      end case;
+   end Renum_Reg;
+
+   procedure Free_Insn_Regs (Insn : O_Enode)
+   is
+      R : O_Reg;
+   begin
+      R := Get_Expr_Reg (Insn);
+      case R is
+         when R_Ax
+           | R_Bx
+           | R_Cx
+           | R_Dx
+           | R_Si
+           | R_Di =>
+            Free_R32 (R);
+         when R_Sp
+           | R_Bp =>
+            null;
+         when R_St0 =>
+            Free_Fp;
+         when Regs_Xmm =>
+            Free_Xmm (R);
+         when Regs_R64 =>
+            Free_R32 (Get_R64_High (R));
+            Free_R32 (Get_R64_Low (R));
+         when R_Mem =>
+            if Get_Expr_Kind (Insn) = OE_Indir then
+               Free_Insn_Regs (Get_Expr_Operand (Insn));
+            else
+               raise Program_Error;
+            end if;
+         when R_B_Off
+           | R_B_I
+           | R_I_Off
+           | R_Sib =>
+            case Get_Expr_Kind (Insn) is
+               when OE_Add =>
+                  Free_Insn_Regs (Get_Expr_Left (Insn));
+                  Free_Insn_Regs (Get_Expr_Right (Insn));
+               when OE_Addrl =>
+                  if Get_Addrl_Frame (Insn) /= O_Enode_Null then
+                     Free_Insn_Regs (Get_Addrl_Frame (Insn));
+                  end if;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when R_I =>
+            Free_Insn_Regs (Get_Expr_Left (Insn));
+         when R_Imm =>
+            null;
+         when R_Spill =>
+            null;
+         when others =>
+            Error_Reg ("free_insn_regs: unknown reg", Insn, R);
+      end case;
+   end Free_Insn_Regs;
+
+   procedure Insert_Reg (Mode : Mode_Type)
+   is
+      N : O_Enode;
+      Num : O_Inum;
+   begin
+      Num := Get_Insn_Num;
+      N := New_Enode (OE_Reg, Mode, O_Tnode_Null,
+                      O_Enode_Null, O_Enode_Null);
+      Set_Expr_Reg (N, Alloc_Reg (Get_Reg_Any (Mode), N, Num));
+      Link_Stmt (N);
+      Free_Insn_Regs (N);
+   end Insert_Reg;
+
+   procedure Insert_Arg (Expr : O_Enode)
+   is
+      N : O_Enode;
+   begin
+      Free_Insn_Regs (Expr);
+      N := New_Enode (OE_Arg, Get_Expr_Mode (Expr), O_Tnode_Null,
+                      Expr, O_Enode_Null);
+      Set_Expr_Reg (N, R_None);
+      Link_Stmt (N);
+   end Insert_Arg;
+
+   function Insert_Intrinsic (Stmt : O_Enode; Reg : O_Reg; Num : O_Inum)
+                             return O_Enode
+   is
+      N : O_Enode;
+      Op : Int32;
+      Mode : Mode_Type;
+   begin
+      Mode := Get_Expr_Mode (Stmt);
+      case Get_Expr_Kind (Stmt) is
+         when OE_Mul_Ov =>
+            case Mode is
+               when Mode_U64 =>
+                  Op := Intrinsic_Mul_Ov_U64;
+               when Mode_I64 =>
+                  Op := Intrinsic_Mul_Ov_I64;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when OE_Div_Ov =>
+            case Mode is
+               when Mode_U64 =>
+                  Op := Intrinsic_Div_Ov_U64;
+               when Mode_I64 =>
+                  Op := Intrinsic_Div_Ov_I64;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when OE_Mod =>
+            case Mode is
+               when Mode_U64 =>
+                  Op := Intrinsic_Mod_Ov_U64;
+               when Mode_I64 =>
+                  Op := Intrinsic_Mod_Ov_I64;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when OE_Rem =>
+            case Mode is
+               when Mode_U64 =>
+                  --  For unsigned, MOD == REM.
+                  Op := Intrinsic_Mod_Ov_U64;
+               when Mode_I64 =>
+                  Op := Intrinsic_Rem_Ov_I64;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when others =>
+            raise Program_Error;
+      end case;
+
+      --  Save caller-saved registers.
+      Clobber_R32 (R_Ax);
+      Clobber_R32 (R_Dx);
+      Clobber_R32 (R_Cx);
+
+      N := New_Enode (OE_Intrinsic, Mode, O_Tnode_Null,
+                      O_Enode (Op), O_Enode_Null);
+      Set_Expr_Reg (N, Alloc_Reg (Reg, N, Num));
+      Link_Stmt (N);
+      return N;
+   end Insert_Intrinsic;
+
+   --  REG is mandatory: the result of STMT must satisfy the REG constraint.
+   function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
+                     return O_Enode;
+
+   function Gen_Conv_From_Fp_Insn (Stmt : O_Enode;
+                                   Reg : O_Reg;
+                                   Pnum : O_Inum)
+                                  return O_Enode
+   is
+      Num : O_Inum;
+      Left : O_Enode;
+   begin
+      Left := Get_Expr_Operand (Stmt);
+      Num := Get_Insn_Num;
+      Left := Gen_Insn (Left, R_St0, Num);
+      Free_Insn_Regs (Left);
+      Set_Expr_Operand (Stmt, Left);
+      case Reg is
+         when Regs_R32
+           | R_Any32
+           | Regs_R64
+           | R_Any64 =>
+            Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+         when R_Rm
+           | R_Irm
+           | R_Ir =>
+            Set_Expr_Reg (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
+         when others =>
+            raise Program_Error;
+      end case;
+      Link_Stmt (Stmt);
+      return Stmt;
+--                             declare
+--                                Spill : O_Enode;
+--                             begin
+--                                Num := Get_Insn_Num;
+--                                Left := Gen_Insn (Left, R_St0, Num);
+--                                Set_Expr_Operand (Stmt, Left);
+--                                Set_Expr_Reg (Stmt, R_Spill);
+--                                Free_Insn_Regs (Left);
+--                                Link_Stmt (Stmt);
+--                                Spill := Insert_Spill (Stmt);
+--                                case Reg is
+--                                   when R_Any32
+--                                     | Regs_R32 =>
+--                                      return Gen_Reload (Spill, Reg, Pnum);
+--                                   when R_Ir =>
+--                                    return Gen_Reload (Spill, R_Any32, Pnum);
+--                                   when R_Rm
+--                                     | R_Irm =>
+--                                      return Spill;
+--                                   when others =>
+--                                      Error_Reg
+--                                        ("gen_insn:oe_conv(fp)", Stmt, Reg);
+--                                end case;
+--                             end;
+   end Gen_Conv_From_Fp_Insn;
+
+   function Gen_Call (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
+                     return O_Enode
+   is
+      use Interfaces;
+      Left : O_Enode;
+      Reg_Res : O_Reg;
+      Subprg : O_Dnode;
+      Push_Size : Uns32;
+      Pad : Uns32;
+      Res_Stmt : O_Enode;
+   begin
+      --  Emit Setup_Frame (to align stack).
+      Subprg := Get_Call_Subprg (Stmt);
+      Push_Size := Uns32 (Get_Subprg_Stack (Subprg));
+      --  Pad the stack if necessary.
+      Pad := (Push_Size + Push_Offset) and Uns32 (Flags.Stack_Boundary - 1);
+      if Pad /= 0 then
+         Pad := Uns32 (Flags.Stack_Boundary) - Pad;
+         Link_Stmt (New_Enode (OE_Stack_Adjust, Mode_Nil, O_Tnode_Null,
+                               O_Enode (Pad), O_Enode_Null));
+      end if;
+      --  The stack has been adjusted by Pad bytes.
+      Push_Offset := Push_Offset + Pad;
+
+      --  Generate code for arguments (if any).
+      Left := Get_Arg_Link (Stmt);
+      if Left /= O_Enode_Null then
+         Left := Gen_Insn (Left, R_None, Pnum);
+      end if;
+
+      --  Clobber registers.
+      Clobber_R32 (R_Ax);
+      Clobber_R32 (R_Dx);
+      Clobber_R32 (R_Cx);
+      --  FIXME: fp regs.
+
+      --  Add the call.
+      Reg_Res := Get_Call_Register (Get_Expr_Mode (Stmt));
+      Set_Expr_Reg (Stmt, Reg_Res);
+      Link_Stmt (Stmt);
+      Res_Stmt := Stmt;
+
+      if Push_Size + Pad /= 0 then
+         Res_Stmt :=
+           New_Enode (OE_Stack_Adjust, Get_Expr_Mode (Stmt), O_Tnode_Null,
+                      O_Enode (-Int32 (Push_Size + Pad)), O_Enode_Null);
+         Set_Expr_Reg (Res_Stmt, Reg_Res);
+         Link_Stmt (Res_Stmt);
+      end if;
+
+      --  The stack has been restored (just after the call).
+      Push_Offset := Push_Offset - (Push_Size + Pad);
+
+      case Reg is
+         when R_Any32
+           | R_Any64
+           | R_Any8
+           | R_Irm
+           | R_Rm
+           | R_Ir
+           | R_Sib
+           | R_Ax
+           | R_St0
+           | R_Edx_Eax =>
+            Reg_Res := Alloc_Reg (Reg_Res, Res_Stmt, Pnum);
+            return Res_Stmt;
+         when R_Any_Cc =>
+            --  Move to register.
+            --  (use the 'test' instruction).
+            Alloc_Cc (Res_Stmt, Pnum);
+            return Insert_Move (Res_Stmt, R_Ne);
+         when R_None =>
+            if Reg_Res /= R_None then
+               raise Program_Error;
+            end if;
+            return Res_Stmt;
+         when others =>
+            Error_Gen_Insn (Stmt, Reg);
+      end case;
+   end Gen_Call;
+
+   function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
+                     return O_Enode
+   is
+      Kind : OE_Kind;
+
+      Left : O_Enode;
+      Right : O_Enode;
+
+      Reg1 : O_Reg;
+      --      P_Reg : O_Reg;
+      Reg_L : O_Reg;
+      Reg_Res : O_Reg;
+
+      Num : O_Inum;
+   begin
+      Kind := Get_Expr_Kind (Stmt);
+      case Kind is
+         when OE_Addrl =>
+            Right := Get_Addrl_Frame (Stmt);
+            if Right /= O_Enode_Null then
+               Num := Get_Insn_Num;
+               Right := Gen_Insn (Right, R_Any32, Num);
+               Set_Addrl_Frame (Stmt, Right);
+            else
+               Num := O_Free;
+            end if;
+            case Reg is
+               when R_Sib =>
+                  Set_Expr_Reg (Stmt, R_B_Off);
+                  return Stmt;
+               when R_Irm
+                 | R_Ir =>
+                  if Right /= O_Enode_Null then
+                     Free_Insn_Regs (Right);
+                  end if;
+                  Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, Stmt, Pnum));
+                  Link_Stmt (Stmt);
+                  return Stmt;
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+         when OE_Addrg =>
+            case Reg is
+               when R_Sib
+                 | R_Irm
+                 | R_Ir =>
+                  Set_Expr_Reg (Stmt, R_Imm);
+                  return Stmt;
+               when R_Any32
+                 | Regs_R32 =>
+                  Set_Expr_Reg (Stmt, Reg);
+                  Link_Stmt (Stmt);
+                  return Stmt;
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+         when OE_Indir =>
+            Left := Get_Expr_Operand (Stmt);
+            case Reg is
+               when R_Irm
+                 | R_Rm =>
+                  Left := Gen_Insn (Left, R_Sib, Pnum);
+                  Set_Expr_Reg (Stmt, R_Mem);
+                  Set_Expr_Operand (Stmt, Left);
+               when R_Ir
+                 | R_Sib
+                 | R_I_Off =>
+                  Num := Get_Insn_Num;
+                  Left := Gen_Insn (Left, R_Sib, Num);
+                  Reg1 := Get_Reg_Any (Stmt);
+                  if Reg1 = R_Any64 then
+                     Reg1 := Alloc_Reg (Reg1, Stmt, Pnum);
+                     Free_Insn_Regs (Left);
+                  else
+                     Free_Insn_Regs (Left);
+                     Reg1 := Alloc_Reg (Reg1, Stmt, Pnum);
+                  end if;
+                  Set_Expr_Reg (Stmt, Reg1);
+                  Set_Expr_Operand (Stmt, Left);
+                  Link_Stmt (Stmt);
+               when Regs_R32
+                 | R_Any32
+                 | R_Any8
+                 | Regs_Fp =>
+                  Num := Get_Insn_Num;
+                  Left := Gen_Insn (Left, R_Sib, Num);
+                  Free_Insn_Regs (Left);
+                  Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                  Set_Expr_Operand (Stmt, Left);
+                  Link_Stmt (Stmt);
+               when Regs_R64
+                 | R_Any64 =>
+                  --  Avoid overwritting:
+                  --  Eg: axdx = indir (ax)
+                  --      axdx = indir (ax+dx)
+                  Num := Get_Insn_Num;
+                  Left := Gen_Insn (Left, R_Sib, Num);
+                  Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                  Left := Reload (Left, R_Sib, Num);
+                  Free_Insn_Regs (Left);
+                  Set_Expr_Operand (Stmt, Left);
+                  Link_Stmt (Stmt);
+               when R_Any_Cc =>
+                  Num := Get_Insn_Num;
+                  Left := Gen_Insn (Left, R_Sib, Num);
+                  --  Generate a cmp $1, XX
+                  Set_Expr_Reg (Stmt, R_Eq);
+                  Set_Expr_Operand (Stmt, Left);
+                  Free_Insn_Regs (Left);
+                  Link_Stmt (Stmt);
+                  Alloc_Cc (Stmt, Pnum);
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            return Stmt;
+         when OE_Conv_Ptr =>
+            --  Delete nops.
+            return Gen_Insn (Get_Expr_Operand (Stmt), Reg, Pnum);
+         when OE_Const =>
+            case Get_Expr_Mode (Stmt) is
+               when Mode_U8 .. Mode_U32
+                 | Mode_I8 .. Mode_I32
+                 | Mode_P32
+                 | Mode_B2 =>
+                  case Reg is
+                     when R_Imm
+                       | Regs_Imm32 =>
+                        Set_Expr_Reg (Stmt, R_Imm);
+                     when Regs_R32
+                       | R_Any32
+                       | R_Any8 =>
+                        Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                        Link_Stmt (Stmt);
+                     when R_Rm =>
+                        Set_Expr_Reg
+                          (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
+                        Link_Stmt (Stmt);
+                     when R_Any_Cc =>
+                        Num := Get_Insn_Num;
+                        Set_Expr_Reg (Stmt, Alloc_Reg (R_Any8, Stmt, Num));
+                        Link_Stmt (Stmt);
+                        Free_Insn_Regs (Stmt);
+                        Right := Insert_Move (Stmt, R_Ne);
+                        Alloc_Cc (Right, Pnum);
+                        return Right;
+                     when others =>
+                        Error_Gen_Insn (Stmt, Reg);
+                  end case;
+               when Mode_F32
+                 | Mode_F64 =>
+                  case Reg is
+                     when R_Ir
+                       | R_Irm
+                       | R_Rm
+                       | R_St0 =>
+                        Num := Get_Insn_Num;
+                        if Reg = R_St0 or not Abi.Flag_Sse2 then
+                           Reg1 := R_St0;
+                        else
+                           Reg1 := R_Any_Xmm;
+                        end if;
+                        Set_Expr_Reg (Stmt, Alloc_Reg (Reg1, Stmt, Num));
+                        Link_Stmt (Stmt);
+                     when others =>
+                        raise Program_Error;
+                  end case;
+               when Mode_U64
+                 | Mode_I64 =>
+                  case Reg is
+                     when R_Irm
+                       | R_Ir
+                       | R_Rm =>
+                        Set_Expr_Reg (Stmt, R_Imm);
+                     when R_Mem =>
+                        Set_Expr_Reg (Stmt, R_Mem);
+                     when Regs_R64
+                       | R_Any64 =>
+                        Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                        Link_Stmt (Stmt);
+                     when others =>
+                        raise Program_Error;
+                  end case;
+               when others =>
+                  raise Program_Error;
+            end case;
+            return Stmt;
+         when OE_Alloca =>
+            --  Roughly speaking, emited code is: (MASK is a constant).
+            --  VAL := (VAL + MASK) & ~MASK
+            --  SP := SP - VAL
+            --  res <- SP
+            Left := Get_Expr_Operand (Stmt);
+            case Reg is
+               when R_Ir
+                 | R_Irm
+                 | R_Any32 =>
+                  Num := Get_Insn_Num;
+                  if X86.Flags.Flag_Alloca_Call then
+                     Reg_L := R_Ax;
+                  else
+                     Reg_L := R_Any32;
+                  end if;
+                  Left := Gen_Insn (Left, Reg_L, Num);
+                  Set_Expr_Operand (Stmt, Left);
+                  Link_Stmt (Left);
+                  Free_Insn_Regs (Left);
+                  Set_Expr_Reg (Stmt, Alloc_Reg (Reg_L, Stmt, Pnum));
+                  Link_Stmt (Stmt);
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            return Stmt;
+
+         when OE_Kind_Cmp =>
+            --  Return LEFT cmp RIGHT, ie compute RIGHT - LEFT
+            Num := Get_Insn_Num;
+            Left := Get_Expr_Left (Stmt);
+            Reg_L := Get_Reg_Any (Left);
+            Left := Gen_Insn (Left, Reg_L, Num);
+
+            Right := Get_Expr_Right (Stmt);
+            case Get_Expr_Mode (Right) is
+               when Mode_F32
+                 | Mode_F64 =>
+                  Reg1 := R_St0;
+               when others =>
+                  Reg1 := R_Irm;
+            end case;
+            Right := Gen_Insn (Right, Reg1, Num);
+
+            --  FIXME: what about if right was spilled out of FP regs ?
+            --  (it is reloaded in reverse).
+            Left := Reload (Left, Reg_L, Num);
+
+            Set_Expr_Right (Stmt, Right);
+            Set_Expr_Left (Stmt, Left);
+
+            Link_Stmt (Stmt);
+
+            Reg_Res := Ekind_To_Cc (Stmt, Get_Expr_Mode (Left));
+            case Get_Expr_Mode (Left) is
+               when Mode_F32
+                 | Mode_F64 =>
+                  Reg_Res := Reverse_Cc (Reg_Res);
+               when Mode_I64 =>
+                  --  I64 is a little bit special...
+                  Reg_Res := Get_R64_High (Get_Expr_Reg (Left));
+                  if Reg_Res not in Regs_R8 then
+                     Reg_Res := R_Nil;
+                     for I in Regs_R8 loop
+                        if Regs (I).Num = O_Free then
+                           Reg_Res := I;
+                           exit;
+                        end if;
+                     end loop;
+                     if Reg_Res = R_Nil then
+                        --  FIXME: to be handled.
+                        --  Can this happen ?
+                        raise Program_Error;
+                     end if;
+                  end if;
+
+                  Free_Insn_Regs (Left);
+                  Free_Insn_Regs (Right);
+
+                  Set_Expr_Reg (Stmt, Reg_Res);
+                  case Reg is
+                     when R_Any_Cc =>
+                        Right := Insert_Move (Stmt, R_Ne);
+                        Alloc_Cc (Right, Pnum);
+                        return Right;
+                     when R_Any8
+                       | Regs_R8
+                       | R_Irm
+                       | R_Ir
+                       | R_Rm =>
+                        Reg_Res := Alloc_Reg (Reg_Res, Stmt, Pnum);
+                        return Stmt;
+                     when others =>
+                        Error_Gen_Insn (Stmt, Reg);
+                  end case;
+               when others =>
+                  null;
+            end case;
+            Set_Expr_Reg (Stmt, Reg_Res);
+
+            Free_Insn_Regs (Left);
+            Free_Insn_Regs (Right);
+
+            case Reg is
+               when R_Any_Cc =>
+                  Alloc_Cc (Stmt, Pnum);
+                  return Stmt;
+               when R_Any8
+                 | Regs_R8 =>
+                  Reg_Res := Alloc_Reg (Reg, Stmt, Pnum);
+                  return Insert_Move (Stmt, Reg_Res);
+               when R_Irm
+                 | R_Ir
+                 | R_Rm =>
+                  Reg_Res := Alloc_Reg (R_Any8, Stmt, Pnum);
+                  return Insert_Move (Stmt, Reg_Res);
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+         when OE_Add =>
+            declare
+               R_L : O_Reg;
+               R_R : O_Reg;
+            begin
+               Left := Gen_Insn (Get_Expr_Left (Stmt), R_Sib, Pnum);
+               Right := Gen_Insn (Get_Expr_Right (Stmt), R_Sib, Pnum);
+               Left := Reload (Left, R_Sib, Pnum);
+               Set_Expr_Right (Stmt, Right);
+               Set_Expr_Left (Stmt, Left);
+               R_L := Get_Expr_Reg (Left);
+               R_R := Get_Expr_Reg (Right);
+               --  Results can be: Reg, R_B_Off, R_Sib, R_Imm, R_B_I
+               case R_L is
+                  when R_Any32
+                    | Regs_R32 =>
+                     case R_R is
+                        when R_Imm =>
+                           Set_Expr_Reg (Stmt, R_B_Off);
+                        when R_B_Off
+                          | R_I
+                          | R_I_Off =>
+                           Set_Expr_Reg (Stmt, R_Sib);
+                        when R_Any32
+                          | Regs_R32 =>
+                           Set_Expr_Reg (Stmt, R_B_I);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_Imm =>
+                     case R_R is
+                        when R_Imm =>
+                           Set_Expr_Reg (Stmt, R_Imm);
+                        when R_Any32
+                          | Regs_R32
+                          | R_B_Off =>
+                           Set_Expr_Reg (Stmt, R_B_Off);
+                        when R_I
+                          | R_I_Off =>
+                           Set_Expr_Reg (Stmt, R_I_Off);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_B_Off =>
+                     case R_R is
+                        when R_Imm =>
+                           Set_Expr_Reg (Stmt, R_B_Off);
+                        when R_Any32
+                          | Regs_R32
+                          | R_I =>
+                           Set_Expr_Reg (Stmt, R_Sib);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_I_Off =>
+                     case R_R is
+                        when R_Imm =>
+                           Set_Expr_Reg (Stmt, R_I_Off);
+                        when R_Any32
+                          | Regs_R32 =>
+                           Set_Expr_Reg (Stmt, R_Sib);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_I =>
+                     case R_R is
+                        when R_Imm
+                          | Regs_R32
+                          | R_B_Off =>
+                           Set_Expr_Reg (Stmt, R_Sib);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_Sib
+                    | R_B_I =>
+                     if R_R = R_Imm then
+                        Set_Expr_Reg (Stmt, R_Sib);
+                     else
+                        Num := Get_Insn_Num;
+                        Free_Insn_Regs (Left);
+                        Set_Expr_Reg (Left, Alloc_Reg (R_Any32, Left, Num));
+                        Link_Stmt (Left);
+                        case R_R is
+                           when R_Any32
+                             | Regs_R32
+                             | R_I =>
+                              Set_Expr_Reg (Stmt, R_B_I);
+                           when others =>
+                              Error_Gen_Insn (Stmt, R_R);
+                        end case;
+                     end if;
+                  when others =>
+                     Error_Gen_Insn (Stmt, R_L);
+               end case;
+
+               case Reg is
+                  when R_Sib =>
+                     null;
+                  when R_Ir
+                    | R_Irm =>
+                     if Get_Expr_Reg (Stmt) /= R_Imm then
+                        Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, Stmt, Pnum));
+                        Free_Insn_Regs (Left);
+                        Free_Insn_Regs (Right);
+                        Link_Stmt (Stmt);
+                     end if;
+                  when R_Any32
+                    | Regs_R32 =>
+                     Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                     Link_Stmt (Stmt);
+                  when others =>
+                     Error_Gen_Insn (Stmt, Reg);
+               end case;
+            end;
+            return Stmt;
+         when OE_Mul =>
+            Num := Get_Insn_Num;
+            Left := Gen_Insn (Get_Expr_Left (Stmt), R_Ax, Num);
+            Set_Expr_Left (Stmt, Left);
+
+            Right := Gen_Insn (Get_Expr_Right (Stmt), R_Any32, Num);
+            if Get_Expr_Kind (Right) /= OE_Const then
+               raise Program_Error;
+            end if;
+            Set_Expr_Right (Stmt, Right);
+
+            Free_Insn_Regs (Left);
+            Free_Insn_Regs (Right);
+            Clobber_R32 (R_Dx);
+            Set_Expr_Reg (Stmt, Alloc_Reg (R_Ax, Stmt, Pnum));
+            case Reg is
+               when R_Sib
+                 | R_B_Off =>
+                  null;
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            Link_Stmt (Stmt);
+            return Stmt;
+         when OE_Shl =>
+            Num := Get_Insn_Num;
+            Right := Get_Expr_Right (Stmt);
+            if Get_Expr_Kind (Right) /= OE_Const then
+               Right := Gen_Insn (Right, R_Cx, Num);
+            else
+               Right := Gen_Insn (Right, R_Imm, Num);
+            end if;
+            Left := Get_Expr_Left (Stmt);
+            Reg1 := Get_Reg_Any (Stmt);
+            Left := Gen_Insn (Left, Reg1, Pnum);
+            if Get_Expr_Kind (Right) /= OE_Const then
+               Right := Reload (Right, R_Cx, Num);
+            end if;
+            Left := Reload (Left, Reg1, Pnum);
+            Set_Expr_Left (Stmt, Left);
+            Set_Expr_Right (Stmt, Right);
+            if Reg = R_Sib
+              and then Get_Expr_Kind (Right) = OE_Const
+              and then Get_Expr_Low (Right) in 0 .. 3
+            then
+               Set_Expr_Reg (Stmt, R_I);
+            else
+               Link_Stmt (Stmt);
+               Set_Expr_Reg (Stmt, Get_Expr_Reg (Left));
+               Free_Insn_Regs (Right);
+            end if;
+            return Stmt;
+
+         when OE_Add_Ov
+           | OE_Sub_Ov
+           | OE_And
+           | OE_Xor
+           | OE_Or =>
+            --  Accepted is: R with IMM or R/M
+            Num := Get_Insn_Num;
+            Right := Get_Expr_Right (Stmt);
+            Left := Get_Expr_Left (Stmt);
+            case Reg is
+               when R_Irm
+                 | R_Rm
+                 | R_Ir
+                 | R_Sib =>
+                  Right := Gen_Insn (Right, R_Irm, Num);
+                  Reg1 := Get_Reg_Any (Stmt);
+                  Left := Gen_Insn (Left, Reg1, Num);
+                  Right := Reload (Right, R_Irm, Num);
+                  Left := Reload (Left, Reg1, Num);
+                  Reg_Res := Get_Expr_Reg (Left);
+               when R_Any_Cc =>
+                  Right := Gen_Insn (Right, R_Irm, Num);
+                  Left := Gen_Insn (Left, R_Any8, Num);
+                  Reg_Res := R_Ne;
+                  Alloc_Cc (Stmt, Num);
+                  Free_Insn_Regs (Left);
+               when R_Any32
+                 | Regs_R32
+                 | R_Any8
+                 | R_Any64
+                 | Regs_R64
+                 | Regs_Fp =>
+                  Right := Gen_Insn (Right, R_Irm, Num);
+                  Left := Gen_Insn (Left, Reg, Num);
+                  Right := Reload (Right, R_Irm, Num);
+                  Left := Reload (Left, Reg, Num);
+                  Reg_Res := Get_Expr_Reg (Left);
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            Set_Expr_Right (Stmt, Right);
+            Set_Expr_Left (Stmt, Left);
+            Set_Expr_Reg (Stmt, Reg_Res);
+            Renum_Reg (Reg_Res, Stmt, Pnum);
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Right);
+            return Stmt;
+
+         when OE_Mod
+           | OE_Rem
+           | OE_Mul_Ov
+           | OE_Div_Ov =>
+            declare
+               Mode : Mode_Type;
+            begin
+               Num := Get_Insn_Num;
+               Mode := Get_Expr_Mode (Stmt);
+               Left := Get_Expr_Left (Stmt);
+               Right := Get_Expr_Right (Stmt);
+               case Mode is
+                  when Mode_I32
+                    | Mode_U32
+                    | Mode_I16
+                    | Mode_U16 =>
+                     Left := Gen_Insn (Left, R_Ax, Num);
+                     Right := Gen_Insn (Right, R_Rm, Num);
+                     Left := Reload (Left, R_Ax, Num);
+                     case Kind is
+                        when OE_Div_Ov
+                          | OE_Rem
+                          | OE_Mod =>
+                           --  Be sure EDX is free.
+                           Reg_Res := Alloc_Reg (R_Dx, Stmt, Pnum);
+                        when others =>
+                           Reg_Res := R_Nil;
+                     end case;
+                     Right := Reload (Right, R_Rm, Num);
+                     Set_Expr_Right (Stmt, Right);
+                     Set_Expr_Left (Stmt, Left);
+                     Free_Insn_Regs (Left);
+                     Free_Insn_Regs (Right);
+                     if Reg_Res /= R_Nil then
+                        Free_R32 (Reg_Res);
+                     end if;
+                     if Kind = OE_Div_Ov or Kind = OE_Mul_Ov then
+                        Reg_Res := R_Ax;
+                        Clobber_R32 (R_Dx);
+                     else
+                        Reg_Res := R_Dx;
+                        Clobber_R32 (R_Ax);
+                     end if;
+                     Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum));
+                     Link_Stmt (Stmt);
+                     return Reload (Stmt, Reg, Pnum);
+                  when Mode_U64
+                    | Mode_I64 =>
+                     --  FIXME: align stack
+                     Insert_Arg (Gen_Insn (Right, R_Irm, Num));
+                     Insert_Arg (Gen_Insn (Left, R_Irm, Num));
+                     return Insert_Intrinsic (Stmt, R_Edx_Eax, Pnum);
+                  when Mode_F32
+                    | Mode_F64 =>
+                     Left := Gen_Insn (Left, R_St0, Num);
+                     Right := Gen_Insn (Right, R_Rm, Num);
+                     Set_Expr_Left (Stmt, Left);
+                     Set_Expr_Right (Stmt, Right);
+                     Free_Insn_Regs (Right);
+                     Free_Insn_Regs (Left);
+                     Set_Expr_Reg (Stmt, Alloc_Reg (R_St0, Stmt, Pnum));
+                     Link_Stmt (Stmt);
+                     return Stmt;
+                  when others =>
+                     Error_Gen_Insn (Stmt, Mode);
+               end case;
+            end;
+
+         when OE_Not
+           | OE_Abs_Ov
+           | OE_Neg_Ov =>
+            Left := Get_Expr_Operand (Stmt);
+            case Reg is
+               when R_Any32
+                 | Regs_R32
+                 | R_Any64
+                 | Regs_R64
+                 | R_Any8
+                 | R_St0 =>
+                  Reg_Res := Reg;
+               when R_Any_Cc =>
+                  if Kind /= OE_Not then
+                     raise Program_Error;
+                  end if;
+                  Left := Gen_Insn (Left, R_Any_Cc, Pnum);
+                  Set_Expr_Operand (Stmt, Left);
+                  Reg_Res := Inverse_Cc (Get_Expr_Reg (Left));
+                  Free_Cc;
+                  Set_Expr_Reg (Stmt, Reg_Res);
+                  Alloc_Cc (Stmt, Pnum);
+                  return Stmt;
+               when R_Irm
+                 | R_Rm
+                 | R_Ir =>
+                  Reg_Res := Get_Reg_Any (Get_Expr_Mode (Left));
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            Left := Gen_Insn (Left, Reg_Res, Pnum);
+            Set_Expr_Operand (Stmt, Left);
+            Reg_Res := Get_Expr_Reg (Left);
+            Free_Insn_Regs (Left);
+            Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum));
+            Link_Stmt (Stmt);
+            return Stmt;
+         when OE_Conv =>
+            declare
+               O_Mode : Mode_Type;      --  Operand mode
+               R_Mode : Mode_Type;      --  Result mode
+            begin
+               Left := Get_Expr_Operand (Stmt);
+               O_Mode := Get_Expr_Mode (Left);
+               R_Mode := Get_Expr_Mode (Stmt);
+               --  Simple case: no conversion.
+               --  FIXME: should be handled by EXPR and convert to NOP.
+               if Get_Expr_Mode (Left) = Get_Expr_Mode (Stmt) then
+                  --  A no-op.
+                  return Gen_Insn (Left, Reg, Pnum);
+               end if;
+               case R_Mode is
+                  when Mode_B2 =>
+                     case O_Mode is
+                        when Mode_U32
+                          | Mode_I32 =>
+                           --  Detect for bound.
+                           null;
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_U8 =>
+                     case O_Mode is
+                        when Mode_U16
+                          | Mode_U32
+                          | Mode_I32 =>
+                           --  Detect for bound.
+                           null;
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_U32 =>
+                     case O_Mode is
+                        when Mode_I32 =>
+                           --  Detect for bound.
+                           null;
+                        when Mode_B2
+                          | Mode_U8
+                          | Mode_U16 =>
+                           --  Zero extend.
+                           null;
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_I32 =>
+                     case O_Mode is
+                        when Mode_U8
+                          | Mode_I8
+                          | Mode_B2
+                          | Mode_U16
+                          | Mode_U32 =>
+                           --  Zero extend
+                           --  Detect for bound (U32).
+                           null;
+                        when Mode_I64 =>
+                           --  Detect for bound (U32)
+                           Num := Get_Insn_Num;
+                           Left := Gen_Insn (Left, R_Edx_Eax, Num);
+                           Free_Insn_Regs (Left);
+                           Set_Expr_Operand (Stmt, Left);
+                           case Reg is
+                              when R_Ax
+                                | R_Any32
+                                | R_Rm
+                                | R_Irm
+                                | R_Ir =>
+                                 Set_Expr_Reg
+                                   (Stmt, Alloc_Reg (R_Ax, Stmt, Num));
+                              when others =>
+                                 raise Program_Error;
+                           end case;
+                           Insert_Reg (Mode_U32);
+                           Link_Stmt (Stmt);
+                           return Stmt;
+                        when Mode_F64
+                          | Mode_F32 =>
+                           return Gen_Conv_From_Fp_Insn (Stmt, Reg, Pnum);
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_I64 =>
+                     case O_Mode is
+                        when Mode_I32 =>
+                           --  Sign extend.
+                           Num := Get_Insn_Num;
+                           Left := Gen_Insn (Left, R_Ax, Num);
+                           Set_Expr_Operand (Stmt, Left);
+                           Free_Insn_Regs (Left);
+                           case Reg is
+                              when R_Edx_Eax
+                                | R_Any64
+                                | R_Rm
+                                | R_Irm
+                                | R_Ir =>
+                                 Set_Expr_Reg
+                                   (Stmt, Alloc_Reg (R_Edx_Eax, Stmt, Pnum));
+                              when others =>
+                                 raise Program_Error;
+                           end case;
+                           Link_Stmt (Stmt);
+                           return Stmt;
+                        when Mode_F64
+                          | Mode_F32 =>
+                           return Gen_Conv_From_Fp_Insn (Stmt, Reg, Pnum);
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_F64 =>
+                     case O_Mode is
+                        when Mode_I32
+                          | Mode_I64 =>
+                           null;
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when others =>
+                     Error_Gen_Insn (Stmt, O_Mode);
+               end case;
+               Left := Gen_Insn (Left, R_Rm, Pnum);
+               Set_Expr_Operand (Stmt, Left);
+               case Reg is
+                  when R_Irm
+                    | R_Rm
+                    | R_Ir
+                    | R_Sib
+                    | R_Any32
+                    | Regs_R32
+                    | R_Any64
+                    | R_Any8
+                    | Regs_R64
+                    | Regs_Fp =>
+                     Free_Insn_Regs (Left);
+                     Set_Expr_Reg
+                       (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
+                  when others =>
+                     Error_Gen_Insn (Stmt, Reg);
+               end case;
+               Link_Stmt (Stmt);
+               return Stmt;
+            end;
+         when OE_Arg =>
+            if Reg /= R_None then
+               raise Program_Error;
+            end if;
+            Left := Get_Arg_Link (Stmt);
+            if Left /= O_Enode_Null then
+               --  Recurse on next argument, so the first argument is pushed
+               --  the last one.
+               Left := Gen_Insn (Left, R_None, Pnum);
+            end if;
+
+            Left := Get_Expr_Operand (Stmt);
+            case Get_Expr_Mode (Left) is
+               when Mode_F32 .. Mode_F64 =>
+                  --  fstp instruction.
+                  Reg_Res := R_St0;
+               when others =>
+                  --  Push instruction.
+                  Reg_Res := R_Irm;
+            end case;
+            Left := Gen_Insn (Left, Reg_Res, Pnum);
+            Set_Expr_Operand (Stmt, Left);
+            Push_Offset := Push_Offset +
+              Do_Align (Get_Mode_Size (Get_Expr_Mode (Left)), Mode_U32);
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Left);
+            return Stmt;
+         when OE_Call =>
+            return Gen_Call (Stmt, Reg, Pnum);
+         when OE_Case_Expr =>
+            Left := Get_Expr_Operand (Stmt);
+            Set_Expr_Reg (Stmt, Alloc_Reg (Get_Expr_Reg (Left), Stmt, Pnum));
+            return Stmt;
+         when OE_Get_Stack =>
+            Set_Expr_Reg (Stmt, R_Sp);
+            return Stmt;
+         when OE_Get_Frame =>
+            Set_Expr_Reg (Stmt, R_Bp);
+            return Stmt;
+         when others =>
+            Ada.Text_IO.Put_Line
+              ("gen_insn: unhandled enode " & OE_Kind'Image (Kind));
+            raise Program_Error;
+      end case;
+   end Gen_Insn;
+
+   procedure Assert_Free_Regs (Stmt : O_Enode) is
+   begin
+      for I in Regs_R32 loop
+         if Regs (I).Num /= O_Free then
+            Error_Reg ("gen_insn_stmt: reg is not free", Stmt, I);
+         end if;
+      end loop;
+      for I in Fp_Stack_Type loop
+         if Fp_Regs (I).Stmt /= O_Enode_Null then
+            Error_Reg ("gen_insn_stmt: reg is not free", Stmt, R_St0);
+         end if;
+      end loop;
+   end Assert_Free_Regs;
+
+   procedure Gen_Insn_Stmt (Stmt : O_Enode)
+   is
+      Kind : OE_Kind;
+
+      Left : O_Enode;
+      Right : O_Enode;
+      P_Reg : O_Reg;
+      Num : O_Inum;
+
+      Prev_Stack_Offset : Uns32;
+   begin
+      Insn_Num := O_Iroot;
+      Num := Get_Insn_Num;
+      Prev_Stack_Offset := Stack_Offset;
+
+      Kind := Get_Expr_Kind (Stmt);
+      case Kind is
+         when OE_Asgn =>
+            Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Ir, Num);
+            Right := Gen_Insn (Get_Assign_Target (Stmt), R_Sib, Num);
+            Left := Reload (Left, R_Ir, Num);
+            --Right := Reload (Right, R_Sib, Num);
+            Set_Expr_Operand (Stmt, Left);
+            Set_Assign_Target (Stmt, Right);
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Left);
+            Free_Insn_Regs (Right);
+         when OE_Set_Stack =>
+            Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Rm, Num);
+            Set_Expr_Operand (Stmt, Left);
+            Set_Expr_Reg (Stmt, R_Sp);
+            Link_Stmt (Stmt);
+         when OE_Jump_F
+           | OE_Jump_T =>
+            Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Any_Cc, Num);
+            Set_Expr_Operand (Stmt, Left);
+            Link_Stmt (Stmt);
+            Free_Cc;
+         when OE_Beg =>
+            declare
+               Block_Decl : O_Dnode;
+            begin
+               Cur_Block := Stmt;
+               Block_Decl := Get_Block_Decls (Cur_Block);
+               Set_Block_Max_Stack (Block_Decl, Stack_Offset);
+               Expand_Decls (Block_Decl);
+            end;
+            Link_Stmt (Stmt);
+         when OE_End =>
+            Swap_Stack_Offset (Get_Block_Decls (Cur_Block));
+            Cur_Block := Get_Block_Parent (Cur_Block);
+            Link_Stmt (Stmt);
+         when OE_Jump
+           | OE_Label =>
+            Link_Stmt (Stmt);
+         when OE_Leave =>
+            Link_Stmt (Stmt);
+         when OE_Call =>
+            Link_Stmt (Gen_Call (Stmt, R_None, Num));
+         when OE_Ret =>
+            Left := Get_Expr_Operand (Stmt);
+            P_Reg := Get_Call_Register (Get_Expr_Mode (Stmt));
+            Left := Gen_Insn (Left, P_Reg, Num);
+            Set_Expr_Operand (Stmt, Left);
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Left);
+         when OE_Case =>
+            Left := Gen_Insn (Get_Expr_Operand (Stmt),
+                              Get_Reg_Any (Get_Expr_Mode (Stmt)),
+                              Num);
+            Set_Expr_Operand (Stmt, Left);
+            Set_Expr_Reg (Stmt, Get_Expr_Reg (Left));
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Left);
+         when OE_Line =>
+            Set_Expr_Reg (Stmt, R_None);
+            Link_Stmt (Stmt);
+         when OE_BB =>
+            --  Keep BB.
+            Link_Stmt (Stmt);
+         when others =>
+            Ada.Text_IO.Put_Line
+              ("gen_insn_stmt: unhandled enode " & OE_Kind'Image (Kind));
+            raise Program_Error;
+      end case;
+
+      --  Free any spill stack slots.
+      case Kind is
+         when OE_Beg
+           | OE_End =>
+            null;
+         when others =>
+            Stack_Offset := Prev_Stack_Offset;
+      end case;
+
+      --  Check all registers are free.
+      if Debug.Flag_Debug_Assert then
+         Assert_Free_Regs (Stmt);
+      end if;
+   end Gen_Insn_Stmt;
+
+   procedure Gen_Subprg_Insns (Subprg : Subprogram_Data_Acc)
+   is
+      First : O_Enode;
+      Stmt : O_Enode;
+      N_Stmt : O_Enode;
+   begin
+      if Debug.Flag_Debug_Insn then
+         declare
+            Inter : O_Dnode;
+         begin
+            Disp_Decl (1, Subprg.D_Decl);
+            Inter := Get_Subprg_Interfaces (Subprg.D_Decl);
+            while Inter /= O_Dnode_Null loop
+               Disp_Decl (2, Inter);
+               Inter := Get_Interface_Chain (Inter);
+            end loop;
+         end;
+      end if;
+
+      for I in Regs_R32 loop
+         Regs (I).Used := False;
+      end loop;
+
+      Stack_Max := 0;
+      Stack_Offset := 0;
+      First := Subprg.E_Entry;
+      Expand_Decls (Subprg.D_Body + 1);
+      Abi.Last_Link := First;
+
+      --  Generate instructions.
+      --  Skip OE_Entry.
+      Stmt := Get_Stmt_Link (First);
+      loop
+         N_Stmt := Get_Stmt_Link (Stmt);
+         Gen_Insn_Stmt (Stmt);
+         exit when Get_Expr_Kind (Stmt) = OE_Leave;
+         Stmt := N_Stmt;
+      end loop;
+
+      --  Keep stack depth for this subprogram.
+      Subprg.Stack_Max := Stack_Max;
+
+      --  Sanity check: there must be no remaining pushed bytes.
+      if Push_Offset /= 0 then
+         raise Program_Error with "gen_subprg_insn: push_offset not 0";
+      end if;
+   end Gen_Subprg_Insns;
+
+end Ortho_Code.X86.Insns;
diff --git a/src/ortho/mcode/ortho_code-x86-insns.ads b/src/ortho/mcode/ortho_code-x86-insns.ads
new file mode 100644
index 000000000..9411737a0
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-insns.ads
@@ -0,0 +1,25 @@
+--  Mcode back-end for ortho - mcode to X86 instructions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Ortho_Code.X86.Insns is
+   function Reg_Used (Reg : Regs_R32) return Boolean;
+
+   --  Split enodes of SUBPRG into instructions.
+   procedure Gen_Subprg_Insns (Subprg : Subprogram_Data_Acc);
+
+end Ortho_Code.X86.Insns;
+
diff --git a/src/ortho/mcode/ortho_code-x86.adb b/src/ortho/mcode/ortho_code-x86.adb
new file mode 100644
index 000000000..175dd7e99
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86.adb
@@ -0,0 +1,109 @@
+--  Mcode back-end for ortho - X86 common definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Ortho_Code.X86 is
+   function Inverse_Cc (R : O_Reg) return O_Reg is
+   begin
+      case R is
+         when R_Ult =>
+            return R_Uge;
+         when R_Uge =>
+            return R_Ult;
+         when R_Eq =>
+            return R_Ne;
+         when R_Ne =>
+            return R_Eq;
+         when R_Ule =>
+            return R_Ugt;
+         when R_Ugt =>
+            return R_Ule;
+         when R_Slt =>
+            return R_Sge;
+         when R_Sge =>
+            return R_Slt;
+         when R_Sle =>
+            return R_Sgt;
+         when R_Sgt =>
+            return R_Sle;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Inverse_Cc;
+
+   function Get_R64_High (Reg : Regs_R64) return Regs_R32 is
+   begin
+      case Reg is
+         when R_Edx_Eax =>
+            return R_Dx;
+         when R_Ebx_Ecx =>
+            return R_Bx;
+         when R_Esi_Edi =>
+            return R_Si;
+      end case;
+   end Get_R64_High;
+
+   function Get_R64_Low (Reg : Regs_R64) return Regs_R32 is
+   begin
+      case Reg is
+         when R_Edx_Eax =>
+            return R_Ax;
+         when R_Ebx_Ecx =>
+            return R_Cx;
+         when R_Esi_Edi =>
+            return R_Di;
+      end case;
+   end Get_R64_Low;
+
+   function Ekind_Unsigned_To_Cc (Kind : OE_Kind_Cmp) return O_Reg is
+   begin
+      case Kind is
+         when OE_Eq =>
+            return R_Eq;
+         when OE_Neq =>
+            return R_Ne;
+         when OE_Lt =>
+            return R_Ult;
+         when OE_Le =>
+            return R_Ule;
+         when OE_Gt =>
+            return R_Ugt;
+         when OE_Ge =>
+            return R_Uge;
+      end case;
+   end Ekind_Unsigned_To_Cc;
+
+   function Ekind_Signed_To_Cc (Kind : OE_Kind_Cmp) return O_Reg is
+   begin
+      case Kind is
+         when OE_Eq =>
+            return R_Eq;
+         when OE_Neq =>
+            return R_Ne;
+         when OE_Lt =>
+            return R_Slt;
+         when OE_Le =>
+            return R_Sle;
+         when OE_Gt =>
+            return R_Sgt;
+         when OE_Ge =>
+            return R_Sge;
+      end case;
+   end Ekind_Signed_To_Cc;
+
+end Ortho_Code.X86;
+
+
diff --git a/src/ortho/mcode/ortho_code-x86.ads b/src/ortho/mcode/ortho_code-x86.ads
new file mode 100644
index 000000000..24be1eb6c
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86.ads
@@ -0,0 +1,160 @@
+--  Mcode back-end for ortho - X86 common definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+package Ortho_Code.X86 is
+   --  Registers.
+   R_Nil : constant O_Reg := 0;
+
+   --  Not a value.  Used for statements.
+   R_None : constant O_Reg := 1;
+
+   --  Memory.
+   R_Mem : constant O_Reg := 2;
+
+   --  Spilled out.
+   R_Spill : constant O_Reg := 3;
+
+   --  Register or memory.
+   --  THis can only be requested.
+   R_Rm : constant O_Reg := 48;
+
+   --  Immediat
+   R_Imm : constant O_Reg := 49;
+
+   --  Immediat, register or memory.
+   --  This can be requested.
+   R_Irm : constant O_Reg := 50;
+
+   --  Immediat or register.
+   --  This can be requested.
+   R_Ir : constant O_Reg := 51;
+
+   --  BASE + OFFSET
+   R_B_Off : constant O_Reg := 52;
+
+   --  BASE+INDEX*SCALE+OFFSET
+   --  This can be requested.
+   R_Sib : constant O_Reg := 53;
+
+   --  INDEX*SCALE + OFFSET
+   --  This can be requested.
+   R_I_Off : constant O_Reg := 54;
+
+   --  BASE + INDEX*SCALE
+   R_B_I : constant O_Reg := 55;
+
+   --  INDEX*SCALE
+   R_I : constant O_Reg := 56;
+
+   subtype Regs_Imm32 is O_Reg range R_Irm .. R_I_Off;
+
+   R_Any8 : constant O_Reg := 6;
+   R_Any32 : constant O_Reg := 7;
+   R_Ax : constant O_Reg := 8;
+   R_Cx : constant O_Reg := 9;
+   R_Dx : constant O_Reg := 10;
+   R_Bx : constant O_Reg := 11;
+   R_Sp : constant O_Reg := 12;
+   R_Bp : constant O_Reg := 13;
+   R_Si : constant O_Reg := 14;
+   R_Di : constant O_Reg := 15;
+
+   subtype Regs_R8 is O_Reg range R_Ax .. R_Bx;
+   subtype Regs_R32 is O_Reg range R_Ax .. R_Di;
+
+   R_St0 : constant O_Reg := 16;
+   R_St1 : constant O_Reg := 17;
+   R_St2 : constant O_Reg := 18;
+   R_St3 : constant O_Reg := 19;
+   R_St4 : constant O_Reg := 20;
+   R_St5 : constant O_Reg := 21;
+   R_St6 : constant O_Reg := 22;
+   R_St7 : constant O_Reg := 23;
+   --R_Any_Fp : constant O_Reg := 24;
+
+   subtype Regs_Fp is O_Reg range R_St0 .. R_St7;
+
+   --  Any condition register.
+   R_Any_Cc : constant O_Reg := 32;
+   R_Ov : constant O_Reg := 32;
+   R_Ult : constant O_Reg := 34;
+   R_Uge : constant O_Reg := 35;
+   R_Eq : constant O_Reg := 36;
+   R_Ne : constant O_Reg := 37;
+   R_Ule : constant O_Reg := 38;
+   R_Ugt : constant O_Reg := 39;
+   R_Slt : constant O_Reg := 44;
+   R_Sge : constant O_Reg := 45;
+   R_Sle : constant O_Reg := 46;
+   R_Sgt : constant O_Reg := 47;
+
+   subtype Regs_Cc is O_Reg range R_Ov .. R_Sgt;
+
+   R_Edx_Eax : constant O_Reg := 64;
+   R_Ebx_Ecx : constant O_Reg := 65;
+   R_Esi_Edi : constant O_Reg := 66;
+   R_Any64 : constant O_Reg := 67;
+
+   subtype Regs_R64 is O_Reg range R_Edx_Eax .. R_Esi_Edi;
+
+   R_Any_Xmm : constant O_Reg := 79;
+
+   R_Xmm0  : constant O_Reg := 80;
+   R_Xmm1  : constant O_Reg := R_Xmm0 + 1;
+   R_Xmm2  : constant O_Reg := R_Xmm0 + 2;
+   R_Xmm3  : constant O_Reg := R_Xmm0 + 3;
+   R_Xmm4  : constant O_Reg := R_Xmm0 + 4;
+   R_Xmm5  : constant O_Reg := R_Xmm0 + 5;
+   R_Xmm6  : constant O_Reg := R_Xmm0 + 6;
+   R_Xmm7  : constant O_Reg := R_Xmm0 + 7;
+   R_Xmm8  : constant O_Reg := R_Xmm0 + 8;
+   R_Xmm9  : constant O_Reg := R_Xmm0 + 9;
+   R_Xmm10 : constant O_Reg := R_Xmm0 + 10;
+   R_Xmm11 : constant O_Reg := R_Xmm0 + 11;
+   R_Xmm12 : constant O_Reg := R_Xmm0 + 12;
+   R_Xmm13 : constant O_Reg := R_Xmm0 + 13;
+   R_Xmm14 : constant O_Reg := R_Xmm0 + 14;
+   R_Xmm15 : constant O_Reg := R_Xmm0 + 15;
+
+   subtype Regs_X86_64_Xmm is O_Reg range R_Xmm0 .. R_Xmm15;
+   subtype Regs_X86_Xmm is O_Reg range R_Xmm0 .. R_Xmm7;
+   subtype Regs_Xmm is O_Reg range R_Xmm0 .. R_Xmm15;
+
+   function Get_R64_High (Reg : Regs_R64) return Regs_R32;
+   function Get_R64_Low (Reg : Regs_R64) return Regs_R32;
+
+   function Inverse_Cc (R : O_Reg) return O_Reg;
+
+   --  Intrinsic subprograms.
+   Intrinsic_Mul_Ov_U64 : constant Int32 := 1;
+   Intrinsic_Div_Ov_U64 : constant Int32 := 2;
+   Intrinsic_Mod_Ov_U64 : constant Int32 := 3;
+   Intrinsic_Mul_Ov_I64 : constant Int32 := 4;
+   Intrinsic_Div_Ov_I64 : constant Int32 := 5;
+   Intrinsic_Mod_Ov_I64 : constant Int32 := 6;
+   Intrinsic_Rem_Ov_I64 : constant Int32 := 7;
+
+   subtype Intrinsics_X86 is Int32
+     range Intrinsic_Mul_Ov_U64 .. Intrinsic_Rem_Ov_I64;
+
+   --  Convert a KIND to a reg.
+   function Ekind_Unsigned_To_Cc (Kind : OE_Kind_Cmp) return O_Reg;
+   function Ekind_Signed_To_Cc (Kind : OE_Kind_Cmp) return O_Reg;
+
+end Ortho_Code.X86;
diff --git a/src/ortho/mcode/ortho_code.ads b/src/ortho/mcode/ortho_code.ads
new file mode 100644
index 000000000..0657b07e6
--- /dev/null
+++ b/src/ortho/mcode/ortho_code.ads
@@ -0,0 +1,150 @@
+--  Mcode back-end for ortho - common definitions.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+
+package Ortho_Code is
+   type Int32 is range -(2 ** 31) .. (2 ** 31) - 1;
+
+   type Uns32 is mod 2 ** 32;
+
+   type Uns64 is mod 2 ** 64;
+
+   function Shift_Right (L : Uns64; R : Natural) return Uns64;
+   function Shift_Right (L : Uns32; R : Natural) return Uns32;
+   pragma Import (Intrinsic, Shift_Right);
+
+   function Shift_Right_Arithmetic (L : Uns32; R : Natural) return Uns32;
+   pragma Import (Intrinsic, Shift_Right_Arithmetic);
+
+   function Shift_Left (L : Uns32; R : Natural) return Uns32;
+   pragma Import (Intrinsic, Shift_Left);
+
+   type O_Tnode is new Int32;
+   for O_Tnode'Size use 32;
+   O_Tnode_Null : constant O_Tnode := 0;
+   O_Tnode_First : constant O_Tnode := 2;
+
+   --  A generic pointer.
+   --  This is used by static chains.
+   O_Tnode_Ptr : constant O_Tnode := 2;
+
+   type O_Cnode is new Int32;
+   for O_Cnode'Size use 32;
+   O_Cnode_Null : constant O_Cnode := 0;
+
+   type O_Dnode is new Int32;
+   for O_Dnode'Size use 32;
+   O_Dnode_Null : constant O_Dnode := 0;
+   O_Dnode_First : constant O_Dnode := 2;
+
+   type O_Enode is new Int32;
+   for O_Enode'Size use 32;
+   O_Enode_Null : constant O_Enode := 0;
+   O_Enode_Err : constant O_Enode := 1;
+
+   type O_Fnode is new Int32;
+   for O_Fnode'Size use 32;
+   O_Fnode_Null : constant O_Fnode := 0;
+
+   type O_Lnode is new Int32;
+   for O_Lnode'Size use 32;
+   O_Lnode_Null : constant O_Lnode := 0;
+
+   type O_Ident is new Int32;
+   O_Ident_Nul : constant O_Ident := 0;
+
+   function To_Int32 is new Ada.Unchecked_Conversion
+     (Source => Uns32, Target => Int32);
+
+   function To_Uns32 is new Ada.Unchecked_Conversion
+     (Source => Int32, Target => Uns32);
+
+
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+
+   --  Depth of a declaration.
+   --    0 for top-level,
+   --    1 for declared in a top-level subprogram
+   type O_Depth is range 0 .. (2 ** 16) - 1;
+   O_Toplevel : constant O_Depth := 0;
+
+   --  BE representation of a register.
+   type O_Reg is mod 256;
+   R_Nil : constant O_Reg := 0;
+
+   type Mode_Type is (Mode_U8, Mode_U16, Mode_U32, Mode_U64,
+                      Mode_I8, Mode_I16, Mode_I32, Mode_I64,
+                      Mode_X1, Mode_Nil, Mode_F32, Mode_F64,
+                      Mode_B2, Mode_Blk, Mode_P32, Mode_P64);
+
+   subtype Mode_Uns is Mode_Type range Mode_U8 .. Mode_U64;
+   subtype Mode_Int is Mode_Type range Mode_I8 .. Mode_I64;
+   subtype Mode_Fp is Mode_Type range Mode_F32 .. Mode_F64;
+   -- Mode_Ptr : constant Mode_Type := Mode_P32;
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   Syntax_Error : exception;
+end Ortho_Code;
diff --git a/src/ortho/mcode/ortho_code_main.adb b/src/ortho/mcode/ortho_code_main.adb
new file mode 100644
index 000000000..a0e6dc6c6
--- /dev/null
+++ b/src/ortho/mcode/ortho_code_main.adb
@@ -0,0 +1,198 @@
+--  Mcode back-end for ortho - Main subprogram.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Unchecked_Deallocation;
+with Ada.Text_IO; use Ada.Text_IO;
+with Binary_File; use Binary_File;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ortho_Code.Debug;
+with Ortho_Mcode; use Ortho_Mcode;
+with Ortho_Front; use Ortho_Front;
+with Ortho_Code.Flags; use Ortho_Code.Flags;
+with Binary_File.Elf;
+with Binary_File.Coff;
+with Binary_File.Memory;
+
+procedure Ortho_Code_Main
+is
+   Output : String_Acc := null;
+   type Format_Type is (Format_Coff, Format_Elf);
+   Format : constant Format_Type := Format_Elf;
+   Fd : File_Descriptor;
+
+   First_File : Natural;
+   Opt : String_Acc;
+   Opt_Arg : String_Acc;
+   Filename : String_Acc;
+   Exec_Func : String_Acc;
+   Res : Natural;
+   I : Natural;
+   Argc : Natural;
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => String_Acc, Object => String);
+begin
+   First_File := Natural'Last;
+   Exec_Func := null;
+
+   Ortho_Front.Init;
+
+   Argc := Argument_Count;
+   I := 1;
+   while I <= Argc loop
+      declare
+         Arg : constant String := Argument (I);
+      begin
+         if Arg (1) = '-' then
+            if Arg'Length > 5 and then Arg (1 .. 5) = "--be-" then
+               Ortho_Code.Debug.Set_Be_Flag (Arg);
+               I := I + 1;
+            elsif Arg = "-o" then
+               if I = Argc then
+                  Put_Line (Standard_Error, "error: missing filename to '-o'");
+                  return;
+               end if;
+               Output := new String'(Argument (I + 1));
+               I := I + 2;
+            elsif Arg = "-quiet" then
+               --  Skip silently.
+               I := I + 1;
+            elsif Arg = "--exec" then
+               if I = Argc then
+                  Put_Line (Standard_Error,
+                            "error: missing function name to '--exec'");
+                  return;
+               end if;
+               Exec_Func := new String'(Argument (I + 1));
+               I := I + 2;
+            elsif Arg = "-g" then
+               Flag_Debug := Debug_Dwarf;
+               I := I + 1;
+            elsif Arg = "-p" or Arg = "-pg" then
+               Flag_Profile := True;
+               I := I + 1;
+            else
+               --  This is really an argument.
+               Opt := new String'(Arg);
+               if I < Argument_Count then
+                  Opt_Arg := new String'(Argument (I + 1));
+               else
+                  Opt_Arg := null;
+               end if;
+               Res := Ortho_Front.Decode_Option (Opt, Opt_Arg);
+               case Res is
+                  when 0 =>
+                     Put_Line (Standard_Error, "unknown option '" & Arg & "'");
+                     return;
+                  when 1 =>
+                     I := I + 1;
+                  when 2 =>
+                     I := I + 2;
+                  when others =>
+                     raise Program_Error;
+               end case;
+               Unchecked_Deallocation (Opt);
+               Unchecked_Deallocation (Opt_Arg);
+            end if;
+         else
+            First_File := I;
+            exit;
+         end if;
+      end;
+   end loop;
+
+   Ortho_Mcode.Init;
+
+   Set_Exit_Status (Failure);
+
+   if First_File > Argument_Count then
+      begin
+         if not Parse (null) then
+            return;
+         end if;
+      exception
+         when others =>
+            return;
+      end;
+   else
+      for I in First_File .. Argument_Count loop
+         Filename := new String'(Argument (First_File));
+         begin
+            if not Parse (Filename) then
+               return;
+            end if;
+         exception
+            when others =>
+               return;
+         end;
+      end loop;
+   end if;
+
+   Ortho_Mcode.Finish;
+
+   if Ortho_Code.Debug.Flag_Debug_Hli then
+      Set_Exit_Status (Success);
+      return;
+   end if;
+
+   if Output /= null then
+      Fd := Create_File (Output.all, Binary);
+      if Fd /= Invalid_FD then
+         case Format is
+            when Format_Elf =>
+               Binary_File.Elf.Write_Elf (Fd);
+            when Format_Coff =>
+               Binary_File.Coff.Write_Coff (Fd);
+         end case;
+         Close (Fd);
+      end if;
+   elsif Exec_Func /= null then
+      declare
+         Sym : Symbol;
+
+         type Func_Acc is access function return Integer;
+         function Conv is new Ada.Unchecked_Conversion
+           (Source => Pc_Type, Target => Func_Acc);
+         F : Func_Acc;
+         V : Integer;
+         Err : Boolean;
+      begin
+         Binary_File.Memory.Write_Memory_Init;
+         Binary_File.Memory.Write_Memory_Relocate (Err);
+         if Err then
+            return;
+         end if;
+         Sym := Binary_File.Get_Symbol (Exec_Func.all);
+         if Sym = Null_Symbol then
+            Put_Line (Standard_Error, "no '" & Exec_Func.all & "' symbol");
+         else
+            F := Conv (Get_Symbol_Vaddr (Sym));
+            V := F.all;
+            Put_Line ("Result is " & Integer'Image (V));
+         end if;
+      end;
+   end if;
+
+   Set_Exit_Status (Success);
+exception
+   when others =>
+      Set_Exit_Status (2);
+      raise;
+end Ortho_Code_Main;
+
+
diff --git a/src/ortho/mcode/ortho_ident.adb b/src/ortho/mcode/ortho_ident.adb
new file mode 100644
index 000000000..0893b75dd
--- /dev/null
+++ b/src/ortho/mcode/ortho_ident.adb
@@ -0,0 +1,117 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO;
+with GNAT.Table;
+
+package body Ortho_Ident is
+   package Ids is new GNAT.Table
+     (Table_Component_Type => Natural,
+      Table_Index_Type => O_Ident,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   package Strs is new GNAT.Table
+     (Table_Component_Type => Character,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Start : Natural;
+   begin
+      Start := Strs.Allocate (Str'Length + 1);
+      for I in Str'Range loop
+         Strs.Table (Start + I - Str'First) := Str (I);
+      end loop;
+      Strs.Table (Start + Str'Length) := ASCII.Nul;
+      Ids.Append (Start);
+      return Ids.Last;
+   end Get_Identifier;
+
+   function Is_Equal (L, R : O_Ident) return Boolean
+   is
+   begin
+      return L = R;
+   end Is_Equal;
+
+   function Get_String_Length (Id : O_Ident) return Natural
+   is
+      Start : Natural;
+   begin
+      Start := Ids.Table (Id);
+      if Id = Ids.Last then
+         return Strs.Last - Start + 1 - 1;
+      else
+         return Ids.Table (Id + 1) - 1 - Start;
+      end if;
+   end Get_String_Length;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      Res : String (1 .. Get_String_Length (Id));
+      Start : constant Natural := Ids.Table (Id);
+   begin
+      for I in Res'Range loop
+         Res (I) := Strs.Table (Start + I - Res'First);
+      end loop;
+      return Res;
+   end Get_String;
+
+   function Get_Cstring (Id : O_Ident) return System.Address is
+   begin
+      return Strs.Table (Ids.Table (Id))'Address;
+   end Get_Cstring;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean
+   is
+      Start : constant Natural := Ids.Table (Id);
+      Len : constant Natural := Get_String_Length (Id);
+   begin
+      if Len /= Str'Length then
+         return False;
+      end if;
+      for I in Str'Range loop
+         if Str (I) /= Strs.Table (Start + I - Str'First) then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Is_Equal;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = O_Ident_Nul;
+   end Is_Nul;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Ident: " & O_Ident'Image (Ids.Last));
+      Put_Line ("Number of Ident-Strs: " & Natural'Image (Strs.Last));
+   end Disp_Stats;
+
+   procedure Finish is
+   begin
+      Ids.Free;
+      Strs.Free;
+   end Finish;
+end Ortho_Ident;
diff --git a/src/ortho/mcode/ortho_ident.ads b/src/ortho/mcode/ortho_ident.ads
new file mode 100644
index 000000000..cdc42fcad
--- /dev/null
+++ b/src/ortho/mcode/ortho_ident.ads
@@ -0,0 +1,38 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System;
+with Ortho_Code; use Ortho_Code;
+
+package Ortho_Ident is
+   subtype O_Ident is Ortho_Code.O_Ident;
+
+   function Get_Identifier (Str : String) return O_Ident;
+   function Is_Equal (L, R : O_Ident) return Boolean;
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   function Is_Nul (Id : O_Ident) return Boolean;
+   function Get_String (Id : O_Ident) return String;
+   function Get_String_Length (Id : O_Ident) return Natural;
+
+   --  Note: the address is valid until the next call to get_identifier.
+   function Get_Cstring (Id : O_Ident) return System.Address;
+
+   O_Ident_Nul : constant O_Ident := Ortho_Code.O_Ident_Nul;
+
+   procedure Disp_Stats;
+   procedure Finish;
+end Ortho_Ident;
diff --git a/src/ortho/mcode/ortho_jit.adb b/src/ortho/mcode/ortho_jit.adb
new file mode 100644
index 000000000..7aa9724f2
--- /dev/null
+++ b/src/ortho/mcode/ortho_jit.adb
@@ -0,0 +1,125 @@
+--  Ortho JIT implementation for mcode.
+--  Copyright (C) 2009 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ada.Text_IO;
+
+with Binary_File; use Binary_File;
+with Binary_File.Memory;
+with Ortho_Mcode; use Ortho_Mcode;
+with Ortho_Mcode.Jit;
+with Ortho_Code.Flags; use Ortho_Code.Flags;
+with Ortho_Code.Debug;
+with Ortho_Code.Abi;
+with Binary_File.Elf;
+
+package body Ortho_Jit is
+   Snap_Filename : GNAT.OS_Lib.String_Access := null;
+
+   --  Initialize the whole engine.
+   procedure Init is
+   begin
+      Ortho_Mcode.Init;
+      Binary_File.Memory.Write_Memory_Init;
+   end Init;
+
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address)
+     renames Ortho_Mcode.Jit.Set_Address;
+
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address
+     renames Ortho_Mcode.Jit.Get_Address;
+
+   --  Do link.
+   procedure Link (Status : out Boolean) is
+   begin
+      if Ortho_Code.Debug.Flag_Debug_Hli then
+         --  Can't generate code in HLI.
+         Status := True;
+         return;
+      end if;
+
+      Ortho_Mcode.Finish;
+
+      Ortho_Code.Abi.Link_Intrinsics;
+
+      Binary_File.Memory.Write_Memory_Relocate (Status);
+      if Status then
+         return;
+      end if;
+
+      if Snap_Filename /= null then
+         declare
+            use Ada.Text_IO;
+            Fd : File_Descriptor;
+         begin
+            Fd := Create_File (Snap_Filename.all, Binary);
+            if Fd = Invalid_FD then
+               Put_Line (Standard_Error,
+                         "can't open '" & Snap_Filename.all & "'");
+               Status := False;
+               return;
+            else
+               Binary_File.Elf.Write_Elf (Fd);
+               Close (Fd);
+            end if;
+         end;
+      end if;
+   end Link;
+
+   procedure Finish is
+   begin
+      --  Free all the memory.
+      Ortho_Mcode.Free_All;
+
+      Binary_File.Finish;
+   end Finish;
+
+   function Decode_Option (Option : String) return Boolean
+   is
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      if Opt = "-g" then
+         Flag_Debug := Debug_Dwarf;
+         return True;
+      elsif Opt'Length > 5 and then Opt (1 .. 5) = "--be-" then
+         Ortho_Code.Debug.Set_Be_Flag (Opt);
+         return True;
+      elsif Opt'Length > 7 and then Opt (1 .. 7) = "--snap=" then
+         Snap_Filename := new String'(Opt (8 .. Opt'Last));
+         return True;
+      else
+         return False;
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Help is
+      use Ada.Text_IO;
+   begin
+      Put_Line (" -g             Generate debugging informations");
+      Put_Line (" --debug-be=X   Set X internal debugging flags");
+      Put_Line (" --snap=FILE    Write memory snapshot to FILE");
+   end Disp_Help;
+
+   function Get_Jit_Name return String is
+   begin
+      return "mcode";
+   end Get_Jit_Name;
+
+end Ortho_Jit;
diff --git a/src/ortho/mcode/ortho_mcode-jit.adb b/src/ortho/mcode/ortho_mcode-jit.adb
new file mode 100644
index 000000000..7e845cc6e
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode-jit.adb
@@ -0,0 +1,28 @@
+with Ada.Unchecked_Conversion;
+
+with Ortho_Code.Binary;
+with Binary_File; use Binary_File;
+with Binary_File.Memory;
+
+package body Ortho_Mcode.Jit is
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address)
+   is
+      use Ortho_Code.Binary;
+   begin
+      Binary_File.Memory.Set_Symbol_Address
+        (Get_Decl_Symbol (Ortho_Code.O_Dnode (Decl)), Addr);
+   end Set_Address;
+
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address
+   is
+      use Ortho_Code.Binary;
+
+      function Conv is new Ada.Unchecked_Conversion
+        (Source => Pc_Type, Target => Address);
+   begin
+      return Conv (Get_Symbol_Vaddr
+                     (Get_Decl_Symbol (Ortho_Code.O_Dnode (Decl))));
+   end Get_Address;
+end Ortho_Mcode.Jit;
diff --git a/src/ortho/mcode/ortho_mcode-jit.ads b/src/ortho/mcode/ortho_mcode-jit.ads
new file mode 100644
index 000000000..c689a1e12
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode-jit.ads
@@ -0,0 +1,9 @@
+with System; use System;
+
+package Ortho_Mcode.Jit is
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address);
+
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address;
+end Ortho_Mcode.Jit;
diff --git a/src/ortho/mcode/ortho_mcode.adb b/src/ortho/mcode/ortho_mcode.adb
new file mode 100644
index 000000000..55e890bf3
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode.adb
@@ -0,0 +1,738 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO;
+with Ortho_Code.Debug;
+with Ortho_Ident;
+with Ortho_Code.Abi;
+-- with Binary_File;
+
+package body Ortho_Mcode is
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   procedure Start_Const_Value (Const : in out O_Dnode)
+   is
+      pragma Unreferenced (Const);
+   begin
+      null;
+   end Start_Const_Value;
+
+   procedure Start_Record_Type (Elements : out O_Element_List) is
+   begin
+      Ortho_Code.Types.Start_Record_Type
+        (Ortho_Code.Types.O_Element_List (Elements));
+   end Start_Record_Type;
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode) is
+   begin
+      Ortho_Code.Types.New_Record_Field
+        (Ortho_Code.Types.O_Element_List (Elements),
+         Ortho_Code.O_Fnode (El), Ident, Ortho_Code.O_Tnode (Etype));
+   end New_Record_Field;
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Ortho_Code.Types.Finish_Record_Type
+        (Ortho_Code.Types.O_Element_List (Elements),
+         Ortho_Code.O_Tnode (Res));
+   end Finish_Record_Type;
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      Ortho_Code.Types.New_Uncomplete_Record_Type (Ortho_Code.O_Tnode (Res));
+   end New_Uncomplete_Record_Type;
+
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List) is
+   begin
+      Ortho_Code.Types.Start_Uncomplete_Record_Type
+        (Ortho_Code.O_Tnode (Res),
+         Ortho_Code.Types.O_Element_List (Elements));
+   end Start_Uncomplete_Record_Type;
+
+   procedure Start_Union_Type (Elements : out O_Element_List) is
+   begin
+      Ortho_Code.Types.Start_Union_Type
+        (Ortho_Code.Types.O_Element_List (Elements));
+   end Start_Union_Type;
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode) is
+   begin
+      Ortho_Code.Types.New_Union_Field
+        (Ortho_Code.Types.O_Element_List (Elements),
+         Ortho_Code.O_Fnode (El),
+         Ident,
+         Ortho_Code.O_Tnode (Etype));
+   end New_Union_Field;
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Ortho_Code.Types.Finish_Union_Type
+        (Ortho_Code.Types.O_Element_List (Elements),
+         Ortho_Code.O_Tnode (Res));
+   end Finish_Union_Type;
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode is
+   begin
+      return O_Tnode
+        (Ortho_Code.Types.New_Access_Type (Ortho_Code.O_Tnode (Dtype)));
+   end New_Access_Type;
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) is
+   begin
+      Ortho_Code.Types.Finish_Access_Type (Ortho_Code.O_Tnode (Atype),
+                                           Ortho_Code.O_Tnode (Dtype));
+   end Finish_Access_Type;
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
+   is
+      pragma Warnings (Off, Const);
+   begin
+      New_Const_Value (Ortho_Code.O_Dnode (Const), Ortho_Code.O_Cnode (Val));
+   end Finish_Const_Value;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+                           return O_Tnode is
+   begin
+      return O_Tnode
+        (Ortho_Code.Types.New_Array_Type (Ortho_Code.O_Tnode (El_Type),
+                                          Ortho_Code.O_Tnode (Index_Type)));
+   end New_Array_Type;
+
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+                                       return O_Tnode
+   is
+      Len : constant Ortho_Code.O_Cnode := Ortho_Code.O_Cnode (Length);
+      L_Type : Ortho_Code.O_Tnode;
+   begin
+      L_Type := Get_Const_Type (Len);
+      if Get_Type_Kind (L_Type) /= OT_Unsigned then
+         raise Syntax_Error;
+      end if;
+      return O_Tnode (New_Constrained_Array_Type
+                        (Ortho_Code.O_Tnode (Atype), Get_Const_U32 (Len)));
+   end New_Constrained_Array_Type;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode is
+   begin
+      return O_Tnode (Ortho_Code.Types.New_Unsigned_Type (Size));
+   end New_Unsigned_Type;
+
+   function New_Signed_Type (Size : Natural) return O_Tnode is
+   begin
+      return O_Tnode (Ortho_Code.Types.New_Signed_Type (Size));
+   end New_Signed_Type;
+
+   function New_Float_Type return O_Tnode is
+   begin
+      return O_Tnode (Ortho_Code.Types.New_Float_Type);
+   end New_Float_Type;
+
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode) is
+   begin
+      Ortho_Code.Types.New_Boolean_Type (Ortho_Code.O_Tnode (Res),
+                                         False_Id,
+                                         Ortho_Code.O_Cnode (False_E),
+                                         True_Id,
+                                         Ortho_Code.O_Cnode (True_E));
+   end New_Boolean_Type;
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural) is
+   begin
+      Ortho_Code.Types.Start_Enum_Type (Ortho_Code.Types.O_Enum_List (List),
+                                        Size);
+   end Start_Enum_Type;
+
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode) is
+   begin
+      Ortho_Code.Types.New_Enum_Literal (Ortho_Code.Types.O_Enum_List (List),
+                                         Ident, Ortho_Code.O_Cnode (Res));
+   end New_Enum_Literal;
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Ortho_Code.Types.Finish_Enum_Type (Ortho_Code.Types.O_Enum_List (List),
+                                         Ortho_Code.O_Tnode (Res));
+   end Finish_Enum_Type;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   To_Op : constant array (ON_Op_Kind) of Ortho_Code.ON_Op_Kind :=
+     (
+      ON_Nil => ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov => ON_Add_Ov,
+      ON_Sub_Ov => ON_Sub_Ov,
+      ON_Mul_Ov => ON_Mul_Ov,
+      ON_Div_Ov => ON_Div_Ov,
+      ON_Rem_Ov => ON_Rem_Ov,
+      ON_Mod_Ov => ON_Mod_Ov,
+
+      --  Binary operations.
+      ON_And => ON_And,
+      ON_Or => ON_Or,
+      ON_Xor => ON_Xor,
+
+      --  Monadic operations.
+      ON_Not => ON_Not,
+      ON_Neg_Ov => ON_Neg_Ov,
+      ON_Abs_Ov => ON_Abs_Ov,
+
+      --  Comparaisons
+      ON_Eq => ON_Eq,
+      ON_Neq => ON_Neq,
+      ON_Le => ON_Le,
+      ON_Lt => ON_Lt,
+      ON_Ge => ON_Ge,
+      ON_Gt => ON_Gt
+     );
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Signed_Literal (Ortho_Code.O_Tnode (Ltype),
+                                               Value));
+   end New_Signed_Literal;
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Unsigned_Literal (Ortho_Code.O_Tnode (Ltype),
+                                                 Value));
+   end New_Unsigned_Literal;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Float_Literal (Ortho_Code.O_Tnode (Ltype),
+                                              Value));
+   end New_Float_Literal;
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Null_Access (Ortho_Code.O_Tnode (Ltype)));
+   end New_Null_Access;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode) is
+   begin
+      Ortho_Code.Consts.Start_Record_Aggr
+        (Ortho_Code.Consts.O_Record_Aggr_List (List),
+         Ortho_Code.O_Tnode (Atype));
+   end Start_Record_Aggr;
+
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode) is
+   begin
+      Ortho_Code.Consts.New_Record_Aggr_El
+        (Ortho_Code.Consts.O_Record_Aggr_List (List),
+         Ortho_Code.O_Cnode (Value));
+   end New_Record_Aggr_El;
+
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode) is
+   begin
+      Ortho_Code.Consts.Finish_Record_Aggr
+        (Ortho_Code.Consts.O_Record_Aggr_List (List),
+         Ortho_Code.O_Cnode (Res));
+   end Finish_Record_Aggr;
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode)
+   is
+   begin
+      Ortho_Code.Consts.Start_Array_Aggr
+        (Ortho_Code.Consts.O_Array_Aggr_List (List),
+         Ortho_Code.O_Tnode (Atype));
+   end Start_Array_Aggr;
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode) is
+   begin
+      Ortho_Code.Consts.New_Array_Aggr_El
+        (Ortho_Code.Consts.O_Array_Aggr_List (List),
+         Ortho_Code.O_Cnode (Value));
+   end New_Array_Aggr_El;
+
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode) is
+   begin
+      Ortho_Code.Consts.Finish_Array_Aggr
+        (Ortho_Code.Consts.O_Array_Aggr_List (List),
+         Ortho_Code.O_Cnode (Res));
+   end Finish_Array_Aggr;
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Union_Aggr (Ortho_Code.O_Tnode (Atype),
+                                           Ortho_Code.O_Fnode (Field),
+                                           Ortho_Code.O_Cnode (Value)));
+   end New_Union_Aggr;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Sizeof (Ortho_Code.O_Tnode (Atype),
+                                       Ortho_Code.O_Tnode (Rtype)));
+   end New_Sizeof;
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Alignof (Ortho_Code.O_Tnode (Atype),
+                                        Ortho_Code.O_Tnode (Rtype)));
+   end New_Alignof;
+
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Offsetof (Ortho_Code.O_Tnode (Atype),
+                                         Ortho_Code.O_Fnode (Field),
+                                         Ortho_Code.O_Tnode (Rtype)));
+   end New_Offsetof;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Subprogram_Address
+           (Ortho_Code.O_Dnode (Subprg), Ortho_Code.O_Tnode (Atype)));
+   end New_Subprogram_Address;
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Global_Address
+           (Ortho_Code.O_Dnode (Decl), Ortho_Code.O_Tnode (Atype)));
+   end New_Global_Address;
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Global_Unchecked_Address
+           (Ortho_Code.O_Dnode (Decl), Ortho_Code.O_Tnode (Atype)));
+   end New_Global_Unchecked_Address;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode (Ortho_Code.Exprs.New_Lit (Ortho_Code.O_Cnode (Lit)));
+   end New_Lit;
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+                          return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Dyadic_Op (To_Op (Kind),
+                                         Ortho_Code.O_Enode (Left),
+                                         Ortho_Code.O_Enode (Right)));
+   end New_Dyadic_Op;
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+                           return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Monadic_Op (To_Op (Kind),
+                                          Ortho_Code.O_Enode (Operand)));
+   end New_Monadic_Op;
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Compare_Op (To_Op (Kind),
+                                          Ortho_Code.O_Enode (Left),
+                                          Ortho_Code.O_Enode (Right),
+                                          Ortho_Code.O_Tnode (Ntype)));
+   end New_Compare_Op;
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+                                return O_Lnode is
+   begin
+      return O_Lnode
+        (Ortho_Code.Exprs.New_Indexed_Element (Ortho_Code.O_Lnode (Arr),
+                                               Ortho_Code.O_Enode (Index)));
+   end New_Indexed_Element;
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+                      return O_Lnode is
+   begin
+      return O_Lnode
+        (Ortho_Code.Exprs.New_Slice (Ortho_Code.O_Lnode (Arr),
+                                     Ortho_Code.O_Tnode (Res_Type),
+                                     Ortho_Code.O_Enode (Index)));
+   end New_Slice;
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+                                 return O_Lnode is
+   begin
+      return O_Lnode
+        (Ortho_Code.Exprs.New_Selected_Element (Ortho_Code.O_Lnode (Rec),
+                                                Ortho_Code.O_Fnode (El)));
+   end New_Selected_Element;
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode is
+   begin
+      return O_Lnode
+        (Ortho_Code.Exprs.New_Access_Element (Ortho_Code.O_Enode (Acc)));
+   end New_Access_Element;
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Convert_Ov (Ortho_Code.O_Enode (Val),
+                                          Ortho_Code.O_Tnode (Rtype)));
+   end New_Convert_Ov;
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+                        return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Address (Ortho_Code.O_Lnode (Lvalue),
+                                       Ortho_Code.O_Tnode (Atype)));
+   end New_Address;
+
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+                                  return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Unchecked_Address (Ortho_Code.O_Lnode (Lvalue),
+                                                 Ortho_Code.O_Tnode (Atype)));
+   end New_Unchecked_Address;
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Value (Ortho_Code.O_Lnode (Lvalue)));
+   end New_Value;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return New_Value (New_Obj (Obj));
+   end New_Obj_Value;
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode is
+   begin
+      return O_Enode (Ortho_Code.Exprs.New_Alloca (Ortho_Code.O_Tnode (Rtype),
+                                                   Ortho_Code.O_Enode (Size)));
+   end New_Alloca;
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   procedure New_Debug_Filename_Decl (Filename : String)
+     renames Ortho_Code.Abi.New_Debug_Filename_Decl;
+
+   procedure New_Debug_Line_Decl (Line : Natural)
+   is
+      pragma Unreferenced (Line);
+   begin
+      null;
+   end New_Debug_Line_Decl;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.New_Type_Decl (Ident, Ortho_Code.O_Tnode (Atype));
+   end New_Type_Decl;
+
+   To_Storage : constant array (O_Storage) of Ortho_Code.O_Storage :=
+     (O_Storage_External => O_Storage_External,
+      O_Storage_Public => O_Storage_Public,
+      O_Storage_Private => O_Storage_Private,
+      O_Storage_Local => O_Storage_Local);
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.New_Const_Decl
+        (Ortho_Code.O_Dnode (Res), Ident, To_Storage (Storage),
+         Ortho_Code.O_Tnode (Atype));
+   end New_Const_Decl;
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.New_Var_Decl
+        (Ortho_Code.O_Dnode (Res), Ident, To_Storage (Storage),
+         Ortho_Code.O_Tnode (Atype));
+   end New_Var_Decl;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      return O_Lnode (Ortho_Code.Exprs.New_Obj (Ortho_Code.O_Dnode (Obj)));
+   end New_Obj;
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.Start_Function_Decl
+        (Ortho_Code.Decls.O_Inter_List (Interfaces),
+         Ident, To_Storage (Storage), Ortho_Code.O_Tnode (Rtype));
+   end Start_Function_Decl;
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage) is
+   begin
+      Ortho_Code.Decls.Start_Procedure_Decl
+        (Ortho_Code.Decls.O_Inter_List (Interfaces),
+         Ident, To_Storage (Storage));
+   end Start_Procedure_Decl;
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.New_Interface_Decl
+        (Ortho_Code.Decls.O_Inter_List (Interfaces),
+         Ortho_Code.O_Dnode (Res),
+         Ident,
+         Ortho_Code.O_Tnode (Atype));
+   end New_Interface_Decl;
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode) is
+   begin
+      Ortho_Code.Decls.Finish_Subprogram_Decl
+        (Ortho_Code.Decls.O_Inter_List (Interfaces), Ortho_Code.O_Dnode (Res));
+   end Finish_Subprogram_Decl;
+
+   procedure Start_Subprogram_Body (Func : O_Dnode) is
+   begin
+      Ortho_Code.Exprs.Start_Subprogram_Body (Ortho_Code.O_Dnode (Func));
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body
+     renames Ortho_Code.Exprs.Finish_Subprogram_Body;
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural)
+     renames Ortho_Code.Exprs.New_Debug_Line_Stmt;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   procedure Start_Declare_Stmt renames
+     Ortho_Code.Exprs.Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt renames
+     Ortho_Code.Exprs.Finish_Declare_Stmt;
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode) is
+   begin
+      Ortho_Code.Exprs.Start_Association
+        (Ortho_Code.Exprs.O_Assoc_List (Assocs), Ortho_Code.O_Dnode (Subprg));
+   end Start_Association;
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode) is
+   begin
+      Ortho_Code.Exprs.New_Association
+        (Ortho_Code.Exprs.O_Assoc_List (Assocs), Ortho_Code.O_Enode (Val));
+   end New_Association;
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode is
+   begin
+      return O_Enode (Ortho_Code.Exprs.New_Function_Call
+                        (Ortho_Code.Exprs.O_Assoc_List (Assocs)));
+   end New_Function_Call;
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List) is
+   begin
+      Ortho_Code.Exprs.New_Procedure_Call
+        (Ortho_Code.Exprs.O_Assoc_List (Assocs));
+   end New_Procedure_Call;
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode) is
+   begin
+      Ortho_Code.Exprs.New_Assign_Stmt (Ortho_Code.O_Lnode (Target),
+                                        Ortho_Code.O_Enode (Value));
+   end New_Assign_Stmt;
+
+   procedure New_Return_Stmt (Value : O_Enode) is
+   begin
+      Ortho_Code.Exprs.New_Return_Stmt (Ortho_Code.O_Enode (Value));
+   end New_Return_Stmt;
+
+   procedure New_Return_Stmt
+     renames Ortho_Code.Exprs.New_Return_Stmt;
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode) is
+   begin
+      Ortho_Code.Exprs.Start_If_Stmt (Ortho_Code.Exprs.O_If_Block (Block),
+                                      Ortho_Code.O_Enode (Cond));
+   end Start_If_Stmt;
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+   begin
+      Ortho_Code.Exprs.New_Else_Stmt (Ortho_Code.Exprs.O_If_Block (Block));
+   end New_Else_Stmt;
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block) is
+   begin
+      Ortho_Code.Exprs.Finish_If_Stmt (Ortho_Code.Exprs.O_If_Block (Block));
+   end Finish_If_Stmt;
+
+   procedure Start_Loop_Stmt (Label : out O_Snode) is
+   begin
+      Ortho_Code.Exprs.Start_Loop_Stmt (Ortho_Code.Exprs.O_Snode (Label));
+   end Start_Loop_Stmt;
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode) is
+   begin
+      Ortho_Code.Exprs.Finish_Loop_Stmt (Ortho_Code.Exprs.O_Snode (Label));
+   end Finish_Loop_Stmt;
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+   begin
+      Ortho_Code.Exprs.New_Exit_Stmt (Ortho_Code.Exprs.O_Snode (L));
+   end New_Exit_Stmt;
+
+   procedure New_Next_Stmt (L : O_Snode) is
+   begin
+      Ortho_Code.Exprs.New_Next_Stmt (Ortho_Code.Exprs.O_Snode (L));
+   end New_Next_Stmt;
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode) is
+   begin
+      Ortho_Code.Exprs.Start_Case_Stmt
+        (Ortho_Code.Exprs.O_Case_Block (Block), Ortho_Code.O_Enode (Value));
+   end Start_Case_Stmt;
+
+   procedure Start_Choice (Block : in out O_Case_Block) is
+   begin
+      Ortho_Code.Exprs.Start_Choice (Ortho_Code.Exprs.O_Case_Block (Block));
+   end Start_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode) is
+   begin
+      Ortho_Code.Exprs.New_Expr_Choice (Ortho_Code.Exprs.O_Case_Block (Block),
+                                        Ortho_Code.O_Cnode (Expr));
+   end New_Expr_Choice;
+
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode) is
+   begin
+      Ortho_Code.Exprs.New_Range_Choice
+        (Ortho_Code.Exprs.O_Case_Block (Block),
+         Ortho_Code.O_Cnode (Low), Ortho_Code.O_Cnode (High));
+   end New_Range_Choice;
+
+   procedure New_Default_Choice (Block : in out O_Case_Block) is
+   begin
+      Ortho_Code.Exprs.New_Default_Choice
+        (Ortho_Code.Exprs.O_Case_Block (Block));
+   end New_Default_Choice;
+
+   procedure Finish_Choice (Block : in out O_Case_Block) is
+   begin
+      Ortho_Code.Exprs.Finish_Choice (Ortho_Code.Exprs.O_Case_Block (Block));
+   end Finish_Choice;
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block) is
+   begin
+      Ortho_Code.Exprs.Finish_Case_Stmt
+        (Ortho_Code.Exprs.O_Case_Block (Block));
+   end Finish_Case_Stmt;
+
+   procedure Init is
+   begin
+      --  Create an anonymous pointer type.
+      if New_Access_Type (O_Tnode_Null) /= O_Tnode (O_Tnode_Ptr) then
+         raise Program_Error;
+      end if;
+      --  Do not finish the access, since this creates an infinite recursion
+      --  in gdb (at least for GDB 6.3).
+      --Finish_Access_Type (O_Tnode_Ptr, O_Tnode_Ptr);
+      Ortho_Code.Abi.Init;
+   end Init;
+
+   procedure Finish is
+   begin
+      if False then
+         Ortho_Code.Decls.Disp_All_Decls;
+         --Ortho_Code.Exprs.Disp_All_Enode;
+      end if;
+      Ortho_Code.Abi.Finish;
+      if Debug.Flag_Debug_Stat then
+         Ada.Text_IO.Put_Line ("Statistics:");
+         Ortho_Code.Exprs.Disp_Stats;
+         Ortho_Code.Decls.Disp_Stats;
+         Ortho_Code.Types.Disp_Stats;
+         Ortho_Code.Consts.Disp_Stats;
+         Ortho_Ident.Disp_Stats;
+         -- Binary_File.Disp_Stats;
+      end if;
+   end Finish;
+
+   procedure Free_All is
+   begin
+      Ortho_Code.Types.Finish;
+      Ortho_Code.Exprs.Finish;
+      Ortho_Code.Consts.Finish;
+      Ortho_Code.Decls.Finish;
+      Ortho_Ident.Finish;
+   end Free_All;
+end Ortho_Mcode;
diff --git a/src/ortho/mcode/ortho_mcode.ads b/src/ortho/mcode/ortho_mcode.ads
new file mode 100644
index 000000000..45e803690
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode.ads
@@ -0,0 +1,583 @@
+--  DO NOT MODIFY - this file was generated from:
+--  ortho_nodes.common.ads and ortho_mcode.private.ads
+--
+--  Mcode back-end for ortho.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+with Ortho_Code; use Ortho_Code;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Consts; use Ortho_Code.Consts;
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+--  Interface to create nodes.
+package Ortho_Mcode is
+   --  Initialize nodes.
+   procedure Init;
+   procedure Finish;
+
+   procedure Free_All;
+
+--  Start of common part
+
+   type O_Enode is private;
+   type O_Cnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+   type O_Dnode is private;
+   type O_Fnode is private;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+   --  True if the code generated supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+--  End of common part
+private
+   --  MCode supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   type O_Tnode is new Ortho_Code.O_Tnode;
+   type O_Cnode is new Ortho_Code.O_Cnode;
+   type O_Dnode is new Ortho_Code.O_Dnode;
+   type O_Enode is new Ortho_Code.O_Enode;
+   type O_Fnode is new Ortho_Code.O_Fnode;
+   type O_Lnode is new Ortho_Code.O_Lnode;
+   type O_Snode is new Ortho_Code.Exprs.O_Snode;
+
+   O_Lnode_Null : constant O_Lnode := O_Lnode (Ortho_Code.O_Lnode_Null);
+   O_Cnode_Null : constant O_Cnode := O_Cnode (Ortho_Code.O_Cnode_Null);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (Ortho_Code.O_Dnode_Null);
+   O_Enode_Null : constant O_Enode := O_Enode (Ortho_Code.O_Enode_Null);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (Ortho_Code.O_Fnode_Null);
+   O_Snode_Null : constant O_Snode := O_Snode (Ortho_Code.Exprs.O_Snode_Null);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (Ortho_Code.O_Tnode_Null);
+
+   type O_Element_List is new Ortho_Code.Types.O_Element_List;
+   type O_Enum_List    is new Ortho_Code.Types.O_Enum_List;
+   type O_Inter_List   is new Ortho_Code.Decls.O_Inter_List;
+   type O_Record_Aggr_List is new Ortho_Code.Consts.O_Record_Aggr_List;
+   type O_Array_Aggr_List is new Ortho_Code.Consts.O_Array_Aggr_List;
+   type O_Assoc_List is new Ortho_Code.Exprs.O_Assoc_List;
+   type O_If_Block   is new Ortho_Code.Exprs.O_If_Block;
+   type O_Case_Block is new Ortho_Code.Exprs.O_Case_Block;
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Dyadic_Op);
+   pragma Inline (New_Monadic_Op);
+   pragma Inline (New_Compare_Op);
+   pragma Inline (New_Signed_Literal);
+   pragma Inline (New_Unsigned_Literal);
+   pragma Inline (New_Float_Literal);
+   pragma Inline (New_Null_Access);
+
+   pragma Inline (Start_Record_Aggr);
+   pragma Inline (New_Record_Aggr_El);
+   pragma Inline (Finish_Record_Aggr);
+
+   pragma Inline (Start_Array_Aggr);
+   pragma Inline (New_Array_Aggr_El);
+   pragma Inline (Finish_Array_Aggr);
+
+   pragma Inline (New_Union_Aggr);
+   pragma Inline (New_Sizeof);
+   pragma Inline (New_Alignof);
+   pragma Inline (New_Offsetof);
+
+   pragma Inline (New_Indexed_Element);
+   pragma Inline (New_Slice);
+   pragma Inline (New_Selected_Element);
+   pragma Inline (New_Access_Element);
+
+   pragma Inline (New_Convert_Ov);
+
+   pragma Inline (New_Address);
+   pragma Inline (New_Global_Address);
+   pragma Inline (New_Unchecked_Address);
+   pragma Inline (New_Global_Unchecked_Address);
+   pragma Inline (New_Subprogram_Address);
+
+   pragma Inline (New_Value);
+   pragma Inline (New_Obj_Value);
+
+   pragma Inline (New_Alloca);
+
+   pragma Inline (New_Debug_Filename_Decl);
+   pragma Inline (New_Debug_Line_Decl);
+   pragma Inline (New_Debug_Comment_Decl);
+
+   pragma Inline (New_Type_Decl);
+   pragma Inline (New_Const_Decl);
+
+   pragma Inline (Start_Const_Value);
+   pragma Inline (Finish_Const_Value);
+   pragma Inline (New_Var_Decl);
+
+   pragma Inline (New_Obj);
+   pragma Inline (Start_Function_Decl);
+   pragma Inline (Start_Procedure_Decl);
+   pragma Inline (New_Interface_Decl);
+   pragma Inline (Finish_Subprogram_Decl);
+   pragma Inline (Start_Subprogram_Body);
+   pragma Inline (Finish_Subprogram_Body);
+
+   pragma Inline (New_Debug_Line_Stmt);
+   pragma Inline (New_Debug_Comment_Stmt);
+
+   pragma Inline (Start_Declare_Stmt);
+   pragma Inline (Finish_Declare_Stmt);
+
+   --  Create a function call or a procedure call.
+   pragma Inline (Start_Association);
+   pragma Inline (New_Association);
+   pragma Inline (New_Function_Call);
+   pragma Inline (New_Procedure_Call);
+
+   pragma Inline (New_Assign_Stmt);
+   pragma Inline (New_Return_Stmt);
+   pragma Inline (Start_If_Stmt);
+   pragma Inline (New_Else_Stmt);
+   pragma Inline (Finish_If_Stmt);
+
+   pragma Inline (Start_Loop_Stmt);
+   pragma Inline (Finish_Loop_Stmt);
+   pragma Inline (New_Exit_Stmt);
+   pragma Inline (New_Next_Stmt);
+
+   pragma Inline (Start_Case_Stmt);
+   pragma Inline (Start_Choice);
+   pragma Inline (New_Expr_Choice);
+   pragma Inline (New_Range_Choice);
+   pragma Inline (New_Default_Choice);
+   pragma Inline (Finish_Choice);
+   pragma Inline (Finish_Case_Stmt);
+end Ortho_Mcode;
diff --git a/src/ortho/mcode/ortho_mcode.private.ads b/src/ortho/mcode/ortho_mcode.private.ads
new file mode 100644
index 000000000..1b414773f
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode.private.ads
@@ -0,0 +1,151 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+with Ortho_Code; use Ortho_Code;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Consts; use Ortho_Code.Consts;
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+--  Interface to create nodes.
+package Ortho_Mcode is
+   --  Initialize nodes.
+   procedure Init;
+   procedure Finish;
+
+   procedure Free_All;
+
+private
+   --  MCode supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   type O_Tnode is new Ortho_Code.O_Tnode;
+   type O_Cnode is new Ortho_Code.O_Cnode;
+   type O_Dnode is new Ortho_Code.O_Dnode;
+   type O_Enode is new Ortho_Code.O_Enode;
+   type O_Fnode is new Ortho_Code.O_Fnode;
+   type O_Lnode is new Ortho_Code.O_Lnode;
+   type O_Snode is new Ortho_Code.Exprs.O_Snode;
+
+   O_Lnode_Null : constant O_Lnode := O_Lnode (Ortho_Code.O_Lnode_Null);
+   O_Cnode_Null : constant O_Cnode := O_Cnode (Ortho_Code.O_Cnode_Null);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (Ortho_Code.O_Dnode_Null);
+   O_Enode_Null : constant O_Enode := O_Enode (Ortho_Code.O_Enode_Null);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (Ortho_Code.O_Fnode_Null);
+   O_Snode_Null : constant O_Snode := O_Snode (Ortho_Code.Exprs.O_Snode_Null);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (Ortho_Code.O_Tnode_Null);
+
+   type O_Element_List is new Ortho_Code.Types.O_Element_List;
+   type O_Enum_List    is new Ortho_Code.Types.O_Enum_List;
+   type O_Inter_List   is new Ortho_Code.Decls.O_Inter_List;
+   type O_Record_Aggr_List is new Ortho_Code.Consts.O_Record_Aggr_List;
+   type O_Array_Aggr_List is new Ortho_Code.Consts.O_Array_Aggr_List;
+   type O_Assoc_List is new Ortho_Code.Exprs.O_Assoc_List;
+   type O_If_Block   is new Ortho_Code.Exprs.O_If_Block;
+   type O_Case_Block is new Ortho_Code.Exprs.O_Case_Block;
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Dyadic_Op);
+   pragma Inline (New_Monadic_Op);
+   pragma Inline (New_Compare_Op);
+   pragma Inline (New_Signed_Literal);
+   pragma Inline (New_Unsigned_Literal);
+   pragma Inline (New_Float_Literal);
+   pragma Inline (New_Null_Access);
+
+   pragma Inline (Start_Record_Aggr);
+   pragma Inline (New_Record_Aggr_El);
+   pragma Inline (Finish_Record_Aggr);
+
+   pragma Inline (Start_Array_Aggr);
+   pragma Inline (New_Array_Aggr_El);
+   pragma Inline (Finish_Array_Aggr);
+
+   pragma Inline (New_Union_Aggr);
+   pragma Inline (New_Sizeof);
+   pragma Inline (New_Alignof);
+   pragma Inline (New_Offsetof);
+
+   pragma Inline (New_Indexed_Element);
+   pragma Inline (New_Slice);
+   pragma Inline (New_Selected_Element);
+   pragma Inline (New_Access_Element);
+
+   pragma Inline (New_Convert_Ov);
+
+   pragma Inline (New_Address);
+   pragma Inline (New_Global_Address);
+   pragma Inline (New_Unchecked_Address);
+   pragma Inline (New_Global_Unchecked_Address);
+   pragma Inline (New_Subprogram_Address);
+
+   pragma Inline (New_Value);
+   pragma Inline (New_Obj_Value);
+
+   pragma Inline (New_Alloca);
+
+   pragma Inline (New_Debug_Filename_Decl);
+   pragma Inline (New_Debug_Line_Decl);
+   pragma Inline (New_Debug_Comment_Decl);
+
+   pragma Inline (New_Type_Decl);
+   pragma Inline (New_Const_Decl);
+
+   pragma Inline (Start_Const_Value);
+   pragma Inline (Finish_Const_Value);
+   pragma Inline (New_Var_Decl);
+
+   pragma Inline (New_Obj);
+   pragma Inline (Start_Function_Decl);
+   pragma Inline (Start_Procedure_Decl);
+   pragma Inline (New_Interface_Decl);
+   pragma Inline (Finish_Subprogram_Decl);
+   pragma Inline (Start_Subprogram_Body);
+   pragma Inline (Finish_Subprogram_Body);
+
+   pragma Inline (New_Debug_Line_Stmt);
+   pragma Inline (New_Debug_Comment_Stmt);
+
+   pragma Inline (Start_Declare_Stmt);
+   pragma Inline (Finish_Declare_Stmt);
+
+   --  Create a function call or a procedure call.
+   pragma Inline (Start_Association);
+   pragma Inline (New_Association);
+   pragma Inline (New_Function_Call);
+   pragma Inline (New_Procedure_Call);
+
+   pragma Inline (New_Assign_Stmt);
+   pragma Inline (New_Return_Stmt);
+   pragma Inline (Start_If_Stmt);
+   pragma Inline (New_Else_Stmt);
+   pragma Inline (Finish_If_Stmt);
+
+   pragma Inline (Start_Loop_Stmt);
+   pragma Inline (Finish_Loop_Stmt);
+   pragma Inline (New_Exit_Stmt);
+   pragma Inline (New_Next_Stmt);
+
+   pragma Inline (Start_Case_Stmt);
+   pragma Inline (Start_Choice);
+   pragma Inline (New_Expr_Choice);
+   pragma Inline (New_Range_Choice);
+   pragma Inline (New_Default_Choice);
+   pragma Inline (Finish_Choice);
+   pragma Inline (Finish_Case_Stmt);
+end Ortho_Mcode;
diff --git a/src/ortho/mcode/ortho_nodes.ads b/src/ortho/mcode/ortho_nodes.ads
new file mode 100644
index 000000000..7a2df3f30
--- /dev/null
+++ b/src/ortho/mcode/ortho_nodes.ads
@@ -0,0 +1,2 @@
+with Ortho_Mcode;
+package Ortho_Nodes renames Ortho_Mcode;
diff --git a/src/ortho/oread/Makefile b/src/ortho/oread/Makefile
new file mode 100644
index 000000000..f94535181
--- /dev/null
+++ b/src/ortho/oread/Makefile
@@ -0,0 +1,43 @@
+#  -*- Makefile -*- for the ortho-code compiler.
+#  Copyright (C) 2005 Tristan Gingold
+#
+#  GHDL is free software; you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free
+#  Software Foundation; either version 2, or (at your option) any later
+#  version.
+#
+#  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#  for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with GCC; see the file COPYING.  If not, write to the Free
+#  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+#  02111-1307, USA.
+BE = gcc
+ortho_srcdir=..
+BACK_END=$(ortho_srcdir)/$(BE)
+ortho_exec=oread-$(BE)
+
+all: $(ortho_exec)
+
+test: test.s
+	$(CC) -o $@ $^
+
+test.s: $(ortho_exec)
+	./$(ortho_exec) test
+
+$(ortho_exec): force
+	$(MAKE) -f $(BACK_END)/Makefile ortho_exec=$(ortho_exec)
+
+clean:
+	$(MAKE) -f $(BACK_END)/Makefile clean
+	$(RM) -f oread-gcc oread-mcode *.o *~
+
+distclean: clean
+	$(MAKE) -f $(BACK_END)/Makefile distclean
+
+force:
+
+.PHONY: force
diff --git a/src/ortho/oread/ortho_front.adb b/src/ortho/oread/ortho_front.adb
new file mode 100644
index 000000000..84bbd1b9d
--- /dev/null
+++ b/src/ortho/oread/ortho_front.adb
@@ -0,0 +1,2677 @@
+--  Ortho code compiler.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Deallocation;
+with Ortho_Nodes; use Ortho_Nodes;
+with Ortho_Ident; use Ortho_Ident;
+with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Interfaces; use Interfaces;
+with Ada.Exceptions;
+--with GNAT.Debug_Pools;
+
+--  TODO:
+--  uncomplete type: check for type redefinition
+
+package body Ortho_Front is
+   --  If true, emit line number before each statement.
+   --  If flase, keep line number indication in the source file.
+   Flag_Renumber : Boolean := True;
+
+   procedure Init is
+   begin
+      null;
+   end Init;
+
+   function Decode_Option (Opt : String_Acc; Arg : String_Acc) return Natural
+   is
+      pragma Unreferenced (Arg);
+   begin
+      if Opt.all = "-r" or Opt.all = "--ghdl-r" then
+         Flag_Renumber := True;
+         return 1;
+      else
+         return 0;
+      end if;
+   end Decode_Option;
+
+   --  File buffer.
+   File_Name : String_Acc;
+   Buf : String (1 .. 2048 + 1);
+   Buf_Len : Natural;
+   Pos : Natural;
+   Lineno : Natural;
+
+   Fd : File_Descriptor;
+
+   Error : exception;
+
+   procedure Puterr (Msg : String)
+   is
+      L : Integer;
+      pragma Unreferenced (L);
+   begin
+      L := Write (Standerr, Msg'Address, Msg'Length);
+   end Puterr;
+
+   procedure Puterr (N : Natural)
+   is
+      Str : constant String := Natural'Image (N);
+   begin
+      Puterr (Str (Str'First + 1 .. Str'Last));
+   end Puterr;
+
+   procedure Newline_Err is
+   begin
+      Puterr ((1 => LF));
+   end Newline_Err;
+
+   procedure Scan_Error (Msg : String) is
+   begin
+      Puterr (File_Name.all);
+      Puterr (":");
+      Puterr (Lineno);
+      Puterr (": ");
+      Puterr (Msg);
+      Newline_Err;
+      raise Error;
+   end Scan_Error;
+
+   procedure Parse_Error (Msg : String);
+   pragma No_Return (Parse_Error);
+
+   procedure Parse_Error (Msg : String) is
+   begin
+      Puterr (File_Name.all);
+      Puterr (":");
+      Puterr (Lineno);
+      Puterr (": ");
+      Puterr (Msg);
+      Newline_Err;
+      raise Error;
+   end Parse_Error;
+
+
+--    Uniq_Num : Natural := 0;
+
+--    function Get_Uniq_Id return O_Ident
+--    is
+--       Str : String (1 .. 8);
+--       V : Natural;
+--    begin
+--       V := Uniq_Num;
+--       Uniq_Num := Uniq_Num + 1;
+--       Str (1) := 'L';
+--       Str (2) := '.';
+--       for I in reverse 3 .. Str'Last loop
+--          Str (I) := Character'Val ((V mod 10) + Character'Pos('0'));
+--          V := V / 10;
+--       end loop;
+--       return Get_Identifier (Str);
+--    end Get_Uniq_Id;
+
+   --  Get the next character.
+   --  Return NUL on end of file.
+   function Get_Char return Character
+   is
+      Res : Character;
+   begin
+      if Buf (Pos) = NUL then
+         --  Read line.
+         Buf_Len := Read (Fd, Buf'Address, Buf'Length - 1);
+         if Buf_Len = 0 then
+            --  End of file.
+            return NUL;
+         end if;
+         Pos := 1;
+         Buf (Buf_Len + 1) := NUL;
+      end if;
+
+      Res := Buf (Pos);
+      Pos := Pos + 1;
+      return Res;
+   end Get_Char;
+
+   procedure Unget_Char is
+   begin
+      if Pos = Buf'First then
+         raise Program_Error;
+      end if;
+      Pos := Pos - 1;
+   end Unget_Char;
+
+   type Token_Type is
+      (Tok_Eof,
+       Tok_Line_Number, Tok_File_Name, Tok_Comment,
+       Tok_Ident, Tok_Num, Tok_String, Tok_Float_Num,
+       Tok_Plus, Tok_Minus,
+       Tok_Star, Tok_Div, Tok_Mod, Tok_Rem,
+       Tok_Sharp,
+       Tok_Not, Tok_Abs,
+       Tok_Or, Tok_And, Tok_Xor,
+       Tok_Equal, Tok_Not_Equal,
+       Tok_Greater, Tok_Greater_Eq,
+       Tok_Less, Tok_Less_Eq,
+       Tok_Colon, Tok_Semicolon,
+       Tok_Comma, Tok_Dot, Tok_Tick, Tok_Arob, Tok_Elipsis,
+       Tok_Assign,
+       Tok_Left_Paren, Tok_Right_Paren,
+       Tok_Left_Brace, Tok_Right_Brace,
+       Tok_Left_Brack, Tok_Right_Brack,
+       Tok_Unsigned, Tok_Signed, Tok_Float,
+       Tok_Array, Tok_Subarray,
+       Tok_Access, Tok_Record, Tok_Union,
+       Tok_Boolean, Tok_Enum,
+       Tok_If, Tok_Then, Tok_Else, Tok_Elsif,
+       Tok_Loop, Tok_Exit, Tok_Next,
+       Tok_Is, Tok_Of, Tok_All,
+       Tok_Return,
+       Tok_Type,
+       Tok_External, Tok_Private, Tok_Public, Tok_Local,
+       Tok_Procedure, Tok_Function,
+       Tok_Constant, Tok_Var,
+       Tok_Declare, Tok_Begin, Tok_End,
+       Tok_Case, Tok_When, Tok_Default, Tok_Arrow,
+       Tok_Null);
+
+   type Hash_Type is new Unsigned_32;
+
+   type Name_Type;
+   type Name_Acc is access Name_Type;
+
+   --  Symbol table.
+   type Syment_Type;
+   type Syment_Acc is access Syment_Type;
+   type Syment_type is record
+      --  The hash for the symbol.
+      Hash : Hash_Type;
+      --  Identification of the symbol.
+      Ident : O_Ident;
+      --  Next symbol with the same collision.
+      Next : Syment_Acc;
+      --  Meaning of the symbol.
+      Name : Name_Acc;
+   end record;
+
+   --  Well known identifiers (used for attributes).
+   Id_Address : Syment_Acc;
+   Id_Unchecked_Address : Syment_Acc;
+   Id_Subprg_Addr : Syment_Acc;
+   Id_Conv : Syment_Acc;
+   Id_Sizeof : Syment_Acc;
+   Id_Alignof : Syment_Acc;
+   Id_Alloca : Syment_Acc;
+   Id_Offsetof : Syment_Acc;
+
+   Token_Number : Unsigned_64;
+   Token_Float : IEEE_Float_64;
+   Token_Ident : String (1 .. 256);
+   Token_Idlen : Natural;
+   Token_Hash : Hash_Type;
+   Token_Sym : Syment_Acc;
+
+   --  The symbol table.
+   type Syment_Acc_Array is array (Hash_Type range <>) of Syment_Acc;
+   Hash_Max : constant Hash_Type := 511;
+   Symtable : Syment_Acc_Array (0 .. Hash_Max - 1) := (others => null);
+
+   type Node_Kind is (Decl_Keyword, Decl_Type, Decl_Param,
+                      Node_Function, Node_Procedure, Node_Object, Node_Field,
+                      Node_Lit,
+                      Type_Boolean, Type_Enum,
+                      Type_Unsigned, Type_Signed, Type_Float,
+                      Type_Array, Type_Subarray,
+                      Type_Access, Type_Record, Type_Union);
+   subtype Nodes_Subprogram is Node_Kind range Node_Function .. Node_Procedure;
+
+   type Node (<>);
+   type Node_Acc is access Node;
+   type Node (Kind : Node_Kind) is record
+      case Kind is
+         when Decl_Keyword =>
+            --  Keyword.
+            --  A keyword is not a declaration since the identifier has only
+            --  one meaning (the keyword).
+            Keyword : Token_Type;
+         when Decl_Type
+           | Decl_Param
+           | Node_Function
+           | Node_Procedure
+           | Node_Object
+           | Node_Lit =>
+            --  Declarations
+            --  All declarations but NODE_PROCEDURE have a type.
+            Decl_Dtype : Node_Acc;
+            Decl_Storage : O_Storage;
+            case Kind is
+               when Decl_Type =>
+                  --  Type declaration.
+                  null;
+               when Decl_Param =>
+                  --  Parameter identifier.
+                  Param_Name : Syment_Acc;
+                  --  Parameter ortho node.
+                  Param_Node : O_Dnode;
+                  --  Next parameter of the parameters list.
+                  Param_Next : Node_Acc;
+               when Node_Procedure
+                 | Node_Function =>
+                  --  Subprogram symbol name.
+                  Subprg_Name : Syment_Acc;
+                  --  List of parameters.
+                  Subprg_Params : Node_Acc;
+                  --  Subprogram ortho node.
+                  Subprg_Node : O_Dnode;
+               when Node_Object =>
+                  --  Name of the object (constant, variable).
+                  Obj_Name : O_Ident;
+                  --  Ortho node of the object.
+                  Obj_Node : O_Dnode;
+               when Node_Lit =>
+                  --  Name of the literal.
+                  Lit_Name : O_Ident;
+                  --  Enum literal
+                  Lit_Cnode : O_Cnode;
+                  --  Next literal for the type.
+                  Lit_Next : Node_Acc;
+               when others =>
+                  null;
+            end case;
+         when Node_Field =>
+            --  Record field.
+            Field_Ident : Syment_Acc;
+            Field_Fnode : O_Fnode;
+            Field_Type : Node_Acc;
+            Field_Next : Node_Acc;
+         when Type_Signed
+           | Type_Unsigned
+           | Type_Float
+           | Type_Array
+           | Type_Subarray
+           | Type_Record
+           | Type_Union
+           | Type_Access
+           | Type_Boolean
+           | Type_Enum =>
+            --  Ortho node type.
+            Type_Onode : O_Tnode;
+            case Kind is
+               when Type_Array =>
+                  Array_Index : Node_Acc;
+                  Array_Element : Node_Acc;
+               when Type_Subarray =>
+                  Subarray_Base : Node_Acc;
+                  --Subarray_Length : Natural;
+               when Type_Access =>
+                  Access_Dtype : Node_Acc;
+               when Type_Record
+                 | Type_Union =>
+                  Record_Union_Fields : Node_Acc;
+               when Type_Enum
+                 | Type_Boolean =>
+                  Enum_Lits : Node_Acc;
+               when Type_Float =>
+                  null;
+               when others =>
+                  null;
+            end case;
+      end case;
+   end record;
+
+   type Scope_Type;
+   type Scope_Acc is access Scope_Type;
+
+   type Name_Type is record
+      --  Current interpretation of the symbol.
+      Inter : Node_Acc;
+      --  Next declaration in the current scope.
+      Next : Syment_Acc;
+      --  Interpretation in a previous scope.
+      Up : Name_Acc;
+      --  Current scope.
+      Scope : Scope_Acc;
+   end record;
+
+   type Scope_Type is record
+      --  Simply linked list of names.
+      Names : Syment_Acc;
+      --  Previous scope.
+      Prev : Scope_Acc;
+   end record;
+
+   --  Return the current declaration for symbol SYM.
+   function Get_Decl (Sym : Syment_Acc) return Node_Acc;
+   pragma Inline (Get_Decl);
+
+   procedure Scan_Char (C : Character)
+   is
+      R : Character;
+   begin
+
+      if C = '\' then
+         R := Get_Char;
+         case R is
+            when 'n' =>
+               R := LF;
+            when 'r' =>
+               R := CR;
+            when ''' =>
+               R := ''';
+            when '"' => -- "
+               R := '"'; -- "
+            when others =>
+               Scan_Error ("bad character sequence \" & R);
+         end case;
+      else
+         R := C;
+      end if;
+      Token_Idlen := Token_Idlen + 1;
+      Token_Ident (Token_Idlen) := R;
+   end Scan_Char;
+
+   function Get_Hash (Str : String) return Hash_Type
+   is
+      Res : Hash_Type;
+   begin
+      Res := 0;
+      for I in Str'Range loop
+         Res := Res * 31 + Character'Pos (Str (I));
+      end loop;
+      return Res;
+   end Get_Hash;
+
+   --  Previous token.
+   Tok_Previous : Token_Type;
+
+   function Scan_Number (First_Char : Character) return Token_Type
+   is
+      function To_Digit (C : Character) return Integer is
+      begin
+         case C is
+            when '0' .. '9' =>
+               return Character'Pos (C) - Character'Pos ('0');
+            when 'A' .. 'F' =>
+               return Character'Pos (C) - Character'Pos ('A') + 10;
+            when 'a' .. 'f' =>
+               return Character'Pos (C) - Character'Pos ('a') + 10;
+            when others =>
+               return -1;
+         end case;
+      end To_Digit;
+
+      function Is_Digit (C : Character) return Boolean is
+      begin
+         case C is
+            when '0' .. '9'
+              | 'A' .. 'F'
+              | 'a' .. 'f' =>
+               return True;
+            when others =>
+               return False;
+         end case;
+      end Is_Digit;
+
+      After_Point : Integer;
+      C : Character;
+      Exp : Integer;
+      Exp_Neg : Boolean;
+      Base : Unsigned_64;
+   begin
+      Token_Number := 0;
+      C := First_Char;
+      loop
+         Token_Number := Token_Number * 10 + Unsigned_64 (To_Digit (C));
+         C := Get_Char;
+         exit when not Is_Digit (C);
+      end loop;
+      if C = '#' then
+         Base := Token_Number;
+         Token_Number := 0;
+         C := Get_Char;
+         loop
+            Token_Number := Token_Number * Base + Unsigned_64 (To_Digit (C));
+            C := Get_Char;
+            exit when C = '#';
+         end loop;
+         return Tok_Num;
+      end if;
+      if C = '.' then
+         -- A real number.
+         After_Point := 0;
+         Token_Float := IEEE_Float_64 (Token_Number);
+         loop
+            C := Get_Char;
+            exit when C not in '0' .. '9';
+            Token_Float := Token_Float * 10.0 + IEEE_Float_64 (To_Digit (C));
+            After_Point := After_Point + 1;
+         end loop;
+         if C = 'e' or C = 'E' then
+            Exp := 0;
+            C := Get_Char;
+            Exp_Neg := False;
+            if C = '-' then
+               Exp_Neg := True;
+               C := Get_Char;
+            elsif C = '+' then
+               C := Get_Char;
+            elsif not Is_Digit (C) then
+               Scan_Error ("digit expected");
+            end if;
+            while Is_Digit (C) loop
+               Exp := Exp * 10 + To_Digit (C);
+               C := Get_Char;
+            end loop;
+            if Exp_Neg then
+               Exp := -Exp;
+            end if;
+            Exp := Exp - After_Point;
+         else
+            Exp := - After_Point;
+         end if;
+         Unget_Char;
+         Token_Float := Token_Float * 10.0 ** Exp;
+         if Token_Float > IEEE_Float_64'Last then
+            Token_Float := IEEE_Float_64'Last;
+         end if;
+         return Tok_Float_Num;
+      else
+         Unget_Char;
+         return Tok_Num;
+      end if;
+   end Scan_Number;
+
+   procedure Scan_Comment
+   is
+      C : Character;
+   begin
+      Token_Idlen := 0;
+      loop
+         C := Get_Char;
+         exit when C = CR or C = LF;
+         Token_Idlen := Token_Idlen + 1;
+         Token_Ident (Token_Idlen) := C;
+      end loop;
+      Unget_Char;
+   end Scan_Comment;
+
+   --  Get the next token.
+   function Get_Token return Token_Type
+   is
+      C : Character;
+   begin
+      loop
+
+         C := Get_Char;
+         << Again >> null;
+         case C is
+            when NUL =>
+               return Tok_Eof;
+            when ' ' | HT =>
+               null;
+            when LF =>
+               Lineno := Lineno + 1;
+               C := Get_Char;
+               if C /= CR then
+                  goto Again;
+               end if;
+            when CR =>
+               Lineno := Lineno + 1;
+               C := Get_Char;
+               if C /= LF then
+                  goto Again;
+               end if;
+            when '+' =>
+               return Tok_Plus;
+            when '-' =>
+               C := Get_Char;
+               if C = '-' then
+                  C := Get_Char;
+                  if C = '#' then
+                     return Tok_Line_Number;
+                  elsif C = 'F' then
+                     Scan_Comment;
+                     return Tok_File_Name;
+                  elsif C = ' ' then
+                     Scan_Comment;
+                     return Tok_Comment;
+                  else
+                     Scan_Error ("bad comment");
+                  end if;
+               else
+                  Unget_Char;
+                  return Tok_Minus;
+               end if;
+            when '/' =>
+               C := Get_Char;
+               if C = '=' then
+                  return Tok_Not_Equal;
+               else
+                  Unget_Char;
+                  return Tok_Div;
+               end if;
+            when '*' =>
+               return Tok_Star;
+            when '#' =>
+               return Tok_Sharp;
+            when '=' =>
+               C := Get_Char;
+               if C = '>' then
+                  return Tok_Arrow;
+               else
+                  Unget_Char;
+                  return Tok_Equal;
+               end if;
+            when '>' =>
+               C := Get_Char;
+               if C = '=' then
+                  return Tok_Greater_Eq;
+               else
+                  Unget_Char;
+                  return Tok_Greater;
+               end if;
+            when '(' =>
+               return Tok_Left_Paren;
+            when ')' =>
+               return Tok_Right_Paren;
+            when '{' =>
+               return Tok_Left_Brace;
+            when '}' =>
+               return Tok_Right_Brace;
+            when '[' =>
+               return Tok_Left_Brack;
+            when ']' =>
+               return Tok_Right_Brack;
+            when '<' =>
+               C := Get_Char;
+               if C = '=' then
+                  return Tok_Less_Eq;
+               else
+                  Unget_Char;
+                  return Tok_Less;
+               end if;
+            when ':' =>
+               C := Get_Char;
+               if C = '=' then
+                  return Tok_Assign;
+               else
+                  Unget_Char;
+                  return Tok_Colon;
+               end if;
+            when '.' =>
+               C := Get_Char;
+               if C = '.' then
+                  C := Get_Char;
+                  if C = '.' then
+                     return Tok_Elipsis;
+                  else
+                     Scan_Error ("'...' expected");
+                  end if;
+               else
+                  Unget_Char;
+                  return Tok_Dot;
+               end if;
+            when ';' =>
+               return Tok_Semicolon;
+            when ',' =>
+               return Tok_Comma;
+            when '@' =>
+               return Tok_Arob;
+            when ''' =>
+               if Tok_Previous = Tok_Ident then
+                  return Tok_Tick;
+               else
+                  Token_Number := Character'Pos (Get_Char);
+                  C := Get_Char;
+                  if C /= ''' then
+                     Scan_Error ("ending single quote expected");
+                  end if;
+                  return Tok_Num;
+               end if;
+            when '"' => -- "
+               --  Eat double quote.
+               C := Get_Char;
+               Token_Idlen := 0;
+               loop
+                  Scan_Char (C);
+                  C := Get_Char;
+                  exit when C = '"'; -- "
+               end loop;
+               return Tok_String;
+            when '0' .. '9' =>
+               return Scan_Number (C);
+            when 'a' .. 'z'
+              | 'A' .. 'Z'
+              | '_' =>
+               Token_Idlen := 0;
+               Token_Hash := 0;
+               loop
+                  Token_Idlen := Token_Idlen + 1;
+                  Token_Ident (Token_Idlen) := C;
+                  Token_Hash := Token_Hash * 31 + Character'Pos (C);
+                  C := Get_Char;
+                  exit when (C < 'A' or C > 'Z')
+                    and (C < 'a' or C > 'z')
+                    and (C < '0' or C > '9')
+                    and (C /= '_');
+               end loop;
+               Unget_Char;
+               declare
+                  H : Hash_Type;
+                  S : Syment_Acc;
+                  N : Node_Acc;
+               begin
+                  H := Token_Hash mod Hash_Max;
+                  S := Symtable (H);
+                  while S /= null loop
+                     if S.Hash = Token_Hash
+                       and then Is_Equal (S.Ident,
+                                          Token_Ident (1 .. Token_Idlen))
+                     then
+                        --  This identifier is known.
+                        Token_Sym := S;
+
+                        --  It may be a keyword.
+                        if S.Name /= null then
+                           N := Get_Decl (S);
+                           if N.Kind = Decl_Keyword then
+                              return N.Keyword;
+                           end if;
+                        end if;
+
+                        return Tok_Ident;
+                     end if;
+                     S := S.Next;
+                  end loop;
+                  Symtable (H) := new Syment_Type'
+                    (Hash => Token_Hash,
+                     Ident => Get_Identifier (Token_Ident (1 .. Token_Idlen)),
+                     Next => Symtable (H),
+                     Name => null);
+                  Token_Sym := Symtable (H);
+                  return Tok_Ident;
+               end;
+            when others =>
+               Scan_Error ("Bad character:"
+                           & Integer'Image (Character'Pos (C))
+                           & C);
+               return Tok_Eof;
+         end case;
+      end loop;
+   end Get_Token;
+
+   --  The current token.
+   Tok : Token_Type;
+
+   procedure Next_Token is
+   begin
+      Tok_Previous := Tok;
+      Tok := Get_Token;
+   end Next_Token;
+
+   procedure Expect (T : Token_Type; Msg : String := "") is
+   begin
+      if Tok /= T then
+         if Msg'Length = 0 then
+            case T is
+               when Tok_Left_Brace =>
+                  Parse_Error ("'{' expected");
+               when others =>
+                  if Tok = Tok_Ident then
+                     Parse_Error
+                       (Token_Type'Image (T) & " expected, found '" &
+                        Token_Ident (1 .. Token_Idlen) & "'");
+                  else
+                     Parse_Error (Token_Type'Image (T) & " expected, found "
+                                  & Token_Type'Image (Tok));
+                  end if;
+            end case;
+         else
+            Parse_Error (Msg);
+         end if;
+      end if;
+   end Expect;
+
+   procedure Next_Expect (T : Token_Type; Msg : String := "") is
+   begin
+      Next_Token;
+      Expect (T, Msg);
+   end Next_Expect;
+
+   --  Scopes and identifiers.
+
+
+   --  Current scope.
+   Scope : Scope_Acc := null;
+
+   --  Add a declaration for symbol SYM in the current scope.
+   --  INTER defines the meaning of the declaration.
+   --  There must be at most one declaration for a symbol in the current scope,
+   --  i.e. a symbol cannot be redefined.
+   procedure Add_Decl (Sym : Syment_Acc; Inter : Node_Acc);
+
+   --  Return TRUE iff SYM is already defined in the current scope.
+   function Is_Defined (Sym : Syment_Acc) return Boolean;
+
+   --  Create new scope.
+   procedure Push_Scope;
+
+   --  Close the current scope.  Symbols defined in the scope regain their
+   --  previous declaration.
+   procedure Pop_Scope;
+
+
+   procedure Push_Scope
+   is
+      Nscope : Scope_Acc;
+   begin
+      Nscope := new Scope_Type'(Names => null, Prev => Scope);
+      Scope := Nscope;
+   end Push_Scope;
+
+   procedure Pop_Scope
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Object => Name_Type, Name => Name_Acc);
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Object => Scope_Type, Name => Scope_Acc);
+
+      Sym : Syment_Acc;
+      N_Sym : Syment_Acc;
+      Name : Name_Acc;
+      Old_Scope : Scope_Acc;
+   begin
+      Sym := Scope.Names;
+      while Sym /= null loop
+         Name := Sym.Name;
+         --  Check.
+         if Name.Scope /= Scope then
+            raise Program_Error;
+         end if;
+
+         --  Set the interpretation of this symbol.
+         Sym.Name := Name.Up;
+
+         N_Sym := Name.Next;
+
+         Free (Name);
+         Sym := N_Sym;
+      end loop;
+
+      --  Free scope.
+      Old_Scope := Scope;
+      Scope := Scope.Prev;
+      Free (Old_Scope);
+   end Pop_Scope;
+
+   function Is_Defined (Sym : Syment_Acc) return Boolean is
+   begin
+      if Sym.Name /= null
+        and then Sym.Name.Scope = Scope
+      then
+         return True;
+      else
+         return False;
+      end if;
+   end Is_Defined;
+
+   function New_Symbol (Str : String) return Syment_Acc
+   is
+      Ent : Syment_Acc;
+      H : Hash_Type;
+   begin
+      Ent := new Syment_Type'(Hash => Get_Hash (Str),
+                              Ident => Get_Identifier (Str),
+                              Next => null,
+                              Name => null);
+      H := Ent.Hash mod Hash_Max;
+      Ent.Next := Symtable (H);
+      Symtable (H) := Ent;
+      return Ent;
+   end New_Symbol;
+
+   procedure Add_Keyword (Str : String; Token : Token_Type)
+   is
+      Ent : Syment_Acc;
+   begin
+      Ent := New_Symbol (Str);
+      if Ent.Name /= null
+        or else Scope /= null
+      then
+         --  Redefinition of a keyword.
+         raise Program_Error;
+      end if;
+      Ent.Name := new Name_Type'(Inter => new Node'(Kind => Decl_Keyword,
+                                                    Keyword => Token),
+                                 Next => null,
+                                 Up => null,
+                                 Scope => null);
+   end Add_Keyword;
+
+   procedure Add_Decl (Sym : Syment_Acc; Inter : Node_Acc)
+   is
+      Name : Name_Acc;
+      Prev : Node_Acc;
+   begin
+      Name := Sym.Name;
+      if Name /= null and then Name.Scope = Scope then
+         Prev := Name.Inter;
+         if Prev.Kind = Inter.Kind
+           and then Prev.Decl_Dtype = Inter.Decl_Dtype
+           and then Prev.Decl_Storage = O_Storage_External
+           and then Inter.Decl_Storage = O_Storage_Public
+         then
+            --  Redefinition
+            Name.Inter := Inter;
+            return;
+         end if;
+         Parse_Error ("redefinition of " & Get_String (Sym.Ident));
+      end if;
+      Name := new Name_Type'(Inter => Inter,
+                             Next => Scope.Names,
+                             Up => Sym.Name,
+                             Scope => Scope);
+      Sym.Name := Name;
+      Scope.Names := Sym;
+   end Add_Decl;
+
+   function Get_Decl (Sym : Syment_Acc) return Node_Acc is
+   begin
+      if Sym.Name = null then
+         Parse_Error ("undefined identifier " & Get_String (Sym.Ident));
+      else
+         return Sym.Name.Inter;
+      end if;
+   end Get_Decl;
+
+   function Parse_Constant_Value (Atype : Node_Acc) return O_Cnode;
+   function Parse_Address (Prefix : Node_Acc) return O_Enode;
+   function Parse_Constant_Address (Prefix : Node_Acc) return O_Cnode;
+   procedure Parse_Declaration;
+   procedure Parse_Compound_Statement;
+
+   function Parse_Type return Node_Acc;
+
+   procedure Parse_Fields (Aggr_Type : Node_Acc;
+                           Constr : in out O_Element_List)
+   is
+      F_Type : Node_Acc;
+      F : Syment_Acc;
+      Last_Field : Node_Acc;
+      Field : Node_Acc;
+   begin
+      Last_Field := null;
+      loop
+         exit when Tok = Tok_End;
+
+         if Tok /= Tok_Ident then
+            Parse_Error ("field name expected");
+         end if;
+         F := Token_Sym;
+         Next_Expect (Tok_Colon, "':' expected");
+         Next_Token;
+         F_Type := Parse_Type;
+         Field := new Node'(Kind => Node_Field,
+                            Field_Ident => F,
+                            Field_Fnode => O_Fnode_Null,
+                            Field_Type => F_Type,
+                            Field_Next => null);
+         case Aggr_Type.Kind is
+            when Type_Record =>
+               New_Record_Field (Constr, Field.Field_Fnode, F.Ident,
+                                 F_Type.Type_Onode);
+            when Type_Union =>
+               New_Union_Field (Constr, Field.Field_Fnode, F.Ident,
+                                F_Type.Type_Onode);
+            when others =>
+               raise Program_Error;
+         end case;
+         if Last_Field = null then
+            Aggr_Type.Record_Union_Fields := Field;
+         else
+            Last_Field.Field_Next := Field;
+         end if;
+         Last_Field := Field;
+         Expect (Tok_Semicolon, "';' expected");
+         Next_Token;
+      end loop;
+   end Parse_Fields;
+
+   procedure Parse_Record_Type (Def : Node_Acc)
+   is
+      Constr : O_Element_List;
+   begin
+      if Def.Type_Onode = O_Tnode_Null then
+         Start_Record_Type (Constr);
+      else
+         Start_Uncomplete_Record_Type (Def.Type_Onode, Constr);
+      end if;
+      Parse_Fields (Def, Constr);
+      Next_Expect (Tok_Record, "end record expected");
+      Finish_Record_Type (Constr, Def.Type_Onode);
+   end Parse_Record_Type;
+
+   procedure Parse_Union_Type (Def : Node_Acc)
+   is
+      Constr : O_Element_List;
+   begin
+      Start_Union_Type (Constr);
+      Parse_Fields (Def, Constr);
+      Next_Expect (Tok_Union, "end union expected");
+      Finish_Union_Type (Constr, Def.Type_Onode);
+   end Parse_Union_Type;
+
+   function Parse_Type return Node_Acc
+   is
+      Res : Node_Acc;
+      T : Token_Type;
+   begin
+      T := Tok;
+      case T is
+         when Tok_Unsigned
+           | Tok_Signed =>
+            Next_Expect (Tok_Left_Paren, "'(' expected");
+            Next_Expect (Tok_Num, "number expected");
+            case T is
+               when Tok_Unsigned =>
+                  Res := new Node'
+                    (Kind => Type_Unsigned,
+                     Type_Onode => New_Unsigned_Type (Natural
+                                                      (Token_Number)));
+               when Tok_Signed =>
+                  Res := new Node'
+                     (Kind => Type_Signed,
+                      Type_Onode => New_Signed_Type (Natural
+                                                     (Token_Number)));
+               when others =>
+                  raise Program_Error;
+            end case;
+            Next_Expect (Tok_Right_Paren, "')' expected");
+         when Tok_Float =>
+            Res := new Node'(Kind => Type_Float,
+                             Type_Onode => New_Float_Type);
+         when Tok_Array =>
+            declare
+               Index_Node : Node_Acc;
+               El_Node : Node_Acc;
+            begin
+               Next_Expect (Tok_Left_Brack, "'[' expected");
+               Next_Token;
+               Index_Node := Parse_Type;
+               Expect (Tok_Right_Brack, "']' expected");
+               Next_Expect (Tok_Of, "'of' expected");
+               Next_Token;
+               El_Node := Parse_Type;
+               Res := new Node'
+                 (Kind => Type_Array,
+                  Type_Onode => New_Array_Type (El_Node.Type_Onode,
+                                                Index_Node.Type_Onode),
+                  Array_Index => Index_Node,
+                  Array_Element => El_Node);
+            end;
+            return Res;
+         when Tok_Subarray =>
+            declare
+               Base_Node : Node_Acc;
+               Res_Type : O_Tnode;
+            begin
+               Next_Token;
+               Base_Node := Parse_Type;
+               Expect (Tok_Left_Brack);
+               Next_Token;
+               Res_Type := New_Constrained_Array_Type
+                 (Base_Node.Type_Onode,
+                  Parse_Constant_Value (Base_Node.Array_Index));
+               Expect (Tok_Right_Brack);
+               Next_Token;
+               Res := new Node' (Kind => Type_Subarray,
+                                 Type_Onode => Res_Type,
+                                 Subarray_Base => Base_Node);
+               return Res;
+            end;
+         when Tok_Ident =>
+            declare
+               Inter : Node_Acc;
+            begin
+               Inter := Get_Decl (Token_Sym);
+               if Inter = null then
+                  Parse_Error ("undefined type name symbol "
+                               & Get_String (Token_Sym.Ident));
+               end if;
+               if Inter.Kind /= Decl_Type then
+                  Parse_Error ("type declarator expected");
+               end if;
+               Res := Inter.Decl_Dtype;
+            end;
+         when Tok_Access =>
+            declare
+               Dtype : Node_Acc;
+            begin
+               Next_Token;
+               if Tok = Tok_Semicolon then
+                  Res := new Node'
+                    (Kind => Type_Access,
+                     Type_Onode => New_Access_Type (O_Tnode_Null),
+                     Access_Dtype => null);
+               else
+                  Dtype := Parse_Type;
+                  Res := new Node'
+                    (Kind => Type_Access,
+                     Type_Onode => New_Access_Type (Dtype.Type_Onode),
+                     Access_Dtype => Dtype);
+               end if;
+               return Res;
+            end;
+         when Tok_Record =>
+            Next_Token;
+            if Tok = Tok_Semicolon then
+               --  Uncomplete record type.
+               Res := new Node'(Kind => Type_Record,
+                                Type_Onode => O_Tnode_Null,
+                                Record_Union_Fields => null);
+               New_Uncomplete_Record_Type (Res.Type_Onode);
+               return Res;
+            end if;
+
+            Res := new Node'(Kind => Type_Record,
+                             Type_Onode => O_Tnode_Null,
+                             Record_Union_Fields => null);
+            Parse_Record_Type (Res);
+         when Tok_Union =>
+            Next_Token;
+            Res := new Node'(Kind => Type_Union,
+                             Type_Onode => O_Tnode_Null,
+                             Record_Union_Fields => null);
+            Parse_Union_Type (Res);
+
+         when Tok_Boolean =>
+            declare
+               False_Lit, True_Lit : Node_Acc;
+            begin
+               Res := new Node'(Kind => Type_Boolean,
+                                Type_Onode => O_Tnode_Null,
+                                Enum_Lits => null);
+               Next_Expect (Tok_Left_Brace, "'{' expected");
+               Next_Expect (Tok_Ident, "identifier expected");
+               False_Lit := new Node'(Kind => Node_Lit,
+                                      Decl_Dtype => Res,
+                                      Decl_Storage => O_Storage_Public,
+                                      Lit_Name => Token_Sym.Ident,
+                                      Lit_Cnode => O_Cnode_Null,
+                                      Lit_Next => null);
+               Next_Expect (Tok_Comma, "',' expected");
+               Next_Expect (Tok_Ident, "identifier expected");
+               True_Lit := new Node'(Kind => Node_Lit,
+                                     Decl_Dtype => Res,
+                                     Decl_Storage => O_Storage_Public,
+                                     Lit_Name => Token_Sym.Ident,
+                                     Lit_Cnode => O_Cnode_Null,
+                                     Lit_Next => null);
+               Next_Expect (Tok_Right_Brace, "'}' expected");
+               False_Lit.Lit_Next := True_Lit;
+               Res.Enum_Lits := False_Lit;
+               New_Boolean_Type (Res.Type_Onode,
+                                 False_Lit.Lit_Name, False_Lit.Lit_Cnode,
+                                 True_Lit.Lit_Name, True_Lit.Lit_Cnode);
+            end;
+         when Tok_Enum =>
+            declare
+               List : O_Enum_List;
+               Lit : Node_Acc;
+               Last_Lit : Node_Acc;
+            begin
+               Res := new Node'(Kind => Type_Enum,
+                                Type_Onode => O_Tnode_Null,
+                                Enum_Lits => null);
+               Last_Lit := null;
+               Push_Scope;
+               Next_Expect (Tok_Left_Brace);
+               Next_Token;
+               --  FIXME: set a size to the enum.
+               Start_Enum_Type (List, 8);
+               loop
+                  Expect (Tok_Ident);
+                  Lit := new Node'(Kind => Node_Lit,
+                                   Decl_Dtype => Res,
+                                   Decl_Storage => O_Storage_Public,
+                                   Lit_Name => Token_Sym.Ident,
+                                   Lit_Cnode => O_Cnode_Null,
+                                   Lit_Next => null);
+                  Add_Decl (Token_Sym, Lit);
+                  New_Enum_Literal (List, Lit.Lit_Name, Lit.Lit_Cnode);
+                  if Last_Lit = null then
+                     Res.Enum_Lits := Lit;
+                  else
+                     Last_Lit.Lit_Next := Lit;
+                  end if;
+                  Last_Lit := Lit;
+                  Next_Expect (Tok_Equal);
+                  Next_Expect (Tok_Num);
+                  Next_Token;
+                  exit when Tok = Tok_Right_Brace;
+                  Expect (Tok_Comma);
+                  Next_Token;
+               end loop;
+               Finish_Enum_Type (List, Res.Type_Onode);
+               Pop_Scope;
+            end;
+         when others =>
+            Parse_Error ("bad type " & Token_Type'Image (Tok));
+            return null;
+      end case;
+      Next_Token;
+      return Res;
+   end Parse_Type;
+
+   procedure Parse_Type_Completion (Decl : Node_Acc)
+   is
+   begin
+      case Tok is
+         when Tok_Record =>
+            Next_Token;
+            Parse_Record_Type (Decl.Decl_Dtype);
+            Next_Token;
+         when Tok_Access =>
+            Next_Token;
+            declare
+               Dtype : Node_Acc;
+            begin
+               Dtype := Parse_Type;
+               Decl.Decl_Dtype.Access_Dtype := Dtype;
+               Finish_Access_Type (Decl.Decl_Dtype.Type_Onode,
+                                   Dtype.Type_Onode);
+            end;
+         when others =>
+            Parse_Error ("'access' or 'record' expected");
+      end case;
+   end Parse_Type_Completion;
+
+--    procedure Parse_Declaration;
+
+   procedure Parse_Expression (Expr_Type : Node_Acc;
+                               Expr : out O_Enode;
+                               Res_Type : out Node_Acc);
+   procedure Parse_Name (Prefix : Node_Acc;
+                         Name : out O_Lnode; N_Type : out Node_Acc);
+   procedure Parse_Lvalue (N : in out O_Lnode; N_Type : in out Node_Acc);
+
+   --  Expect: '('
+   --  Let: next token.
+   procedure Parse_Association (Constr : in out O_Assoc_List;
+                                Decl : Node_Acc);
+
+   function Find_Field_By_Name (Aggr_Type : Node_Acc) return Node_Acc
+   is
+      Field : Node_Acc;
+   begin
+      Field := Aggr_Type.Record_Union_Fields;
+      while Field /= null loop
+         exit when Field.Field_Ident = Token_Sym;
+         Field := Field.Field_Next;
+      end loop;
+      if Field = null then
+         Parse_Error ("no such field name");
+      end if;
+      return Field;
+   end Find_Field_By_Name;
+
+   --  expect: offsetof id.
+   function Parse_Offsetof (Atype : Node_Acc) return O_Cnode
+   is
+      Rec_Type : Node_Acc;
+      Rec_Field : Node_Acc;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Expect (Tok_Ident);
+      Rec_Type := Get_Decl (Token_Sym);
+      if Rec_Type.Kind /= Decl_Type
+        or else Rec_Type.Decl_Dtype.Kind /= Type_Record
+      then
+         Parse_Error ("type name expected");
+      end if;
+      Next_Expect (Tok_Dot);
+      Next_Expect (Tok_Ident);
+      Rec_Field := Find_Field_By_Name (Rec_Type.Decl_Dtype);
+      Next_Expect (Tok_Right_Paren);
+      return New_Offsetof (Rec_Type.Decl_Dtype.Type_Onode,
+                           Rec_Field.Field_Fnode,
+                           Atype.Type_Onode);
+   end Parse_Offsetof;
+
+   function Parse_Sizeof (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Token;
+      if Tok /= Tok_Ident then
+         Parse_Error ("type name expected");
+      end if;
+      Res := New_Sizeof
+        (Get_Decl (Token_Sym).Decl_Dtype.Type_Onode,
+         Atype.Type_Onode);
+      Next_Expect (Tok_Right_Paren);
+      return Res;
+   end Parse_Sizeof;
+
+   function Parse_Alignof (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Token;
+      if Tok /= Tok_Ident then
+         Parse_Error ("type name expected");
+      end if;
+      Res := New_Alignof
+        (Get_Decl (Token_Sym).Decl_Dtype.Type_Onode,
+         Atype.Type_Onode);
+      Next_Expect (Tok_Right_Paren);
+      return Res;
+   end Parse_Alignof;
+
+   --  Parse a literal whose type is ATYPE.
+   function Parse_Typed_Literal (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      case Tok is
+         when Tok_Num =>
+            case Atype.Kind is
+               when Type_Signed =>
+                  Res := New_Signed_Literal
+                    (Atype.Type_Onode, Integer_64 (Token_Number));
+               when Type_Unsigned =>
+                  Res := New_Unsigned_Literal
+                    (Atype.Type_Onode, Token_Number);
+               when others =>
+                  Parse_Error ("bad type for integer literal");
+            end case;
+         when Tok_Minus =>
+            Next_Token;
+            case Tok is
+               when Tok_Num =>
+                  declare
+                     V : Integer_64;
+                  begin
+                     if Token_Number = Unsigned_64 (Integer_64'Last) + 1 then
+                        V := Integer_64'First;
+                     else
+                        V := -Integer_64 (Token_Number);
+                     end if;
+                     Res := New_Signed_Literal (Atype.Type_Onode, V);
+                  end;
+               when Tok_Float_Num =>
+                  Res := New_Float_Literal (Atype.Type_Onode, -Token_Float);
+               when others =>
+                  Parse_Error ("bad token after '-'");
+            end case;
+         when Tok_Float_Num =>
+            Res := New_Float_Literal (Atype.Type_Onode, Token_Float);
+         when Tok_Ident =>
+            declare
+               Pfx : Node_Acc;
+               N : Node_Acc;
+            begin
+               --  Note: we don't use get_decl, since the name can be a literal
+               --  name, which is not directly visible.
+               if Token_Sym.Name /= null
+                 and then Token_Sym.Name.Inter.Kind = Decl_Type
+               then
+                  --  A typed expression.
+                  Pfx := Token_Sym.Name.Inter;
+                  N := Pfx.Decl_Dtype;
+                  if Atype /= null and then N /= Atype then
+                     Parse_Error ("type mismatch");
+                  end if;
+                  Next_Expect (Tok_Tick);
+                  Next_Token;
+                  if Tok = Tok_Left_Brack then
+                     Next_Token;
+                     Res := Parse_Typed_Literal (N);
+                     Expect (Tok_Right_Brack);
+                  elsif Tok = Tok_Ident then
+                     if Token_Sym = Id_Offsetof then
+                        Res := Parse_Offsetof (N);
+                     elsif Token_Sym = Id_Sizeof then
+                        Res := Parse_Sizeof (N);
+                     elsif Token_Sym = Id_Alignof then
+                        Res := Parse_Alignof (N);
+                     elsif Token_Sym = Id_Address
+                       or Token_Sym = Id_Unchecked_Address
+                       or Token_Sym = Id_Subprg_Addr
+                     then
+                        Res := Parse_Constant_Address (Pfx);
+                     elsif Token_Sym = Id_Conv then
+                        Next_Expect (Tok_Left_Paren);
+                        Next_Token;
+                        Res := Parse_Typed_Literal (N);
+                        Expect (Tok_Right_Paren);
+                     else
+                        Parse_Error ("offsetof or sizeof attributes expected");
+                     end if;
+                  else
+                     Parse_Error ("'[' or attribute expected");
+                  end if;
+               else
+                  if Atype.Kind /= Type_Enum
+                    and then Atype.Kind /= Type_Boolean
+                  then
+                     Parse_Error ("name allowed only for enumeration");
+                  end if;
+                  N := Atype.Enum_Lits;
+                  while N /= null loop
+                     if Is_Equal (N.Lit_Name, Token_Sym.Ident) then
+                        Res := N.Lit_Cnode;
+                        exit;
+                     end if;
+                     N := N.Lit_Next;
+                  end loop;
+                  if N = null then
+                     Parse_Error ("no matching literal");
+                     return O_Cnode_Null;
+                  end if;
+               end if;
+            end;
+         when Tok_Null =>
+            Res := New_Null_Access (Atype.Type_Onode);
+         when others =>
+            Parse_Error ("bad primary expression: " & Token_Type'Image (Tok));
+            return O_Cnode_Null;
+      end case;
+      Next_Token;
+      return Res;
+   end Parse_Typed_Literal;
+
+   --  expect: next token
+   --  Parse an expression starting with NAME.
+   procedure Parse_Named_Expression
+     (Atype : Node_Acc; Name : Node_Acc; Stop_At_All : Boolean;
+                                         Res : out O_Enode;
+                                         Res_Type : out Node_Acc)
+   is
+   begin
+      if Tok = Tok_Tick then
+         Next_Token;
+         if Tok = Tok_Left_Brack then
+            --  Typed literal.
+            Next_Token;
+            Res := New_Lit (Parse_Typed_Literal (Name.Decl_Dtype));
+            Res_Type := Name.Decl_Dtype;
+            Expect (Tok_Right_Brack);
+            Next_Token;
+         elsif Tok = Tok_Left_Paren then
+            --  Typed expression (used for comparaison operators)
+            Next_Token;
+            Parse_Expression (Name.Decl_Dtype, Res, Res_Type);
+            Expect (Tok_Right_Paren);
+            Next_Token;
+         elsif Tok = Tok_Ident then
+            --  Attribute.
+            if Token_Sym = Id_Conv then
+               Next_Expect (Tok_Left_Paren);
+               Next_Token;
+               Parse_Expression (null, Res, Res_Type);
+               --  Discard Res_Type.
+               Expect (Tok_Right_Paren);
+               Next_Token;
+               Res_Type := Name.Decl_Dtype;
+               Res := New_Convert_Ov (Res, Res_Type.Type_Onode);
+               --  Fall-through.
+            elsif Token_Sym = Id_Address
+              or Token_Sym = Id_Unchecked_Address
+              or Token_Sym = Id_Subprg_Addr
+            then
+               Res_Type := Name.Decl_Dtype;
+               Res := Parse_Address (Name);
+               --  Fall-through.
+            elsif Token_Sym = Id_Sizeof then
+               Res_Type := Name.Decl_Dtype;
+               Res := New_Lit (Parse_Sizeof (Res_Type));
+               Next_Token;
+               return;
+            elsif Token_Sym = Id_Alignof then
+               Res_Type := Name.Decl_Dtype;
+               Res := New_Lit (Parse_Alignof (Res_Type));
+               Next_Token;
+               return;
+            elsif Token_Sym = Id_Alloca then
+               Next_Expect (Tok_Left_Paren);
+               Next_Token;
+               Parse_Expression (null, Res, Res_Type);
+               --  Discard Res_Type.
+               Res_Type := Name.Decl_Dtype;
+               Res := New_Alloca (Res_Type.Type_Onode, Res);
+               Expect (Tok_Right_Paren);
+               Next_Token;
+               return;
+            elsif Token_Sym = Id_Offsetof then
+               Res_Type := Atype;
+               Res := New_Lit (Parse_Offsetof (Res_Type));
+               Next_Token;
+               return;
+            else
+               Parse_Error ("unknown attribute name");
+            end if;
+            -- Fall-through.
+         else
+            Parse_Error ("typed expression expected");
+         end if;
+      elsif Tok = Tok_Left_Paren then
+         if Name.Kind /= Node_Function then
+            Parse_Error ("function name expected");
+         end if;
+         declare
+            Constr : O_Assoc_List;
+         begin
+            Parse_Association (Constr, Name);
+            Res := New_Function_Call (Constr);
+            Res_Type := Name.Decl_Dtype;
+            --  Fall-through.
+         end;
+      elsif Name.Kind = Node_Object
+        or else Name.Kind = Decl_Param
+      then
+         --  Name.
+         declare
+            Lval : O_Lnode;
+         begin
+            Parse_Name (Name, Lval, Res_Type);
+            Res := New_Value (Lval);
+         end;
+      else
+         Parse_Error ("bad ident expression: "
+                      & Token_Type'Image (Tok));
+      end if;
+
+      -- Continue.
+      --  R_TYPE and RES must be set.
+      if Tok = Tok_Dot then
+         if Stop_At_All then
+            return;
+         end if;
+         Next_Token;
+         if Tok = Tok_All then
+            if Res_Type.Kind /= Type_Access then
+               Parse_Error ("type of prefix is not an access");
+            end if;
+            declare
+               N : O_Lnode;
+            begin
+               Next_Token;
+               N := New_Access_Element (Res);
+               Res_Type := Res_Type.Access_Dtype;
+               Parse_Lvalue (N, Res_Type);
+               Res := New_Value (N);
+            end;
+            return;
+         else
+            Parse_Error ("'.all' expected");
+         end if;
+      end if;
+   end Parse_Named_Expression;
+
+   procedure Parse_Primary_Expression (Atype : Node_Acc;
+                                       Res : out O_Enode;
+                                       Res_Type : out Node_Acc)
+   is
+   begin
+      case Tok is
+         when Tok_Num
+           | Tok_Float_Num =>
+            if Atype = null then
+               Parse_Error ("numeric literal without type context");
+            end if;
+            Res_Type := Atype;
+            Res := New_Lit (Parse_Typed_Literal (Atype));
+         when Tok_Ident =>
+            declare
+               N : Node_Acc;
+            begin
+               N := Get_Decl (Token_Sym);
+               Next_Token;
+               Parse_Named_Expression (Atype, N, False, Res, Res_Type);
+            end;
+         when Tok_Left_Paren =>
+            Next_Token;
+            Parse_Expression (Atype, Res, Res_Type);
+            Expect (Tok_Right_Paren);
+            Next_Token;
+         when others =>
+            Parse_Error ("bad primary expression: " & Token_Type'Image (Tok));
+      end case;
+   end Parse_Primary_Expression;
+
+   --  Parse '-' EXPR, 'not' EXPR, 'abs' EXPR or EXPR.
+   procedure Parse_Unary_Expression (Atype : Node_Acc;
+                                     Res : out O_Enode;
+                                     Res_Type : out Node_Acc)
+   is
+   begin
+      case Tok is
+         when Tok_Minus =>
+            Next_Token;
+            Parse_Primary_Expression (Atype, Res, Res_Type);
+            Res := New_Monadic_Op (ON_Neg_Ov, Res);
+         when Tok_Not =>
+            Next_Token;
+            Parse_Unary_Expression (Atype, Res, Res_Type);
+            Res := New_Monadic_Op (ON_Not, Res);
+         when Tok_Abs =>
+            Next_Token;
+            Parse_Unary_Expression (Atype, Res, Res_Type);
+            Res := New_Monadic_Op (ON_Abs_Ov, Res);
+         when others =>
+            Parse_Primary_Expression (Atype, Res, Res_Type);
+      end case;
+   end Parse_Unary_Expression;
+
+   function Check_Sharp (Op_Ov : ON_Op_Kind) return ON_Op_Kind is
+   begin
+      Next_Expect (Tok_Sharp);
+      Next_Token;
+      return Op_Ov;
+   end Check_Sharp;
+
+   procedure Parse_Expression (Expr_Type : Node_Acc;
+                               Expr : out O_Enode;
+                               Res_Type : out Node_Acc)
+   is
+      Op_Type : Node_Acc;
+      L : O_Enode;
+      R : O_Enode;
+      Op : ON_Op_Kind;
+   begin
+      if Expr_Type = null or else Expr_Type.Kind = Type_Boolean then
+         --  The type of the expression isn't known, as this can be a
+         --  comparaison operator.
+         Op_Type := null;
+      else
+         Op_Type := Expr_Type;
+      end if;
+      Parse_Unary_Expression (Op_Type, L, Res_Type);
+      case Tok is
+         when Tok_Div =>
+            Op := Check_Sharp (ON_Div_Ov);
+         when Tok_Plus =>
+            Op := Check_Sharp (ON_Add_Ov);
+         when Tok_Minus =>
+            Op := Check_Sharp (ON_Sub_Ov);
+         when Tok_Star =>
+            Op := Check_Sharp (ON_Mul_Ov);
+         when Tok_Mod =>
+            Op := Check_Sharp (ON_Mod_Ov);
+         when Tok_Rem =>
+            Op := Check_Sharp (ON_Rem_Ov);
+
+         when Tok_Equal =>
+            Op := ON_Eq;
+         when Tok_Not_Equal =>
+            Op := ON_Neq;
+         when Tok_Greater =>
+            Op := ON_Gt;
+         when Tok_Greater_Eq =>
+            Op := ON_Ge;
+         when Tok_Less =>
+            Op := ON_Lt;
+         when Tok_Less_Eq =>
+            Op := ON_Le;
+
+         when Tok_Or =>
+            Op := ON_Or;
+            Next_Token;
+         when Tok_And =>
+            Op := ON_And;
+            Next_Token;
+         when Tok_Xor =>
+            Op := ON_Xor;
+            Next_Token;
+
+         when others =>
+            Expr := L;
+            return;
+      end case;
+      if Op in ON_Compare_Op_Kind then
+         Next_Token;
+      end if;
+
+      Parse_Unary_Expression (Res_Type, R, Res_Type);
+      case Op is
+         when ON_Dyadic_Op_Kind =>
+            Expr := New_Dyadic_Op (Op, L, R);
+         when ON_Compare_Op_Kind =>
+            if Expr_Type = null then
+               Parse_Error ("comparaison operator requires a type");
+            end if;
+            Expr := New_Compare_Op (Op, L, R, Expr_Type.Type_Onode);
+            Res_Type := Expr_Type;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Parse_Expression;
+
+   --  Expect and leave: next token
+   procedure Parse_Lvalue (N : in out O_Lnode; N_Type : in out Node_Acc)
+   is
+   begin
+      loop
+         case Tok is
+            when Tok_Dot =>
+               Next_Token;
+               if Tok = Tok_All then
+                  if N_Type.Kind /= Type_Access then
+                     Parse_Error ("type of prefix is not an access");
+                  end if;
+                  N := New_Access_Element (New_Value (N));
+                  N_Type := N_Type.Access_Dtype;
+                  Next_Token;
+               elsif Tok = Tok_Ident then
+                  if N_Type.Kind /= Type_Record and N_Type.Kind /= Type_Union
+                  then
+                     Parse_Error
+                       ("type of prefix is neither a record nor an union");
+                  end if;
+                  declare
+                     Field : Node_Acc;
+                  begin
+                     Field := Find_Field_By_Name (N_Type);
+                     N := New_Selected_Element (N, Field.Field_Fnode);
+                     N_Type := Field.Field_Type;
+                     Next_Token;
+                  end;
+               else
+                  Parse_Error
+                    ("'.' must be followed by 'all' or a field name");
+               end if;
+            when Tok_Left_Brack =>
+               declare
+                  V : O_Enode;
+                  Bt : Node_Acc;
+                  Res_Type : Node_Acc;
+               begin
+                  Next_Token;
+                  if N_Type.Kind = Type_Subarray then
+                     Bt := N_Type.Subarray_Base;
+                  else
+                     Bt := N_Type;
+                  end if;
+                  if Bt.Kind /= Type_Array then
+                     Parse_Error ("type of prefix is not an array");
+                  end if;
+                  Parse_Expression (Bt.Array_Index, V, Res_Type);
+                  if Tok = Tok_Elipsis then
+                     N := New_Slice (N, Bt.Type_Onode, V);
+                     Next_Token;
+                  else
+                     N := New_Indexed_Element (N, V);
+                     N_Type := Bt.Array_Element;
+                  end if;
+                  Expect (Tok_Right_Brack);
+                  Next_Token;
+               end;
+            when others =>
+               return;
+         end case;
+      end loop;
+   end Parse_Lvalue;
+
+   procedure Parse_Name (Prefix : Node_Acc;
+                         Name : out O_Lnode; N_Type : out Node_Acc)
+   is
+   begin
+      case Prefix.Kind is
+         when Decl_Param =>
+            Name := New_Obj (Prefix.Param_Node);
+            N_Type := Prefix.Decl_Dtype;
+         when Node_Object =>
+            Name := New_Obj (Prefix.Obj_Node);
+            N_Type := Prefix.Decl_Dtype;
+         when Decl_Type =>
+            declare
+               Val : O_Enode;
+            begin
+               Parse_Named_Expression (null, Prefix, True, Val, N_Type);
+               if N_Type /= Prefix.Decl_Dtype then
+                  Parse_Error ("type doesn't match");
+               end if;
+               if Tok = Tok_Dot then
+                  Next_Token;
+                  if Tok = Tok_All then
+                     if N_Type.Kind /= Type_Access then
+                        Parse_Error ("type of prefix is not an access");
+                     end if;
+                     Name := New_Access_Element (Val);
+                     N_Type := N_Type.Access_Dtype;
+                     Next_Token;
+                  else
+                     Parse_Error ("'.all' expected");
+                  end if;
+               else
+                  Parse_Error ("name expected");
+               end if;
+            end;
+         when others =>
+            Parse_Error ("invalid name");
+      end case;
+      Parse_Lvalue (Name, N_Type);
+   end Parse_Name;
+
+   --  Expect: '('
+   --  Let: next token.
+   procedure Parse_Association (Constr : in out O_Assoc_List; Decl : Node_Acc)
+   is
+      Param : Node_Acc;
+      Expr : O_Enode;
+      Expr_Type : Node_Acc;
+   begin
+      Start_Association (Constr, Decl.Subprg_Node);
+      if Tok /= Tok_Left_Paren then
+         Parse_Error ("'(' expected for a subprogram call");
+      end if;
+      Next_Token;
+      Param := Decl.Subprg_Params;
+      while Tok /= Tok_Right_Paren loop
+         if Param = null then
+            Parse_Error ("too many parameters");
+         end if;
+         Parse_Expression (Param.Decl_Dtype, Expr, Expr_Type);
+         New_Association (Constr, Expr);
+         Param := Param.Param_Next;
+         exit when Tok /= Tok_Comma;
+         Next_Token;
+      end loop;
+      if Param /= null then
+         Parse_Error ("missing parameters");
+      end if;
+      if Tok /= Tok_Right_Paren then
+         Parse_Error ("')' expected to finish a subprogram call, found "
+                      & Token_Type'Image (Tok));
+      end if;
+      Next_Token;
+   end Parse_Association;
+
+   type Loop_Info;
+   type Loop_Info_Acc is access Loop_Info;
+   type Loop_Info is record
+      Num : Natural;
+      Blk : O_Snode;
+      Prev : Loop_Info_Acc;
+   end record;
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => Loop_Info_Acc, Object => Loop_Info);
+
+   Loop_Stack : Loop_Info_Acc := null;
+
+   function Find_Loop (N : Natural) return Loop_Info_Acc
+   is
+      Res : Loop_Info_Acc;
+   begin
+      Res := Loop_Stack;
+      while Res /= null loop
+         if Res.Num = N then
+            return Res;
+         end if;
+         Res := Res.Prev;
+      end loop;
+      return null;
+   end Find_Loop;
+
+   Current_Subprg : Node_Acc := null;
+
+   procedure Parse_Statement;
+
+   --  Expect : next token
+   --  Let: next token
+   procedure Parse_Statements is
+   begin
+      loop
+         exit when Tok = Tok_End;
+         exit when Tok = Tok_Else;
+         exit when Tok = Tok_When;
+         Parse_Statement;
+      end loop;
+   end Parse_Statements;
+
+   --  Expect : next token
+   --  Let: next token
+   procedure Parse_Statement is
+   begin
+      if Flag_Renumber then
+         New_Debug_Line_Stmt (Lineno);
+      end if;
+
+      case Tok is
+         when Tok_Comment =>
+            Next_Token;
+
+         when Tok_Declare =>
+            Start_Declare_Stmt;
+            Parse_Compound_Statement;
+            Expect (Tok_Semicolon);
+            Next_Token;
+            Finish_Declare_Stmt;
+
+         when Tok_Line_Number =>
+            Next_Expect (Tok_Num);
+            if Flag_Renumber = False then
+               New_Debug_Line_Stmt (Natural (Token_Number));
+            end if;
+            Next_Token;
+
+         when Tok_If =>
+            declare
+               If_Blk : O_If_Block;
+               Cond : O_Enode;
+               Cond_Type : Node_Acc;
+            begin
+               Next_Token;
+               Parse_Expression (null, Cond, Cond_Type);
+               Start_If_Stmt (If_Blk, Cond);
+               Expect (Tok_Then);
+               Next_Token;
+               Parse_Statements;
+               if Tok = Tok_Else then
+                  Next_Token;
+                  New_Else_Stmt (If_Blk);
+                  Parse_Statements;
+               end if;
+               Finish_If_Stmt (If_Blk);
+               Expect (Tok_End);
+               Next_Expect (Tok_If);
+               Next_Expect (Tok_Semicolon);
+               Next_Token;
+            end;
+
+         when Tok_Loop =>
+            declare
+               Info : Loop_Info_Acc;
+               Num : Natural;
+            begin
+               Next_Expect (Tok_Num);
+               Num := Natural (Token_Number);
+               if Find_Loop (Num) /= null then
+                  Parse_Error ("loop label already defined");
+               end if;
+               Info := new Loop_Info;
+               Info.Num := Num;
+               Info.Prev := Loop_Stack;
+               Loop_Stack := Info;
+               Start_Loop_Stmt (Info.Blk);
+               Next_Expect (Tok_Colon);
+               Next_Token;
+               Parse_Statements;
+               Finish_Loop_Stmt (Info.Blk);
+               Next_Expect (Tok_Loop);
+               Next_Expect (Tok_Semicolon);
+               Loop_Stack := Info.Prev;
+               Free (Info);
+               Next_Token;
+            end;
+
+         when Tok_Exit
+           | Tok_Next =>
+            declare
+               Label : Loop_Info_Acc;
+               Etok : Token_Type;
+            begin
+               Etok := Tok;
+               Next_Expect (Tok_Loop);
+               Next_Expect (Tok_Num);
+               Label := Find_Loop (Natural (Token_Number));
+               if Label = null then
+                  Parse_Error ("no such loop");
+               end if;
+               if Etok = Tok_Exit then
+                  New_Exit_Stmt (Label.Blk);
+               else
+                  New_Next_Stmt (Label.Blk);
+               end if;
+               Next_Expect (Tok_Semicolon);
+               Next_Token;
+            end;
+
+         when Tok_Return =>
+            declare
+               Res : O_Enode;
+               Res_Type : Node_Acc;
+            begin
+               Next_Token;
+               if Tok /= Tok_Semicolon then
+                  Parse_Expression (Current_Subprg.Decl_Dtype, Res, Res_Type);
+                  New_Return_Stmt (Res);
+                  if Tok /= Tok_Semicolon then
+                     Parse_Error ("';' expected at end of return statement");
+                  end if;
+               else
+                  New_Return_Stmt;
+               end if;
+               Next_Token;
+            end;
+
+         when Tok_Ident =>
+            --  This is either a procedure call or an assignment.
+            declare
+               Inter : Node_Acc;
+            begin
+               Inter := Get_Decl (Token_Sym);
+               Next_Token;
+               if Tok = Tok_Left_Paren then
+                  --  A procedure call.
+                  declare
+                     Constr : O_Assoc_List;
+                  begin
+                     Parse_Association (Constr, Inter);
+                     New_Procedure_Call (Constr);
+                     if Tok /= Tok_Semicolon then
+                        Parse_Error ("';' expected after call");
+                     end if;
+                     Next_Token;
+                     return;
+                  end;
+               else
+                  --  An assignment.
+                  declare
+                     Name : O_Lnode;
+                     Expr : O_Enode;
+                     Expr_Type : Node_Acc;
+                     N_Type : Node_Acc;
+                  begin
+                     Parse_Name (Inter, Name, N_Type);
+                     if Tok /= Tok_Assign then
+                        Parse_Error ("`:=' expected after a variable");
+                     end if;
+                     Next_Token;
+                     Parse_Expression (N_Type, Expr, Expr_Type);
+                     New_Assign_Stmt (Name, Expr);
+                     if Tok /= Tok_Semicolon then
+                        Parse_Error ("';' expected at end of assignment");
+                     end if;
+                     Next_Token;
+                     return;
+                  end;
+               end if;
+            end;
+
+         when Tok_Case =>
+            declare
+               Case_Blk : O_Case_Block;
+               L : O_Cnode;
+               Choice : O_Enode;
+               Choice_Type : Node_Acc;
+            begin
+               Next_Token;
+               Parse_Expression (null, Choice, Choice_Type);
+               Start_Case_Stmt (Case_Blk, Choice);
+               Expect (Tok_Is);
+               Next_Token;
+               loop
+                  exit when Tok = Tok_End;
+                  Expect (Tok_When);
+                  Next_Token;
+                  Start_Choice (Case_Blk);
+                  loop
+                     if Tok = Tok_Default then
+                        New_Default_Choice (Case_Blk);
+                        Next_Token;
+                     else
+                        L := Parse_Typed_Literal (Choice_Type);
+                        if Tok = Tok_Elipsis then
+                           Next_Token;
+                           New_Range_Choice
+                             (Case_Blk, L, Parse_Typed_Literal (Choice_Type));
+                        else
+                           New_Expr_Choice (Case_Blk, L);
+                        end if;
+                     end if;
+                     exit when Tok = Tok_Arrow;
+                     Expect (Tok_Comma);
+                     Next_Token;
+                  end loop;
+                  --  Skip '=>'.
+                  Next_Token;
+                  Finish_Choice (Case_Blk);
+                  Parse_Statements;
+               end loop;
+               Finish_Case_Stmt (Case_Blk);
+               Expect (Tok_End);
+               Next_Expect (Tok_Case);
+               Next_Expect (Tok_Semicolon);
+               Next_Token;
+            end;
+         when others =>
+            Parse_Error ("bad statement: " & Token_Type'Image (Tok));
+      end case;
+   end Parse_Statement;
+
+   procedure Parse_Compound_Statement is
+   begin
+      if Tok /= Tok_Declare then
+         Parse_Error ("'declare' expected to start a statements block");
+      end if;
+      Next_Token;
+
+      Push_Scope;
+
+      --  Parse declarations.
+      while Tok /= Tok_Begin loop
+         Parse_Declaration;
+      end loop;
+      Next_Token;
+
+      --  Parse statements.
+      Parse_Statements;
+      Expect (Tok_End);
+      Next_Token;
+
+      Pop_Scope;
+   end Parse_Compound_Statement;
+
+   --  Parse (P1 : T1; P2: T2; ...)
+   function Parse_Parameter_List return Node_Acc
+   is
+      First, Last : Node_Acc;
+      P : Node_Acc;
+   begin
+      Expect (Tok_Left_Paren);
+      Next_Token;
+      if Tok = Tok_Right_Paren then
+         Next_Token;
+         return null;
+      end if;
+      First := null;
+      Last := null;
+      loop
+         Expect (Tok_Ident);
+         P := new Node'(Kind => Decl_Param,
+                        Decl_Dtype => null,
+                        Decl_Storage => O_Storage_Public,
+                        Param_Node => O_Dnode_Null,
+                        Param_Name => Token_Sym,
+                        Param_Next => null);
+         --  Link
+         if Last = null then
+            First := P;
+         else
+            Last.Param_Next := P;
+         end if;
+         Last := P;
+         Next_Expect (Tok_Colon);
+         Next_Token;
+         P.Decl_Dtype := Parse_Type;
+         exit when Tok = Tok_Right_Paren;
+         Expect (Tok_Semicolon);
+         Next_Token;
+      end loop;
+      Next_Token;
+      return First;
+   end Parse_Parameter_List;
+
+   procedure Create_Interface_List (Constr : in out O_Inter_List;
+                                    First_Inter : Node_Acc)
+   is
+      Inter : Node_Acc;
+   begin
+      Inter := First_Inter;
+      while Inter /= null loop
+         New_Interface_Decl (Constr, Inter.Param_Node, Inter.Param_Name.Ident,
+                             Inter.Decl_Dtype.Type_Onode);
+         Inter := Inter.Param_Next;
+      end loop;
+   end Create_Interface_List;
+
+   procedure Check_Parameter_List (List : Node_Acc)
+   is
+      Param : Node_Acc;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Token;
+      Param := List;
+      while Tok /= Tok_Right_Paren loop
+         if Param = null then
+            Parse_Error ("subprogram redefined with more parameters");
+         end if;
+         Expect (Tok_Ident);
+         if Token_Sym /= Param.Param_Name then
+            Parse_Error ("subprogram redefined with different parameter name");
+         end if;
+         Next_Expect (Tok_Colon);
+         Next_Token;
+         if Parse_Type /= Param.Decl_Dtype then
+            Parse_Error ("subprogram redefined with different parameter type");
+         end if;
+         Param := Param.Param_Next;
+         exit when Tok = Tok_Right_Paren;
+         Expect (Tok_Semicolon);
+         Next_Token;
+      end loop;
+      Expect (Tok_Right_Paren);
+      Next_Token;
+      if Param /= null then
+         Parse_Error ("subprogram redefined with less parameters");
+      end if;
+   end Check_Parameter_List;
+
+   procedure Parse_Subprogram_Body (Subprg : Node_Acc)
+   is
+      Param : Node_Acc;
+      Prev_Subprg : Node_Acc;
+   begin
+      Prev_Subprg := Current_Subprg;
+      Current_Subprg := Subprg;
+
+      Start_Subprogram_Body (Subprg.Subprg_Node);
+      Push_Scope;
+
+      --  Put parameters in the current scope.
+      Param := Subprg.Subprg_Params;
+      while Param /= null loop
+         Add_Decl (Param.Param_Name, Param);
+         Param := Param.Param_Next;
+      end loop;
+
+      Parse_Compound_Statement;
+
+      Pop_Scope;
+      Finish_Subprogram_Body;
+
+      Current_Subprg := Prev_Subprg;
+   end Parse_Subprogram_Body;
+
+   procedure Parse_Function_Definition (Storage : O_Storage)
+   is
+      Constr : O_Inter_List;
+      Sym : Syment_Acc;
+      N : Node_Acc;
+   begin
+      Expect (Tok_Function);
+      Next_Expect (Tok_Ident);
+      Sym := Token_Sym;
+      if Sym.Name /= null then
+         N := Get_Decl (Sym);
+         Check_Parameter_List (N.Subprg_Params);
+         Expect (Tok_Return);
+         Next_Expect (Tok_Ident);
+         Next_Token;
+      else
+         N := new Node'(Kind => Node_Function,
+                        Decl_Dtype => null,
+                        Decl_Storage => Storage,
+                        Subprg_Node => O_Dnode_Null,
+                        Subprg_Name => Sym,
+                        Subprg_Params => null);
+         Next_Token;
+         N.Subprg_Params := Parse_Parameter_List;
+         Expect (Tok_Return);
+         Next_Token;
+         N.Decl_Dtype := Parse_Type;
+
+         Start_Function_Decl (Constr, N.Subprg_Name.Ident, Storage,
+                              N.Decl_Dtype.Type_Onode);
+         Create_Interface_List (Constr, N.Subprg_Params);
+         Finish_Subprogram_Decl (Constr, N.Subprg_Node);
+
+         Add_Decl (Sym, N);
+      end if;
+
+      if Tok = Tok_Declare then
+         Parse_Subprogram_Body (N);
+      end if;
+   end Parse_Function_Definition;
+
+   procedure Parse_Procedure_Definition (Storage : O_Storage)
+   is
+      Constr : O_Inter_List;
+      Sym : Syment_Acc;
+      N : Node_Acc;
+   begin
+      Expect (Tok_Procedure);
+      Next_Expect (Tok_Ident);
+      Sym := Token_Sym;
+      if Sym.Name /= null then
+         N := Get_Decl (Sym);
+         Check_Parameter_List (N.Subprg_Params);
+      else
+         N := new Node'(Kind => Node_Procedure,
+                        Decl_Dtype => null,
+                        Decl_Storage => Storage,
+                        Subprg_Node => O_Dnode_Null,
+                        Subprg_Name => Sym,
+                        Subprg_Params => null);
+         Next_Token;
+         N.Subprg_Params := Parse_Parameter_List;
+
+         Start_Procedure_Decl (Constr, N.Subprg_Name.Ident, Storage);
+         Create_Interface_List (Constr, N.Subprg_Params);
+         Finish_Subprogram_Decl (Constr, N.Subprg_Node);
+
+         Add_Decl (Sym, N);
+      end if;
+
+      if Tok = Tok_Declare then
+         Parse_Subprogram_Body (N);
+      end if;
+   end Parse_Procedure_Definition;
+
+   function Parse_Address (Prefix : Node_Acc) return O_Enode
+   is
+      Pfx : Node_Acc;
+      N : O_Lnode;
+      N_Type : Node_Acc;
+      Res : O_Enode;
+      Attr : Syment_Acc;
+      T : O_Tnode;
+   begin
+      Attr := Token_Sym;
+      Next_Expect (Tok_Left_Paren);
+      Next_Expect (Tok_Ident);
+      Pfx := Get_Decl (Token_Sym);
+      T := Prefix.Decl_Dtype.Type_Onode;
+      if Attr = Id_Subprg_Addr then
+         Expect (Tok_Ident);
+         Pfx := Get_Decl (Token_Sym);
+         if Pfx.Kind not in Nodes_Subprogram then
+            Parse_Error ("subprogram identifier expected");
+         end if;
+         Res := New_Lit (New_Subprogram_Address (Pfx.Subprg_Node, T));
+         Next_Token;
+      else
+         Next_Token;
+         Parse_Name (Pfx, N, N_Type);
+         if Attr = Id_Address then
+            Res := New_Address (N, T);
+         elsif Attr = Id_Unchecked_Address then
+            Res := New_Unchecked_Address (N, T);
+         else
+            Parse_Error ("address attribute expected");
+         end if;
+      end if;
+      Expect (Tok_Right_Paren);
+      Next_Token;
+      return Res;
+   end Parse_Address;
+
+   function Parse_Constant_Address (Prefix : Node_Acc) return O_Cnode
+   is
+      Pfx : Node_Acc;
+      Res : O_Cnode;
+      Attr : Syment_Acc;
+      T : O_Tnode;
+   begin
+      Attr := Token_Sym;
+      Next_Expect (Tok_Left_Paren);
+      Next_Expect (Tok_Ident);
+      Pfx := Get_Decl (Token_Sym);
+      T := Prefix.Decl_Dtype.Type_Onode;
+      if Attr = Id_Subprg_Addr then
+         Expect (Tok_Ident);
+         Pfx := Get_Decl (Token_Sym);
+         if Pfx.Kind not in Nodes_Subprogram then
+            Parse_Error ("subprogram identifier expected");
+         end if;
+         Res := New_Subprogram_Address (Pfx.Subprg_Node, T);
+         Next_Token;
+      else
+         Next_Token;
+         if Attr = Id_Address then
+            Res := New_Global_Address (Pfx.Obj_Node, T);
+         elsif Attr = Id_Unchecked_Address then
+            Res := New_Global_Unchecked_Address (Pfx.Obj_Node, T);
+         else
+            Parse_Error ("address attribute expected");
+         end if;
+      end if;
+      Expect (Tok_Right_Paren);
+      return Res;
+   end Parse_Constant_Address;
+
+   function Parse_Constant_Value (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      case Atype.Kind is
+         when Type_Subarray =>
+            declare
+               Constr : O_Array_Aggr_List;
+               El : Node_Acc;
+            begin
+               Expect (Tok_Left_Brace);
+               Next_Token;
+               Start_Array_Aggr (Constr, Atype.Type_Onode);
+               El := Atype.Subarray_Base.Array_Element;
+               for I in Natural loop
+                  exit when Tok = Tok_Right_Brace;
+                  if I /= 0 then
+                     Expect (Tok_Comma);
+                     Next_Token;
+                  end if;
+                  New_Array_Aggr_El (Constr, Parse_Constant_Value (El));
+               end loop;
+               Finish_Array_Aggr (Constr, Res);
+               Next_Token;
+               return Res;
+            end;
+         when Type_Unsigned
+           | Type_Signed
+           | Type_Enum
+           | Type_Float
+           | Type_Boolean
+           | Type_Access =>
+            --return Parse_Primary_Expression (Atype);
+            return Parse_Typed_Literal (Atype);
+         when Type_Record =>
+            declare
+               Constr : O_Record_Aggr_List;
+               Field : Node_Acc;
+            begin
+               Expect (Tok_Left_Brace);
+               Next_Token;
+               Start_Record_Aggr (Constr, Atype.Type_Onode);
+               Field := Atype.Record_Union_Fields;
+               while Field /= null loop
+                  if Tok = Tok_Dot then
+                     Next_Expect (Tok_Ident);
+                     if Token_Sym /= Field.Field_Ident then
+                        Parse_Error ("bad field name");
+                     end if;
+                     Next_Expect (Tok_Equal);
+                     Next_Token;
+                  end if;
+                  New_Record_Aggr_El
+                    (Constr, Parse_Constant_Value (Field.Field_Type));
+                  Field := Field.Field_Next;
+                  if Field /= null then
+                     Expect (Tok_Comma);
+                     Next_Token;
+                  end if;
+               end loop;
+               Finish_Record_Aggr (Constr, Res);
+               Expect (Tok_Right_Brace);
+               Next_Token;
+               return Res;
+            end;
+         when Type_Union =>
+            declare
+               Field : Node_Acc;
+            begin
+               Expect (Tok_Left_Brace);
+               Next_Token;
+               Expect (Tok_Dot);
+               Next_Expect (Tok_Ident);
+               Field := Find_Field_By_Name (Atype);
+               Next_Expect (Tok_Equal);
+               Next_Token;
+               Res := New_Union_Aggr
+                 (Atype.Type_Onode, Field.Field_Fnode,
+                  Parse_Constant_Value (Field.Field_Type));
+               Expect (Tok_Right_Brace);
+               Next_Token;
+               return Res;
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Parse_Constant_Value;
+
+   procedure Parse_Constant_Declaration (Storage : O_Storage)
+   is
+      N : Node_Acc;
+      Sym : Syment_Acc;
+      --Val : O_Cnode;
+   begin
+      Expect (Tok_Constant);
+      Next_Expect (Tok_Ident);
+      Sym := Token_Sym;
+      N := new Node'(Kind => Node_Object,
+                     Decl_Dtype => null,
+                     Decl_Storage => Storage,
+                     Obj_Name => Sym.Ident,
+                     Obj_Node => O_Dnode_Null);
+      Next_Expect (Tok_Colon);
+      Next_Token;
+      N.Decl_Dtype := Parse_Type;
+      New_Const_Decl (N.Obj_Node, Sym.Ident, Storage, N.Decl_Dtype.Type_Onode);
+      Add_Decl (Sym, N);
+
+--        if Storage /= O_Storage_External then
+--           Expect (Tok_Assign);
+--           Next_Token;
+--           Start_Const_Value (N.Obj_Node);
+--           Val := Parse_Constant_Value (N.Decl_Dtype);
+--           Finish_Const_Value (N.Obj_Node, Val);
+--        end if;
+   end Parse_Constant_Declaration;
+
+   procedure Parse_Constant_Value_Declaration
+   is
+      N : Node_Acc;
+      Val : O_Cnode;
+   begin
+      Next_Expect (Tok_Ident);
+      N := Get_Decl (Token_Sym);
+      if N.Kind /= Node_Object then
+         Parse_Error ("name of a constant expected");
+      end if;
+      --  FIXME: should check storage,
+      --         should check the object is a constant,
+      --         should check the object has no value.
+      Next_Expect (Tok_Assign);
+      Next_Token;
+      Start_Const_Value (N.Obj_Node);
+      Val := Parse_Constant_Value (N.Decl_Dtype);
+      Finish_Const_Value (N.Obj_Node, Val);
+   end Parse_Constant_Value_Declaration;
+
+   procedure Parse_Var_Declaration (Storage : O_Storage)
+   is
+      N : Node_Acc;
+      Sym : Syment_Acc;
+   begin
+      Expect (Tok_Var);
+      Next_Expect (Tok_Ident);
+      Sym := Token_Sym;
+      N := new Node'(Kind => Node_Object,
+                     Decl_Dtype => null,
+                     Decl_Storage => Storage,
+                     Obj_Name => Sym.Ident,
+                     Obj_Node => O_Dnode_Null);
+      Next_Expect (Tok_Colon);
+      Next_Token;
+      N.Decl_Dtype := Parse_Type;
+      New_Var_Decl (N.Obj_Node, Sym.Ident, Storage, N.Decl_Dtype.Type_Onode);
+      Add_Decl (Sym, N);
+   end Parse_Var_Declaration;
+
+   procedure Parse_Stored_Decl (Storage : O_Storage)
+   is
+   begin
+      Next_Token;
+      if Tok = Tok_Function then
+         Parse_Function_Definition (Storage);
+      elsif Tok = Tok_Procedure then
+         Parse_Procedure_Definition (Storage);
+      elsif Tok = Tok_Constant then
+         Parse_Constant_Declaration (Storage);
+      elsif Tok = Tok_Var then
+         Parse_Var_Declaration (Storage);
+      else
+         Parse_Error ("function declaration expected");
+      end if;
+   end Parse_Stored_Decl;
+
+   procedure Parse_Declaration
+   is
+      Inter : Node_Acc;
+      S : Syment_Acc;
+   begin
+      if Flag_Renumber then
+         New_Debug_Line_Decl (Lineno);
+      end if;
+
+      case Tok is
+         when Tok_Type =>
+            Next_Token;
+            if Tok /= Tok_Ident then
+               Parse_Error ("identifier for type expected");
+            end if;
+            S := Token_Sym;
+            Next_Expect (Tok_Is);
+            Next_Token;
+            if Is_Defined (S) then
+               Parse_Type_Completion (Get_Decl (S));
+            else
+               Inter := new Node'(Kind => Decl_Type,
+                                  Decl_Storage => O_Storage_Public,
+                                  Decl_Dtype => Parse_Type);
+               Add_Decl (S, Inter);
+               New_Type_Decl (S.Ident, Inter.Decl_Dtype.Type_Onode);
+            end if;
+         when Tok_External =>
+            Parse_Stored_Decl (O_Storage_External);
+         when Tok_Private =>
+            Parse_Stored_Decl (O_Storage_Private);
+         when Tok_Public =>
+            Parse_Stored_Decl (O_Storage_Public);
+         when Tok_Local =>
+            Parse_Stored_Decl (O_Storage_Local);
+         when Tok_Constant =>
+            Parse_Constant_Value_Declaration;
+         when Tok_Comment =>
+            New_Debug_Comment_Decl (Token_Ident (1 .. Token_Idlen));
+            Next_Token;
+            return;
+         when Tok_File_Name =>
+            if Flag_Renumber = False then
+               New_Debug_Filename_Decl (Token_Ident (1 .. Token_Idlen));
+            end if;
+            Next_Token;
+            return;
+         when others =>
+            Parse_Error ("declaration expected");
+      end case;
+      Expect (Tok_Semicolon);
+      Next_Token;
+   end Parse_Declaration;
+
+--    procedure Put (Str : String)
+--    is
+--       L : Integer;
+--    begin
+--       L := Write (Standout, Str'Address, Str'Length);
+--    end Put;
+
+   function Parse (Filename : String_Acc) return Boolean
+   is
+   begin
+      --  Initialize symbol table.
+      Add_Keyword ("type", Tok_Type);
+      Add_Keyword ("return", Tok_Return);
+      Add_Keyword ("if", Tok_If);
+      Add_Keyword ("then", Tok_Then);
+      Add_Keyword ("else", Tok_Else);
+      Add_Keyword ("elsif", Tok_Elsif);
+      Add_Keyword ("loop", Tok_Loop);
+      Add_Keyword ("exit", Tok_Exit);
+      Add_Keyword ("next", Tok_Next);
+      Add_Keyword ("signed", Tok_Signed);
+      Add_Keyword ("unsigned", Tok_Unsigned);
+      Add_Keyword ("float", Tok_Float);
+      Add_Keyword ("is", Tok_Is);
+      Add_Keyword ("of", Tok_Of);
+      Add_Keyword ("all", Tok_All);
+      Add_Keyword ("not", Tok_Not);
+      Add_Keyword ("abs", Tok_Abs);
+      Add_Keyword ("or", Tok_Or);
+      Add_Keyword ("and", Tok_And);
+      Add_Keyword ("xor", Tok_Xor);
+      Add_Keyword ("mod", Tok_Mod);
+      Add_Keyword ("rem", Tok_Rem);
+      Add_Keyword ("array", Tok_Array);
+      Add_Keyword ("access", Tok_Access);
+      Add_Keyword ("record", Tok_Record);
+      Add_Keyword ("union", Tok_Union);
+      Add_Keyword ("end", Tok_End);
+      Add_Keyword ("boolean", Tok_Boolean);
+      Add_Keyword ("enum", Tok_Enum);
+      Add_Keyword ("external", Tok_External);
+      Add_Keyword ("private", Tok_Private);
+      Add_Keyword ("public", Tok_Public);
+      Add_Keyword ("local", Tok_Local);
+      Add_Keyword ("procedure", Tok_Procedure);
+      Add_Keyword ("function", Tok_Function);
+      Add_Keyword ("constant", Tok_Constant);
+      Add_Keyword ("var", Tok_Var);
+      Add_Keyword ("subarray", Tok_Subarray);
+      Add_Keyword ("declare", Tok_Declare);
+      Add_Keyword ("begin", Tok_Begin);
+      Add_Keyword ("end", Tok_End);
+      Add_Keyword ("null", Tok_Null);
+      Add_Keyword ("case", Tok_Case);
+      Add_Keyword ("when", Tok_When);
+      Add_Keyword ("default", Tok_Default);
+
+      Id_Address := New_Symbol ("address");
+      Id_Unchecked_Address := New_Symbol ("unchecked_address");
+      Id_Subprg_Addr := New_Symbol ("subprg_addr");
+      Id_Conv := New_Symbol ("conv");
+      Id_Sizeof := New_Symbol ("sizeof");
+      Id_Alignof := New_Symbol ("alignof");
+      Id_Alloca := New_Symbol ("alloca");
+      Id_Offsetof := New_Symbol ("offsetof");
+
+      --  Initialize the scanner.
+      Buf (1) := NUL;
+      Pos := 1;
+      Lineno := 1;
+      if Filename = null then
+         Fd := Standin;
+         File_Name := new String'("*stdin*");
+      else
+         declare
+            Name : String (1 .. Filename'Length + 1);
+            --("C:\cygwin\home\tgingold\src\ortho\x86\tests\olang\ex2.ol",
+         begin
+            Name (1 .. Filename'Length) := Filename.all;
+            Name (Name'Last) := NUL;
+            File_Name := Filename;
+            Fd := Open_Read (Name'Address, Text);
+            if Fd = Invalid_FD then
+               Puterr ("cannot open '" & Filename.all & ''');
+               Newline_Err;
+               return False;
+            end if;
+         end;
+      end if;
+
+      New_Debug_Filename_Decl (File_Name.all);
+
+      Push_Scope;
+      Next_Token;
+      while Tok /= Tok_Eof loop
+         Parse_Declaration;
+      end loop;
+      Pop_Scope;
+
+      if Fd /= Standin then
+         Close (Fd);
+      end if;
+      return True;
+   exception
+      when E : others =>
+         Puterr (Ada.Exceptions.Exception_Information (E));
+         raise;
+   end Parse;
+end Ortho_Front;
diff --git a/src/ortho/ortho_front.ads b/src/ortho/ortho_front.ads
new file mode 100644
index 000000000..1d20e15d7
--- /dev/null
+++ b/src/ortho/ortho_front.ads
@@ -0,0 +1,41 @@
+--  Ortho front-end specifications.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Ortho_Front is
+   type String_Acc is access String;
+
+   --  Called before decode_option.
+   --  This procedure can only do internal initializations.  It cannot call
+   --  ortho subprograms.
+   procedure Init;
+
+   --  An ortho back-end decodes the command line.  Unknown options may
+   --  be decoded by the user, with this function.
+   --  When an ortho back-end encounter an unknown option, it sets OPT with
+   --  this option and ARG with the next one, if any.
+   --
+   --  DECODE_OPTION must return the number of argument used, ie:
+   --   0 if OPT is unknown.
+   --   1 if OPT is known but ARG is unused.
+   --   2 if OPT is known and ARG used.
+   function Decode_Option (Opt : String_Acc; Arg : String_Acc) return Natural;
+
+   --  Start to parse file FILENAME.
+   --  Return False in case of error.
+   function Parse (Filename : String_Acc) return Boolean;
+end Ortho_Front;
diff --git a/src/ortho/ortho_jit.ads b/src/ortho/ortho_jit.ads
new file mode 100644
index 000000000..89c3663f3
--- /dev/null
+++ b/src/ortho/ortho_jit.ads
@@ -0,0 +1,43 @@
+--  Ortho JIT specifications.
+--  Copyright (C) 2009 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with System; use System;
+with Ortho_Nodes; use Ortho_Nodes;
+
+package Ortho_Jit is
+   --  Initialize the whole engine.
+   procedure Init;
+
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address);
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address;
+
+   --  Do link.
+   procedure Link (Status : out Boolean);
+
+   --  Release memory (but the generated code).
+   procedure Finish;
+
+   function Decode_Option (Option : String) return Boolean;
+   procedure Disp_Help;
+
+   --  Return the name of the code generator, to be displayed by --version.
+   function Get_Jit_Name return String;
+end Ortho_Jit;
+
diff --git a/src/ortho/ortho_nodes.common.ads b/src/ortho/ortho_nodes.common.ads
new file mode 100644
index 000000000..178187482
--- /dev/null
+++ b/src/ortho/ortho_nodes.common.ads
@@ -0,0 +1,453 @@
+--  Ortho specifications.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package ORTHO_NODES is
+
+   type O_Enode is private;
+   type O_Cnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+   type O_Dnode is private;
+   type O_Fnode is private;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+   --  True if the code generated supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+private
+   --- PRIVATE PART is defined by ortho_nodes.ads in one of the subdirectory.
+end ORTHO_NODES;