Move sources to src/ subdirectory.

13 files changed, 0 insertions, 3943 deletions

diff --git a/ortho/debug/Makefile b/ortho/debug/Makefile
deleted file mode 100644
index 0c15111..0000000
--- a/ortho/debug/Makefile
+++ /dev/null
@@ -1,47 +0,0 @@
-#  -*- 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/ortho/debug/ortho_debug-disp.adb b/ortho/debug/ortho_debug-disp.adb
deleted file mode 100644
index 2725668..0000000
--- a/ortho/debug/ortho_debug-disp.adb
+++ /dev/null
@@ -1,1064 +0,0 @@
---  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/ortho/debug/ortho_debug-disp.ads b/ortho/debug/ortho_debug-disp.ads
deleted file mode 100644
index c365a35..0000000
--- a/ortho/debug/ortho_debug-disp.ads
+++ /dev/null
@@ -1,29 +0,0 @@
---  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/ortho/debug/ortho_debug-main.adb b/ortho/debug/ortho_debug-main.adb
deleted file mode 100644
index b470dea..0000000
--- a/ortho/debug/ortho_debug-main.adb
+++ /dev/null
@@ -1,151 +0,0 @@
---  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/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb
deleted file mode 100644
index 8285a64..0000000
--- a/ortho/debug/ortho_debug.adb
+++ /dev/null
@@ -1,1931 +0,0 @@
---  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/ortho/debug/ortho_debug.private.ads b/ortho/debug/ortho_debug.private.ads
deleted file mode 100644
index 69ee16c..0000000
--- a/ortho/debug/ortho_debug.private.ads
+++ /dev/null
@@ -1,467 +0,0 @@
---  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/ortho/debug/ortho_debug_front.ads b/ortho/debug/ortho_debug_front.ads
deleted file mode 100644
index 17e32c9..0000000
--- a/ortho/debug/ortho_debug_front.ads
+++ /dev/null
@@ -1,20 +0,0 @@
---  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/ortho/debug/ortho_ident.ads b/ortho/debug/ortho_ident.ads
deleted file mode 100644
index 46aa885..0000000
--- a/ortho/debug/ortho_ident.ads
+++ /dev/null
@@ -1,20 +0,0 @@
---  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/ortho/debug/ortho_ident_hash.adb b/ortho/debug/ortho_ident_hash.adb
deleted file mode 100644
index 60ab895..0000000
--- a/ortho/debug/ortho_ident_hash.adb
+++ /dev/null
@@ -1,72 +0,0 @@
---  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/ortho/debug/ortho_ident_hash.ads b/ortho/debug/ortho_ident_hash.ads
deleted file mode 100644
index a6e4a56..0000000
--- a/ortho/debug/ortho_ident_hash.ads
+++ /dev/null
@@ -1,46 +0,0 @@
---  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/ortho/debug/ortho_ident_simple.adb b/ortho/debug/ortho_ident_simple.adb
deleted file mode 100644
index 83b9756..0000000
--- a/ortho/debug/ortho_ident_simple.adb
+++ /dev/null
@@ -1,44 +0,0 @@
---  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/ortho/debug/ortho_ident_simple.ads b/ortho/debug/ortho_ident_simple.ads
deleted file mode 100644
index f94fe19..0000000
--- a/ortho/debug/ortho_ident_simple.ads
+++ /dev/null
@@ -1,31 +0,0 @@
---  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/ortho/debug/ortho_nodes.ads b/ortho/debug/ortho_nodes.ads
deleted file mode 100644
index 8ade667..0000000
--- a/ortho/debug/ortho_nodes.ads
+++ /dev/null
@@ -1,21 +0,0 @@
---  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;