Move sources to src/ subdirectory.

1 files changed, 0 insertions, 1351 deletions

diff --git a/ortho/mcode/ortho_code-dwarf.adb b/ortho/mcode/ortho_code-dwarf.adb
deleted file mode 100644
index ad67d1ff6..000000000
--- a/ortho/mcode/ortho_code-dwarf.adb
+++ /dev/null
@@ -1,1351 +0,0 @@
---  Mcode back-end for ortho - Dwarf generator.
---  Copyright (C) 2006 Tristan Gingold
---
---  GHDL is free software; you can redistribute it and/or modify it under
---  the terms of the GNU General Public License as published by the Free
---  Software Foundation; either version 2, or (at your option) any later
---  version.
---
---  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
---  WARRANTY; without even the implied warranty of MERCHANTABILITY or
---  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
---  for more details.
---
---  You should have received a copy of the GNU General Public License
---  along with GCC; see the file COPYING.  If not, write to the Free
---  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
---  02111-1307, USA.
-with GNAT.Directory_Operations;
-with GNAT.Table;
-with Interfaces; use Interfaces;
-with Binary_File; use Binary_File;
-with Dwarf; use Dwarf;
-with Ada.Text_IO;
-with Ortho_Code.Decls;
-with Ortho_Code.Types;
-with Ortho_Code.Consts;
-with Ortho_Code.Flags;
-with Ortho_Ident;
-with Ortho_Code.Binary;
-
-package body Ortho_Code.Dwarf is
-   --  Dwarf debugging format.
-   --  Debugging.
-   Line1_Sect : Section_Acc := null;
-   Line_Last : Int32 := 0;
-   Line_Pc : Pc_Type := 0;
-
-   --  Constant.
-   Min_Insn_Len : constant := 1;
-   Line_Base : constant := 1;
-   Line_Range : constant := 4;
-   Line_Opcode_Base : constant := 13;
-   Line_Max_Addr : constant := (255 - Line_Opcode_Base) / Line_Range;
-   -- + Line_Base;
-
-   Cur_File : Natural := 0;
-   Last_File : Natural := 0;
-
-   Orig_Sym : Symbol;
-   End_Sym : Symbol;
-   Abbrev_Sym : Symbol;
-   Info_Sym : Symbol;
-   Line_Sym : Symbol;
-
-   Line_Sect : Section_Acc;
-   Abbrev_Sect : Section_Acc;
-   Info_Sect : Section_Acc;
-   Aranges_Sect : Section_Acc;
-
-   Abbrev_Last : Unsigned_32;
-
---     procedure Gen_String (Str : String)
---     is
---     begin
---        for I in Str'Range loop
---           Gen_B8 (Character'Pos (Str (I)));
---        end loop;
---     end Gen_String;
-
-   procedure Gen_String_Nul (Str : String)
-   is
-   begin
-      Prealloc (Str'Length + 1);
-      for I in Str'Range loop
-         Gen_B8 (Character'Pos (Str (I)));
-      end loop;
-      Gen_B8 (0);
-   end Gen_String_Nul;
-
-   procedure Gen_Sleb128 (V : Int32)
-   is
-      V1 : Uns32 := To_Uns32 (V);
-      V2 : Uns32;
-      B : Byte;
-      function Shift_Right_Arithmetic (Value : Uns32; Amount : Natural)
-                                      return Uns32;
-      pragma Import (Intrinsic, Shift_Right_Arithmetic);
-   begin
-      loop
-         B := Byte (V1 and 16#7F#);
-         V2 := Shift_Right_Arithmetic (V1, 7);
-         if (V2 = 0 and (B and 16#40#) = 0)
-           or (V2 = -1 and (B and 16#40#) /= 0)
-         then
-            Gen_B8 (B);
-            exit;
-         else
-            Gen_B8 (B or 16#80#);
-            V1 := V2;
-         end if;
-      end loop;
-   end Gen_Sleb128;
-
-   procedure Gen_Uleb128 (V : Unsigned_32)
-   is
-      V1 : Unsigned_32 := V;
-      B : Byte;
-   begin
-      loop
-         B := Byte (V1 and 16#7f#);
-         V1 := Shift_Right (V1, 7);
-         if V1 /= 0 then
-            Gen_B8 (B or 16#80#);
-         else
-            Gen_B8 (B);
-            exit;
-         end if;
-      end loop;
-   end Gen_Uleb128;
-
---     procedure New_Debug_Line_Decl (Line : Int32)
---     is
---     begin
---        Line_Last := Line;
---     end New_Debug_Line_Decl;
-
-   procedure Set_Line_Stmt (Line : Int32)
-   is
-      Pc : Pc_Type;
-      D_Pc : Pc_Type;
-      D_Ln : Int32;
-   begin
-      if Line = Line_Last then
-         return;
-      end if;
-      Pc := Get_Current_Pc;
-
-      D_Pc := (Pc - Line_Pc) / Min_Insn_Len;
-      D_Ln := Line - Line_Last;
-
-      --  Always emit line information, since missing info can distrub the
-      --  user.
-      --  As an optimization, we could try to emit the highest line for the
-      --  same PC, since GDB seems to handle this way.
-      if False and D_Pc = 0 then
-         return;
-      end if;
-
-      Set_Current_Section (Line1_Sect);
-      Prealloc (32);
-
-      if Cur_File /= Last_File then
-         Gen_B8 (Byte (DW_LNS_Set_File));
-         Gen_Uleb128 (Unsigned_32 (Cur_File));
-         Last_File := Cur_File;
-      elsif Cur_File = 0 then
-         return;
-      end if;
-
-      if D_Ln < Line_Base or D_Ln >= (Line_Base + Line_Range) then
-         --  Emit an advance line.
-         Gen_B8 (Byte (DW_LNS_Advance_Line));
-         Gen_Sleb128 (Int32 (D_Ln - Line_Base));
-         D_Ln := Line_Base;
-      end if;
-      if D_Pc >= Line_Max_Addr then
-         --  Emit an advance addr.
-         Gen_B8 (Byte (DW_LNS_Advance_Pc));
-         Gen_Uleb128 (Unsigned_32 (D_Pc));
-         D_Pc := 0;
-      end if;
-      Gen_B8 (Line_Opcode_Base
-              + Byte (D_Pc) * Line_Range
-              + Byte (D_Ln - Line_Base));
-
-      --Set_Current_Section (Text_Sect);
-      Line_Pc := Pc;
-      Line_Last := Line;
-   end Set_Line_Stmt;
-
-
-   type String_Acc is access constant String;
-
-   type Dir_Chain;
-   type Dir_Chain_Acc is access Dir_Chain;
-   type Dir_Chain is record
-      Name : String_Acc;
-      Next : Dir_Chain_Acc;
-   end record;
-
-   type File_Chain;
-   type File_Chain_Acc is access File_Chain;
-   type File_Chain is record
-      Name : String_Acc;
-      Dir : Natural;
-      Next : File_Chain_Acc;
-   end record;
-
-   Dirs : Dir_Chain_Acc := null;
-   Files : File_Chain_Acc := null;
-
-   procedure Set_Filename (Dir : String; File : String)
-   is
-      D : Natural;
-      F : Natural;
-      D_C : Dir_Chain_Acc;
-      F_C : File_Chain_Acc;
-   begin
-      --  Find directory.
-      if Dir = "" then
-         --  Current directory.
-         D := 0;
-      elsif Dirs = null then
-         --  First directory.
-         Dirs := new Dir_Chain'(Name => new String'(Dir),
-                                Next => null);
-         D := 1;
-      else
-         --  Find a directory.
-         D_C := Dirs;
-         D := 1;
-         loop
-            exit when D_C.Name.all = Dir;
-            D := D + 1;
-            if D_C.Next = null then
-               D_C.Next := new Dir_Chain'(Name => new String'(Dir),
-                                          Next => null);
-               exit;
-            else
-               D_C := D_C.Next;
-            end if;
-         end loop;
-      end if;
-
-      --  Find file.
-      F := 1;
-      if Files = null then
-         --  first file.
-         Files := new File_Chain'(Name => new String'(File),
-                                  Dir => D,
-                                  Next => null);
-      else
-         F_C := Files;
-         loop
-            exit when F_C.Name.all = File and F_C.Dir = D;
-            F := F + 1;
-            if F_C.Next = null then
-               F_C.Next := new File_Chain'(Name => new String'(File),
-                                           Dir => D,
-                                           Next => null);
-               exit;
-            else
-               F_C := F_C.Next;
-            end if;
-         end loop;
-      end if;
-      Cur_File := F;
-   end Set_Filename;
-
-   procedure Gen_Abbrev_Header (Tag : Unsigned_32; Child : Byte) is
-   begin
-      Gen_Uleb128 (Tag);
-      Gen_B8 (Child);
-   end Gen_Abbrev_Header;
-
-   procedure Gen_Abbrev_Tuple (Attr : Unsigned_32; Form : Unsigned_32) is
-   begin
-      Gen_Uleb128 (Attr);
-      Gen_Uleb128 (Form);
-   end Gen_Abbrev_Tuple;
-
-   procedure Init
-   is
-   begin
-      --  Generate type names.
-      Flags.Flag_Type_Name := True;
-
-
-      Orig_Sym := Create_Local_Symbol;
-      Set_Symbol_Pc (Orig_Sym, False);
-      End_Sym := Create_Local_Symbol;
-
-      Create_Section (Line1_Sect, ".debug_line-1", Section_Debug);
-      Set_Current_Section (Line1_Sect);
-
-      --  Write Address.
-      Gen_B8 (0); -- extended opcode
-      Gen_B8 (5); -- length: 1 + 4
-      Gen_B8 (Byte (DW_LNE_Set_Address));
-      Gen_Ua_32 (Orig_Sym, 0);
-
-      Line_Last := 1;
-
-      Create_Section (Line_Sect, ".debug_line", Section_Debug);
-      Set_Section_Info (Line_Sect, null, 0, 0);
-      Set_Current_Section (Line_Sect);
-      Line_Sym := Create_Local_Symbol;
-      Set_Symbol_Pc (Line_Sym, False);
-
-      --  Abbrevs.
-      Create_Section (Abbrev_Sect, ".debug_abbrev", Section_Debug);
-      Set_Section_Info (Abbrev_Sect, null, 0, 0);
-      Set_Current_Section (Abbrev_Sect);
-
-      Abbrev_Sym := Create_Local_Symbol;
-      Set_Symbol_Pc (Abbrev_Sym, False);
-
-      Gen_Uleb128 (1);
-      Gen_Abbrev_Header (DW_TAG_Compile_Unit, DW_CHILDREN_Yes);
-
-      Gen_Abbrev_Tuple (DW_AT_Stmt_List, DW_FORM_Data4);
-      Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
-      Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
-      Gen_Abbrev_Tuple (DW_AT_Producer, DW_FORM_String);
-      Gen_Abbrev_Tuple (DW_AT_Comp_Dir, DW_FORM_String);
-      Gen_Abbrev_Tuple (0, 0);
-
-      Abbrev_Last := 1;
-
-      --  Info.
-      Create_Section (Info_Sect, ".debug_info", Section_Debug);
-      Set_Section_Info (Info_Sect, null, 0, 0);
-      Set_Current_Section (Info_Sect);
-      Info_Sym := Create_Local_Symbol;
-      Set_Symbol_Pc (Info_Sym, False);
-
-      Gen_32 (7);  --  Length: to be patched.
-      Gen_16 (2);  --  version
-      Gen_Ua_32 (Abbrev_Sym, 0); --  Abbrev offset
-      Gen_B8 (4);  --  Ptr size.
-
-      --  Compile_unit.
-      Gen_Uleb128 (1);
-      Gen_Ua_32 (Line_Sym, 0);
-      Gen_Ua_32 (Orig_Sym, 0);
-      Gen_Ua_32 (End_Sym, 0);
-      Gen_String_Nul ("T.Gingold ortho_mcode (2004)");
-      Gen_String_Nul (GNAT.Directory_Operations.Get_Current_Dir);
-   end Init;
-
-   procedure Emit_Decl (Decl : O_Dnode);
-
-   --  Next node to be emitted.
-   Last_Decl : O_Dnode := O_Dnode_First;
-
-   procedure Emit_Decls_Until (Last : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-   begin
-      while Last_Decl < Last loop
-         Emit_Decl (Last_Decl);
-         Last_Decl := Get_Decl_Chain (Last_Decl);
-      end loop;
-   end Emit_Decls_Until;
-
-   procedure Finish
-   is
-      Length : Pc_Type;
-      Last : O_Dnode;
-   begin
-      Set_Symbol_Pc (End_Sym, False);
-      Length := Get_Current_Pc;
-
-      Last := Decls.Get_Decl_Last;
-      Emit_Decls_Until (Last);
-      if Last_Decl <= Last then
-         Emit_Decl (Last);
-      end if;
-
-      --  Finish abbrevs.
-      Set_Current_Section (Abbrev_Sect);
-      Gen_Uleb128 (0);
-
-      --  Emit header.
-      Set_Current_Section (Line_Sect);
-
-      --  Unit_Length (to be patched).
-      Gen_32 (0);
-      --  version
-      Gen_16 (2);
-      --  header_length (to be patched).
-      Gen_32 (5 + 12 + 1);
-      --  minimum_instruction_length.
-      Gen_B8 (Min_Insn_Len);
-      --  default_is_stmt
-      Gen_B8 (1);
-      --  line base
-      Gen_B8 (Line_Base);
-      --  line range
-      Gen_B8 (Line_Range);
-      --  opcode base
-      Gen_B8 (Line_Opcode_Base);
-      --  standard_opcode_length.
-      Gen_B8 (0); --  copy
-      Gen_B8 (1); --  advance pc
-      Gen_B8 (1); --  advance line
-      Gen_B8 (1); --  set file
-      Gen_B8 (1); --  set column
-      Gen_B8 (0); --  negate stmt
-      Gen_B8 (0); --  set basic block
-      Gen_B8 (0); --  const add pc
-      Gen_B8 (1); --  fixed advance pc
-      Gen_B8 (0); --  set prologue end
-      Gen_B8 (0); --  set epilogue begin
-      Gen_B8 (1); --  set isa
-      --if Line_Opcode_Base /= 13 then
-      --   raise Program_Error;
-      --end if;
-
-      --  include directories
-      declare
-         D : Dir_Chain_Acc;
-      begin
-         D := Dirs;
-         while D /= null loop
-            Gen_String_Nul (D.Name.all);
-            D := D.Next;
-         end loop;
-         Gen_B8 (0); -- last entry.
-      end;
-
-      --  file_names.
-      declare
-         F : File_Chain_Acc;
-      begin
-         F := Files;
-         while F /= null loop
-            Gen_String_Nul (F.Name.all);
-            Gen_Uleb128 (Unsigned_32 (F.Dir));
-            Gen_B8 (0);  --  time
-            Gen_B8 (0);  --  length
-            F := F.Next;
-         end loop;
-         Gen_B8 (0);  --  last entry.
-      end;
-
-      --  Set prolog length
-      Patch_32 (6, Unsigned_32 (Get_Current_Pc - 6));
-
-      Merge_Section (Line_Sect, Line1_Sect);
-
-      --  Emit end of sequence.
-      Gen_B8 (0); -- extended opcode
-      Gen_B8 (1); -- length: 1
-      Gen_B8 (Byte (DW_LNE_End_Sequence));
-
-      --  Set total length.
-      Patch_32 (0, Unsigned_32 (Get_Current_Pc - 4));
-
-      --  Info.
-      Set_Current_Section (Info_Sect);
-      --  Finish child.
-      Gen_Uleb128 (0);
-      --  Set total length.
-      Patch_32 (0, Unsigned_32 (Get_Current_Pc - 4));
-
-      --  Aranges
-      Create_Section (Aranges_Sect, ".debug_aranges", Section_Debug);
-      Set_Section_Info (Aranges_Sect, null, 0, 0);
-      Set_Current_Section (Aranges_Sect);
-
-      Gen_32 (28);  --  Length.
-      Gen_16 (2);  --  version
-      Gen_Ua_32 (Info_Sym, 0); --  info offset
-      Gen_B8 (4);  --  Ptr size.
-      Gen_B8 (0);  --  seg desc size.
-      Gen_32 (0);  --  pad
-      Gen_Ua_32 (Orig_Sym, 0); --  text offset
-      Gen_32 (Unsigned_32 (Length));
-      Gen_32 (0); --  End
-      Gen_32 (0);
-   end Finish;
-
-   procedure Generate_Abbrev (Abbrev : out Unsigned_32) is
-   begin
-      Abbrev_Last := Abbrev_Last + 1;
-      Abbrev := Abbrev_Last;
-
-      Set_Current_Section (Abbrev_Sect);
-      --  FIXME: should be enough ?
-      Prealloc (128);
-      Gen_Uleb128 (Abbrev);
-   end Generate_Abbrev;
-
-   procedure Gen_Info_Header (Abbrev : Unsigned_32) is
-   begin
-      Set_Current_Section (Info_Sect);
-      Gen_Uleb128 (Abbrev);
-   end Gen_Info_Header;
-
-   function Gen_Info_Sibling return Pc_Type
-   is
-      Pc : Pc_Type;
-   begin
-      Pc := Get_Current_Pc;
-      Gen_32 (0);
-      return Pc;
-   end Gen_Info_Sibling;
-
-   procedure Patch_Info_Sibling (Pc : Pc_Type) is
-   begin
-      Patch_32 (Pc, Unsigned_32 (Get_Current_Pc));
-   end Patch_Info_Sibling;
-
-   Abbrev_Base_Type : Unsigned_32 := 0;
-   Abbrev_Base_Type_Name : Unsigned_32 := 0;
-   Abbrev_Pointer : Unsigned_32 := 0;
-   Abbrev_Pointer_Name : Unsigned_32 := 0;
-   Abbrev_Uncomplete_Pointer : Unsigned_32 := 0;
-   Abbrev_Uncomplete_Pointer_Name : Unsigned_32 := 0;
-   Abbrev_Ucarray : Unsigned_32 := 0;
-   Abbrev_Ucarray_Name : Unsigned_32 := 0;
-   Abbrev_Uc_Subrange : Unsigned_32 := 0;
-   Abbrev_Subarray : Unsigned_32 := 0;
-   Abbrev_Subarray_Name : Unsigned_32 := 0;
-   Abbrev_Subrange : Unsigned_32 := 0;
-   Abbrev_Struct : Unsigned_32 := 0;
-   Abbrev_Struct_Name : Unsigned_32 := 0;
-   Abbrev_Union : Unsigned_32 := 0;
-   Abbrev_Union_Name : Unsigned_32 := 0;
-   Abbrev_Member : Unsigned_32 := 0;
-   Abbrev_Enum : Unsigned_32 := 0;
-   Abbrev_Enum_Name : Unsigned_32 := 0;
-   Abbrev_Enumerator : Unsigned_32 := 0;
-
-   package TOnodes is new GNAT.Table
-     (Table_Component_Type => Pc_Type,
-      Table_Index_Type => O_Tnode,
-      Table_Low_Bound => O_Tnode_First,
-      Table_Initial => 16,
-      Table_Increment => 100);
-
-   procedure Emit_Type_Ref (Atype : O_Tnode)
-   is
-      Off : Pc_Type;
-   begin
-      Off := TOnodes.Table (Atype);
-      if Off = Null_Pc then
-         raise Program_Error;
-      end if;
-      Gen_32 (Unsigned_32 (Off));
-   end Emit_Type_Ref;
-
-   procedure Emit_Ident (Id : O_Ident)
-   is
-      use Ortho_Ident;
-      L : Natural;
-   begin
-      L := Get_String_Length (Id);
-      Prealloc (Pc_Type (L) + 128);
-      Gen_String_Nul (Get_String (Id));
-   end Emit_Ident;
-
-   procedure Add_Type_Ref (Atype : O_Tnode; Pc : Pc_Type)
-   is
-      Prev : O_Tnode;
-   begin
-      if Atype > TOnodes.Last then
-         --  Expand.
-         Prev := TOnodes.Last;
-         TOnodes.Set_Last (Atype);
-         TOnodes.Table (Prev + 1 .. Atype - 1) := (others => Null_Pc);
-      end if;
-      TOnodes.Table (Atype) := Pc;
-   end Add_Type_Ref;
-
-   procedure Emit_Decl_Ident (Decl : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-   begin
-      Emit_Ident (Get_Decl_Ident (Decl));
-   end Emit_Decl_Ident;
-
-   procedure Emit_Decl_Ident_If_Set (Decl : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-   begin
-      if Decl /= O_Dnode_Null then
-         Emit_Ident (Get_Decl_Ident (Decl));
-      end if;
-   end Emit_Decl_Ident_If_Set;
-
-   procedure Emit_Type (Atype : O_Tnode);
-
-   procedure Emit_Base_Type (Atype : O_Tnode; Decl : O_Dnode)
-   is
-      use Ortho_Code.Types;
-      procedure Finish_Gen_Abbrev is
-      begin
-         Gen_Abbrev_Tuple (DW_AT_Encoding, DW_FORM_Data1);
-         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
-         Gen_Abbrev_Tuple (0, 0);
-      end Finish_Gen_Abbrev;
-   begin
-      if Decl = O_Dnode_Null then
-         if Abbrev_Base_Type = 0 then
-            Generate_Abbrev (Abbrev_Base_Type);
-            Gen_Abbrev_Header (DW_TAG_Base_Type, DW_CHILDREN_No);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Base_Type);
-      else
-         if Abbrev_Base_Type_Name = 0 then
-            Generate_Abbrev (Abbrev_Base_Type_Name);
-            Gen_Abbrev_Header (DW_TAG_Base_Type, DW_CHILDREN_No);
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Base_Type_Name);
-         Emit_Decl_Ident (Decl);
-      end if;
-
-      case Get_Type_Kind (Atype) is
-         when OT_Signed =>
-            Gen_B8 (DW_ATE_Signed);
-         when OT_Unsigned =>
-            Gen_B8 (DW_ATE_Unsigned);
-         when OT_Float =>
-            Gen_B8 (DW_ATE_Float);
-         when others =>
-            raise Program_Error;
-      end case;
-      Gen_B8 (Byte (Get_Type_Size (Atype)));
-   end Emit_Base_Type;
-
-   procedure Emit_Access_Type (Atype : O_Tnode; Decl : O_Dnode)
-   is
-      use Ortho_Code.Types;
-      procedure Finish_Gen_Abbrev is
-      begin
-         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
-         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (0, 0);
-      end Finish_Gen_Abbrev;
-
-      procedure Finish_Gen_Abbrev_Uncomplete is
-      begin
-         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
-         Gen_Abbrev_Tuple (0, 0);
-      end Finish_Gen_Abbrev_Uncomplete;
-
-      Dtype : O_Tnode;
-      D_Pc : Pc_Type;
-   begin
-      Dtype := Get_Type_Access_Type (Atype);
-
-      if Dtype = O_Tnode_Null then
-         if Decl = O_Dnode_Null then
-            if Abbrev_Uncomplete_Pointer = 0 then
-               Generate_Abbrev (Abbrev_Uncomplete_Pointer);
-               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
-               Finish_Gen_Abbrev_Uncomplete;
-            end if;
-            Gen_Info_Header (Abbrev_Uncomplete_Pointer);
-         else
-            if Abbrev_Uncomplete_Pointer_Name = 0 then
-               Generate_Abbrev (Abbrev_Uncomplete_Pointer_Name);
-               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
-               Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-               Finish_Gen_Abbrev_Uncomplete;
-            end if;
-            Gen_Info_Header (Abbrev_Uncomplete_Pointer_Name);
-            Emit_Decl_Ident (Decl);
-         end if;
-         Gen_B8 (Byte (Get_Type_Size (Atype)));
-      else
-         if Decl = O_Dnode_Null then
-            if Abbrev_Pointer = 0 then
-               Generate_Abbrev (Abbrev_Pointer);
-               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
-               Finish_Gen_Abbrev;
-            end if;
-            Gen_Info_Header (Abbrev_Pointer);
-         else
-            if Abbrev_Pointer_Name = 0 then
-               Generate_Abbrev (Abbrev_Pointer_Name);
-               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
-               Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-               Finish_Gen_Abbrev;
-            end if;
-            Gen_Info_Header (Abbrev_Pointer_Name);
-            Emit_Decl_Ident (Decl);
-         end if;
-         Gen_B8 (Byte (Get_Type_Size (Atype)));
-         --  Break possible loops: generate the access entry...
-         D_Pc := Get_Current_Pc;
-         Gen_32 (0);
-         --  ... generate the designated type ...
-         Emit_Type (Dtype);
-         --  ... and write its reference.
-         Patch_32 (D_Pc, Unsigned_32 (TOnodes.Table (Dtype)));
-      end if;
-   end Emit_Access_Type;
-
-   procedure Emit_Ucarray_Type (Atype : O_Tnode; Decl : O_Dnode)
-   is
-      use Ortho_Code.Types;
-
-      procedure Finish_Gen_Abbrev is
-      begin
-         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (0, 0);
-      end Finish_Gen_Abbrev;
-   begin
-      if Decl = O_Dnode_Null then
-         if Abbrev_Ucarray = 0 then
-            Generate_Abbrev (Abbrev_Ucarray);
-            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Ucarray);
-      else
-         if Abbrev_Ucarray_Name = 0 then
-            Generate_Abbrev (Abbrev_Ucarray_Name);
-            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Ucarray_Name);
-         Emit_Decl_Ident (Decl);
-      end if;
-      Emit_Type_Ref (Get_Type_Ucarray_Element (Atype));
-
-      if Abbrev_Uc_Subrange = 0 then
-         Generate_Abbrev (Abbrev_Uc_Subrange);
-         Gen_Abbrev_Header (DW_TAG_Subrange_Type, DW_CHILDREN_No);
-
-         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (0, 0);
-      end if;
-
-      Gen_Info_Header (Abbrev_Uc_Subrange);
-      Emit_Type_Ref (Get_Type_Ucarray_Index (Atype));
-
-      Gen_Uleb128 (0);
-   end Emit_Ucarray_Type;
-
-   procedure Emit_Subarray_Type (Atype : O_Tnode; Decl : O_Dnode)
-   is
-      use Ortho_Code.Types;
-      procedure Finish_Gen_Abbrev is
-      begin
-         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
-         Gen_Abbrev_Tuple (0, 0);
-      end Finish_Gen_Abbrev;
-
-      Base : O_Tnode;
-   begin
-      if Decl = O_Dnode_Null then
-         if Abbrev_Subarray = 0 then
-            Generate_Abbrev (Abbrev_Subarray);
-            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Subarray);
-      else
-         if Abbrev_Subarray_Name = 0 then
-            Generate_Abbrev (Abbrev_Subarray_Name);
-            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Subarray_Name);
-         Emit_Decl_Ident (Decl);
-      end if;
-
-      Base := Get_Type_Subarray_Base (Atype);
-
-      Emit_Type_Ref (Get_Type_Ucarray_Element (Base));
-      Gen_Uleb128 (Unsigned_32 (Get_Type_Size (Atype)));
-
-      if Abbrev_Subrange = 0 then
-         Generate_Abbrev (Abbrev_Subrange);
-         Gen_Abbrev_Header (DW_TAG_Subrange_Type, DW_CHILDREN_No);
-
-         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (DW_AT_Lower_Bound, DW_FORM_Data1);
-         Gen_Abbrev_Tuple (DW_AT_Count, DW_FORM_Udata);
-         Gen_Abbrev_Tuple (0, 0);
-      end if;
-
-      Gen_Info_Header (Abbrev_Subrange);
-      Emit_Type_Ref (Get_Type_Ucarray_Index (Base));
-      Gen_B8 (0);
-      Gen_Uleb128 (Unsigned_32 (Get_Type_Subarray_Length (Atype)));
-
-      Gen_Uleb128 (0);
-   end Emit_Subarray_Type;
-
-   procedure Emit_Members (Atype : O_Tnode; Decl : O_Dnode)
-   is
-      use Ortho_Code.Types;
-      Nbr : Uns32;
-      F : O_Fnode;
-      Loc_Pc : Pc_Type;
-      Sibling_Pc : Pc_Type;
-   begin
-      if Abbrev_Member = 0 then
-         Generate_Abbrev (Abbrev_Member);
-
-         Gen_Abbrev_Header (DW_TAG_Member, DW_CHILDREN_No);
-
-         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (DW_AT_Data_Member_Location, DW_FORM_Block1);
-         Gen_Abbrev_Tuple (0, 0);
-      end if;
-
-      Set_Current_Section (Info_Sect);
-      Sibling_Pc := Gen_Info_Sibling;
-      Emit_Decl_Ident_If_Set (Decl);
-      Gen_Uleb128 (Unsigned_32 (Get_Type_Size (Atype)));
-
-      Nbr := Get_Type_Record_Nbr_Fields (Atype);
-      F := Get_Type_Record_Fields (Atype);
-      while Nbr > 0 loop
-         Gen_Uleb128 (Abbrev_Member);
-         Emit_Ident (Get_Field_Ident (F));
-         Emit_Type_Ref (Get_Field_Type (F));
-
-         --  Location.
-         Loc_Pc := Get_Current_Pc;
-         Gen_B8 (3);
-         Gen_B8 (DW_OP_Plus_Uconst);
-         Gen_Uleb128 (Unsigned_32 (Get_Field_Offset (F)));
-         Patch_B8 (Loc_Pc, Unsigned_8 (Get_Current_Pc - (Loc_Pc + 1)));
-
-         F := Get_Field_Chain (F);
-         Nbr := Nbr - 1;
-      end loop;
-
-      --  end of children.
-      Gen_Uleb128 (0);
-      Patch_Info_Sibling (Sibling_Pc);
-   end Emit_Members;
-
-   procedure Emit_Record_Type (Atype : O_Tnode; Decl : O_Dnode)
-   is
-      use Ortho_Code.Types;
-      procedure Finish_Gen_Abbrev is
-      begin
-         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
-         Gen_Abbrev_Tuple (0, 0);
-      end Finish_Gen_Abbrev;
-   begin
-      if Decl = O_Dnode_Null then
-         if Abbrev_Struct = 0 then
-            Generate_Abbrev (Abbrev_Struct);
-
-            Gen_Abbrev_Header (DW_TAG_Structure_Type, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Struct);
-      else
-         if Abbrev_Struct_Name = 0 then
-            Generate_Abbrev (Abbrev_Struct_Name);
-
-            Gen_Abbrev_Header (DW_TAG_Structure_Type, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Struct_Name);
-      end if;
-      Emit_Members (Atype, Decl);
-   end Emit_Record_Type;
-
-   procedure Emit_Union_Type (Atype : O_Tnode; Decl : O_Dnode)
-   is
-      use Ortho_Code.Types;
-      procedure Finish_Gen_Abbrev is
-      begin
-         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
-         Gen_Abbrev_Tuple (0, 0);
-      end Finish_Gen_Abbrev;
-   begin
-      if Decl = O_Dnode_Null then
-         if Abbrev_Union = 0 then
-            Generate_Abbrev (Abbrev_Union);
-
-            Gen_Abbrev_Header (DW_TAG_Union_Type, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Union);
-      else
-         if Abbrev_Union_Name = 0 then
-            Generate_Abbrev (Abbrev_Union_Name);
-
-            Gen_Abbrev_Header (DW_TAG_Union_Type, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Union_Name);
-      end if;
-      Emit_Members (Atype, Decl);
-   end Emit_Union_Type;
-
-   procedure Emit_Enum_Type (Atype : O_Tnode; Decl : O_Dnode)
-   is
-      use Ortho_Code.Types;
-      use Ortho_Code.Consts;
-      procedure Finish_Gen_Abbrev is
-      begin
-         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
-         Gen_Abbrev_Tuple (0, 0);
-      end Finish_Gen_Abbrev;
-
-      procedure Emit_Enumerator (L : O_Cnode) is
-      begin
-         Gen_Uleb128 (Abbrev_Enumerator);
-         Emit_Ident (Get_Lit_Ident (L));
-         Gen_Uleb128 (Unsigned_32 (Get_Lit_Value (L)));
-      end Emit_Enumerator;
-
-      Nbr : Uns32;
-      L : O_Cnode;
-      Sibling_Pc : Pc_Type;
-   begin
-      if Abbrev_Enumerator = 0 then
-         Generate_Abbrev (Abbrev_Enumerator);
-
-         Gen_Abbrev_Header (DW_TAG_Enumerator, DW_CHILDREN_No);
-
-         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-         Gen_Abbrev_Tuple (DW_AT_Const_Value, DW_FORM_Udata);
-         Gen_Abbrev_Tuple (0, 0);
-      end if;
-      if Decl = O_Dnode_Null then
-         if Abbrev_Enum = 0 then
-            Generate_Abbrev (Abbrev_Enum);
-            Gen_Abbrev_Header (DW_TAG_Enumeration_Type, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Enum);
-      else
-         if Abbrev_Enum_Name = 0 then
-            Generate_Abbrev (Abbrev_Enum_Name);
-            Gen_Abbrev_Header (DW_TAG_Enumeration_Type, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Finish_Gen_Abbrev;
-         end if;
-         Gen_Info_Header (Abbrev_Enum_Name);
-      end if;
-
-      Sibling_Pc := Gen_Info_Sibling;
-      Emit_Decl_Ident_If_Set (Decl);
-      Gen_B8 (Byte (Get_Type_Size (Atype)));
-      case Get_Type_Kind (Atype) is
-         when OT_Enum =>
-            Nbr := Get_Type_Enum_Nbr_Lits (Atype);
-            L := Get_Type_Enum_Lits (Atype);
-            while Nbr > 0 loop
-               Emit_Enumerator (L);
-
-               L := Get_Lit_Chain (L);
-               Nbr := Nbr - 1;
-            end loop;
-         when OT_Boolean =>
-            Emit_Enumerator (Get_Type_Bool_False (Atype));
-            Emit_Enumerator (Get_Type_Bool_True (Atype));
-         when others =>
-            raise Program_Error;
-      end case;
-
-      --  End of children.
-      Gen_Uleb128 (0);
-      Patch_Info_Sibling (Sibling_Pc);
-   end Emit_Enum_Type;
-
-   procedure Emit_Type (Atype : O_Tnode)
-   is
-      use Ortho_Code.Types;
-      use Ada.Text_IO;
-      Kind : OT_Kind;
-      Decl : O_Dnode;
-   begin
-      --  If already emitted, then return.
-      if Atype <= TOnodes.Last
-        and then TOnodes.Table (Atype) /= Null_Pc
-      then
-         return;
-      end if;
-
-      Kind := Get_Type_Kind (Atype);
-
-      --  First step: emit inner types (if any).
-      case Kind is
-         when OT_Signed
-           | OT_Unsigned
-           | OT_Float
-           | OT_Boolean
-           | OT_Enum =>
-            null;
-         when OT_Access =>
-            null;
-         when OT_Ucarray =>
-            Emit_Type (Get_Type_Ucarray_Index (Atype));
-            Emit_Type (Get_Type_Ucarray_Element (Atype));
-         when OT_Subarray =>
-            Emit_Type (Get_Type_Subarray_Base (Atype));
-         when OT_Record
-           | OT_Union =>
-            declare
-               Nbr : Uns32;
-               F : O_Fnode;
-            begin
-               Nbr := Get_Type_Record_Nbr_Fields (Atype);
-               F := Get_Type_Record_Fields (Atype);
-               while Nbr > 0 loop
-                  Emit_Type (Get_Field_Type (F));
-                  F := Get_Field_Chain (F);
-                  Nbr := Nbr - 1;
-               end loop;
-            end;
-         when OT_Complete =>
-            null;
-      end case;
-
-      Set_Current_Section (Info_Sect);
-      Add_Type_Ref (Atype, Get_Current_Pc);
-
-      Decl := Decls.Get_Type_Decl (Atype);
-
-      --  Second step: emit info.
-      case Kind is
-         when OT_Signed
-           | OT_Unsigned
-           | OT_Float =>
-            Emit_Base_Type (Atype, Decl);
-            -- base types.
-         when OT_Access =>
-            Emit_Access_Type (Atype, Decl);
-         when OT_Ucarray =>
-            Emit_Ucarray_Type (Atype, Decl);
-         when OT_Subarray =>
-            Emit_Subarray_Type (Atype, Decl);
-         when OT_Record =>
-            Emit_Record_Type (Atype, Decl);
-         when OT_Union =>
-            Emit_Union_Type (Atype, Decl);
-         when OT_Enum
-           | OT_Boolean =>
-            Emit_Enum_Type (Atype, Decl);
-         when OT_Complete =>
-            null;
-      end case;
-   end Emit_Type;
-
-   procedure Emit_Decl_Type (Decl : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-   begin
-      Emit_Type_Ref (Get_Decl_Type (Decl));
-   end Emit_Decl_Type;
-
-   Abbrev_Variable : Unsigned_32 := 0;
-   Abbrev_Const : Unsigned_32 := 0;
-
-   procedure Emit_Local_Location (Decl : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-      Pc : Pc_Type;
-   begin
-      Pc := Get_Current_Pc;
-      Gen_B8 (2);
-      Gen_B8 (DW_OP_Fbreg);
-      Gen_Sleb128 (Get_Decl_Info (Decl));
-      Patch_B8 (Pc, Unsigned_8 (Get_Current_Pc - (Pc + 1)));
-   end Emit_Local_Location;
-
-   procedure Emit_Global_Location (Decl : O_Dnode)
-   is
-      use Ortho_Code.Binary;
-   begin
-      Gen_B8 (5);
-      Gen_B8 (DW_OP_Addr);
-      Gen_Ua_32 (Get_Decl_Symbol (Decl), 0);
-   end Emit_Global_Location;
-
-   procedure Emit_Variable (Decl : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-      Dtype : O_Tnode;
-   begin
-      if Get_Decl_Ident (Decl) = O_Ident_Nul then
-         return;
-      end if;
-
-      if Abbrev_Variable = 0 then
-         Generate_Abbrev (Abbrev_Variable);
-         Gen_Abbrev_Header (DW_TAG_Variable, DW_CHILDREN_No);
-
-         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
-         Gen_Abbrev_Tuple (0, 0);
-      end if;
-
-      Dtype := Get_Decl_Type (Decl);
-      Emit_Type (Dtype);
-
-      Gen_Info_Header (Abbrev_Variable);
-      Emit_Decl_Ident (Decl);
-      Emit_Type_Ref (Dtype);
-      case Get_Decl_Kind (Decl) is
-         when OD_Local =>
-            Emit_Local_Location (Decl);
-         when OD_Var =>
-            Emit_Global_Location (Decl);
-         when others =>
-            raise Program_Error;
-      end case;
-   end Emit_Variable;
-
-   procedure Emit_Const (Decl : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-      Dtype : O_Tnode;
-   begin
-      if Abbrev_Const = 0 then
-         Generate_Abbrev (Abbrev_Const);
-         --  FIXME: should be a TAG_Constant, however, GDB does not support it.
-         --  work-around: could use a const_type.
-         Gen_Abbrev_Header (DW_TAG_Variable, DW_CHILDREN_No);
-
-         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
-         Gen_Abbrev_Tuple (0, 0);
-      end if;
-
-      Dtype := Get_Decl_Type (Decl);
-      Emit_Type (Dtype);
-      Gen_Info_Header (Abbrev_Const);
-      Emit_Decl_Ident (Decl);
-      Emit_Type_Ref (Dtype);
-      Emit_Global_Location (Decl);
-   end Emit_Const;
-
-   procedure Emit_Type_Decl (Decl : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-   begin
-      Emit_Type (Get_Decl_Type (Decl));
-   end Emit_Type_Decl;
-
-   Subprg_Sym : Symbol;
-
-   Abbrev_Block : Unsigned_32 := 0;
-
-   procedure Emit_Block_Decl (Decl : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-      Last : O_Dnode;
-      Sdecl : O_Dnode;
-      Sibling_Pc : Pc_Type;
-   begin
-      if Abbrev_Block = 0 then
-         Generate_Abbrev (Abbrev_Block);
-
-         Gen_Abbrev_Header (DW_TAG_Lexical_Block, DW_CHILDREN_Yes);
-         Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-         Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
-         Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
-         Gen_Abbrev_Tuple (0, 0);
-      end if;
-
-      Gen_Info_Header (Abbrev_Block);
-      Sibling_Pc := Gen_Info_Sibling;
-
-      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info1 (Decl)));
-      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info2 (Decl)));
-
-      --  Emit decls for children.
-      Last := Get_Block_Last (Decl);
-      Sdecl := Decl + 1;
-      while Sdecl <= Last loop
-         Emit_Decl (Sdecl);
-         Sdecl := Get_Decl_Chain (Sdecl);
-      end loop;
-
-      --  End of children.
-      Set_Current_Section (Info_Sect);
-      Gen_Uleb128 (0);
-
-      Patch_Info_Sibling (Sibling_Pc);
-   end Emit_Block_Decl;
-
-   Abbrev_Function : Unsigned_32 := 0;
-   Abbrev_Procedure : Unsigned_32 := 0;
-   Abbrev_Interface : Unsigned_32 := 0;
-
-   procedure Emit_Subprg_Body (Bod : O_Dnode)
-   is
-      use Ortho_Code.Decls;
-      Kind : OD_Kind;
-      Decl : O_Dnode;
-      Idecl : O_Dnode;
-      Prev_Subprg_Sym : Symbol;
-      Sibling_Pc : Pc_Type;
-   begin
-      Decl := Get_Body_Decl (Bod);
-      Kind := Get_Decl_Kind (Decl);
-
-      --  Emit interfaces type.
-      Idecl := Get_Subprg_Interfaces (Decl);
-      while Idecl /= O_Dnode_Null loop
-         Emit_Type (Get_Decl_Type (Idecl));
-         Idecl := Get_Interface_Chain (Idecl);
-      end loop;
-
-      if Kind = OD_Function then
-         Emit_Type (Get_Decl_Type (Decl));
-         if Abbrev_Function = 0 then
-            Generate_Abbrev (Abbrev_Function);
-
-            Gen_Abbrev_Header (DW_TAG_Subprogram, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-
-            Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
-            Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
-            Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
-            --Gen_Abbrev_Tuple (DW_AT_Return_Addr, DW_FORM_Block1);
-            Gen_Abbrev_Tuple (0, 0);
-         end if;
-         Gen_Info_Header (Abbrev_Function);
-      else
-         if Abbrev_Procedure = 0 then
-            Generate_Abbrev (Abbrev_Procedure);
-
-            Gen_Abbrev_Header (DW_TAG_Subprogram, DW_CHILDREN_Yes);
-            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
-            Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
-            Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
-            --Gen_Abbrev_Tuple (DW_AT_Return_Addr, DW_FORM_Block1);
-            Gen_Abbrev_Tuple (0, 0);
-         end if;
-         Gen_Info_Header (Abbrev_Procedure);
-      end if;
-
-      Sibling_Pc := Gen_Info_Sibling;
-
-      if Kind = OD_Function then
-         Emit_Decl_Type (Decl);
-      end if;
-
-      Emit_Decl_Ident (Decl);
-      Prev_Subprg_Sym := Subprg_Sym;
-      Subprg_Sym := Binary.Get_Decl_Symbol (Decl);
-      Gen_Ua_32 (Subprg_Sym, 0);
-      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Body_Info (Bod)));
-
-      --  Frame base.
-      Gen_B8 (1);
-      Gen_B8 (DW_OP_Reg5);
-
-      --  Interfaces.
-      Idecl := Get_Subprg_Interfaces (Decl);
-      if Idecl /= O_Dnode_Null then
-         if Abbrev_Interface = 0 then
-            Generate_Abbrev (Abbrev_Interface);
-
-            Gen_Abbrev_Header (DW_TAG_Formal_Parameter, DW_CHILDREN_No);
-            Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
-            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
-            Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
-            Gen_Abbrev_Tuple (0, 0);
-         end if;
-
-         loop
-            Gen_Info_Header (Abbrev_Interface);
-            Emit_Decl_Type (Idecl);
-            Emit_Decl_Ident (Idecl);
-
-            Emit_Local_Location (Idecl);
-
-            Idecl := Get_Interface_Chain (Idecl);
-            exit when Idecl = O_Dnode_Null;
-         end loop;
-      end if;
-
-      --  Internal declarations.
-      Emit_Block_Decl (Bod + 1);
-
-      --  End of children.
-      Gen_Uleb128 (0);
-
-      Patch_Info_Sibling (Sibling_Pc);
-
-      Subprg_Sym := Prev_Subprg_Sym;
-   end Emit_Subprg_Body;
-
-   procedure Emit_Decl (Decl : O_Dnode)
-   is
-      use Ada.Text_IO;
-      use Ortho_Code.Decls;
-   begin
-      case Get_Decl_Kind (Decl) is
-         when OD_Type =>
-            Emit_Type_Decl (Decl);
-         when OD_Local
-           | OD_Var =>
-            Emit_Variable (Decl);
-         when OD_Const =>
-            Emit_Const (Decl);
-         when OD_Function
-           | OD_Procedure
-           | OD_Interface =>
-            null;
-         when OD_Body =>
-            Emit_Subprg_Body (Decl);
-         when OD_Block =>
-            Emit_Block_Decl (Decl);
-         when others =>
-            Put_Line ("dwarf.emit_decl: emit "
-                      & OD_Kind'Image (Get_Decl_Kind (Decl)));
-      end case;
-   end Emit_Decl;
-
-   procedure Emit_Subprg (Bod : O_Dnode) is
-   begin
-      Emit_Decls_Until (Bod);
-      Emit_Decl (Bod);
-      Last_Decl := Decls.Get_Decl_Chain (Bod);
-   end Emit_Subprg;
-
-   procedure Mark (M : out Mark_Type) is
-   begin
-      M.Last_Decl := Last_Decl;
-      M.Last_Tnode := TOnodes.Last;
-   end Mark;
-
-   procedure Release (M : Mark_Type) is
-   begin
-      Last_Decl := M.Last_Decl;
-      TOnodes.Set_Last (M.Last_Tnode);
-   end Release;
-
-end Ortho_Code.Dwarf;
-