--  ELF dumper (library).
--  Copyright (C) 2006 Tristan Gingold
--
--  This program 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 of the License, or
--  (at your option) any later version.
--
--  This program 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 this program.  If not, see <gnu.org/licenses>.
with System.Storage_Elements; use System.Storage_Elements;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with GNAT.OS_Lib;
with Interfaces; use Interfaces;
with Hex_Images; use Hex_Images;
with Elf_Common; use Elf_Common;
with Dwarf;

package body Elfdumper is
   function Get_String (Strtab : Strtab_Type; N : Elf_Size) return String
   is
      E : Elf_Size;
   begin
      E := N;
      while Strtab.Base (E) /= Nul loop
         E := E + 1;
      end loop;
      if E = N then
         return "";
      else
         return String (Strtab.Base (N .. E - 1));
      end if;
   end Get_String;

   procedure Disp_Ehdr (Ehdr : Elf_Ehdr) is
   begin
      Put ("File class: ");
      case Ehdr.E_Ident (EI_CLASS) is
         when ELFCLASSNONE =>
            Put ("none");
         when ELFCLASS32 =>
            Put ("class_32");
         when ELFCLASS64 =>
            Put ("class_64");
         when others =>
            Put ("others");
      end case;
      New_Line;

      Put ("encoding  : ");
      case Ehdr.E_Ident (EI_DATA) is
         when ELFDATANONE =>
            Put ("none");
         when ELFDATA2LSB =>
            Put ("LSB byte order");
         when ELFDATA2MSB =>
            Put ("MSB byte order");
         when others =>
            Put ("unknown");
      end case;
      New_Line;

      Put ("version   : ");
      case Ehdr.E_Ident (EI_VERSION) is
         when EV_NONE =>
            Put ("none");
         when EV_CURRENT =>
            Put ("current (1)");
         when others =>
            Put ("future");
      end case;
      New_Line;

      if Ehdr.E_Ident (EI_CLASS) /= Elf_Arch_Class
--        or Ehdr.E_Ident (EI_DATA) /= ELFDATA2LSB
        or Ehdr.E_Ident (EI_VERSION) /= EV_CURRENT
      then
         Put_Line ("bad class/data encoding/version");
         return;
      end if;

      Put ("File type : ");
      case Ehdr.E_Type is
         when ET_NONE =>
            Put ("no file type");
         when ET_REL =>
            Put ("relocatable file");
         when ET_EXEC =>
            Put ("executable file");
         when ET_CORE =>
            Put ("core file");
         when ET_LOPROC .. ET_HIPROC =>
            Put ("processor-specific");
         when others =>
            Put ("unknown");
      end case;
      New_Line;

      Put ("machine   : ");
      case Ehdr.E_Machine is
         when EM_NONE =>
            Put ("no machine");
         when EM_M32 =>
            Put ("AT&T WE 32100");
         when EM_SPARC =>
            Put ("SPARC");
         when EM_386 =>
            Put ("Intel architecture");
         when EM_68K =>
            Put ("Motorola 68000");
         when EM_88K =>
            Put ("Motorola 88000");
         when EM_860 =>
            Put ("Intel 80860");
         when EM_MIPS =>
            Put ("MIPS RS3000 Big-Endian");
         when EM_MIPS_RS4_BE =>
            Put ("MIPS RS4000 Big-Endian");
         when others =>
            Put ("unknown");
      end case;
      New_Line;

      Put_Line ("Version   : " & Hex_Image (Ehdr.E_Version));
      Put_Line ("Phoff     : " & Hex_Image (Ehdr.E_Phoff));
      Put_Line ("Shoff     : " & Hex_Image (Ehdr.E_Shoff));
      Put_Line ("flags     : " & Hex_Image (Ehdr.E_Flags));
      Put_Line ("phentsize : " & Hex_Image (Ehdr.E_Ehsize));
      Put_Line ("phnum     : " & Hex_Image (Ehdr.E_Phentsize));
      Put_Line ("shentsize : " & Hex_Image (Ehdr.E_Shentsize));
      Put_Line ("shnum     : " & Hex_Image (Ehdr.E_Shnum));
      Put_Line ("shstrndx  : " & Hex_Image (Ehdr.E_Shstrndx));
   end Disp_Ehdr;

   function Get_Shdr_Type_Name (Stype : Elf_Word) return String is
   begin
      case Stype is
         when SHT_NULL =>
            return "NULL";
         when SHT_PROGBITS =>
            return "PROGBITS";
         when SHT_SYMTAB =>
            return "SYMTAB";
         when SHT_STRTAB =>
            return "STRTAB";
         when SHT_RELA =>
            return "RELA";
         when SHT_HASH =>
            return "HASH";
         when SHT_DYNAMIC =>
            return "DYNAMIC";
         when SHT_NOTE =>
            return "NOTE";
         when SHT_NOBITS =>
            return "NOBITS";
         when SHT_REL =>
            return "REL";
         when SHT_SHLIB =>
            return "SHLIB";
         when SHT_DYNSYM =>
            return "DYNSYM";
         when SHT_INIT_ARRAY =>
            return "INIT_ARRAY";
         when SHT_FINI_ARRAY =>
            return "FINI_ARRAY";
         when SHT_PREINIT_ARRAY =>
            return "PREINIT_ARRAY";
         when SHT_GROUP =>
            return "GROUP";
         when SHT_SYMTAB_SHNDX =>
            return "SYMTAB_SHNDX";
         when SHT_NUM =>
            return "NUM";
         when SHT_LOOS =>
            return "LOOS";
         when SHT_GNU_LIBLIST =>
            return "GNU_LIBLIST";
         when SHT_CHECKSUM =>
            return "CHECKSUM";
         when SHT_SUNW_Move =>
            return "SUNW_move";
         when SHT_SUNW_COMDAT =>
            return "SUNW_COMDAT";
         when SHT_SUNW_Syminfo =>
            return "SUNW_syminfo";
         when SHT_GNU_Verdef =>
            return "GNU_verdef";
         when SHT_GNU_Verneed =>
            return "GNU_verneed";
         when SHT_GNU_Versym =>
            return "GNU_versym";
         when SHT_LOPROC .. SHT_HIPROC =>
            return "Processor dependant";
         when SHT_LOUSER .. SHT_HIUSER =>
            return "User dependant";
         when others =>
            return "unknown";
      end case;
   end Get_Shdr_Type_Name;

   procedure Disp_Shdr (Shdr : Elf_Shdr; Sh_Strtab : Strtab_Type)
   is
   begin
      Put_Line ("name  : " & Hex_Image (Shdr.Sh_Name) & " """
                & Get_String (Sh_Strtab, Elf_Size (Shdr.Sh_Name)) & """");
      Put ("type  : " & Hex_Image (Shdr.Sh_Type) & " ");
      Put (Get_Shdr_Type_Name (Shdr.Sh_Type));
      New_Line;
      Put ("flags : " & Hex_Image (Shdr.Sh_Flags));
      if (Shdr.Sh_Flags and SHF_WRITE) /= 0 then
         Put (" WRITE");
      end if;
      if (Shdr.Sh_Flags and SHF_ALLOC) /= 0 then
         Put (" ALLOC");
      end if;
      if (Shdr.Sh_Flags and SHF_EXECINSTR) /= 0 then
         Put (" EXEC");
      end if;
      New_Line;
      Put ("addr  : " & Hex_Image (Shdr.Sh_Addr));
      Put ("  offset : " & Hex_Image (Shdr.Sh_Offset));
      Put ("       size : " & Hex_Image (Shdr.Sh_Size));
      New_Line;
      Put ("link  : " & Hex_Image (Shdr.Sh_Link));
      Put ("    info : " & Hex_Image (Shdr.Sh_Info));
      Put ("  addralign : " & Hex_Image (Shdr.Sh_Addralign));
      Put ("  entsize : " & Hex_Image (Shdr.Sh_Entsize));
      New_Line;
   end Disp_Shdr;

   procedure Disp_Sym (File : Elf_File;
                       Sym : Elf_Sym;
                       Strtab : Strtab_Type)
   is
   begin
      Put (Hex_Image (Sym.St_Value));
      Put (" " & Hex_Image (Sym.St_Size));
      Put (' ');
      --Put ("  info:" & Hex_Image (Sym.St_Info) & " ");
      case Elf_St_Bind (Sym.St_Info) is
         when STB_LOCAL =>
            Put ("loc ");
         when STB_GLOBAL =>
            Put ("glob");
         when STB_WEAK =>
            Put ("weak");
         when others =>
            Put ("?   ");
      end case;
      Put (' ');
      case Elf_St_Type (Sym.St_Info) is
         when STT_NOTYPE =>
            Put ("none");
         when STT_OBJECT =>
            Put ("obj ");
         when STT_FUNC =>
            Put ("func");
         when STT_SECTION =>
            Put ("sect");
         when STT_FILE =>
            Put ("file");
         when others =>
            Put ("?   ");
      end case;
      --Put ("  other:" & Hex_Image (Sym.St_Other));
      Put (' ');
      case Sym.St_Shndx is
         when SHN_UNDEF =>
            Put ("UNDEF   ");
         when 1 .. SHN_LORESERVE - 1 =>
            declare
               S : String := Get_Section_Name (File, Sym.St_Shndx);
               Max : constant Natural := 8;
            begin
               if S'Length <= Max then
                  Put (S);
                  for I in S'Length + 1 .. Max loop
                     Put (' ');
                  end loop;
               else
                  Put (S (S'First .. S'First + Max - 1));
               end if;
            end;
         when SHN_LOPROC .. SHN_HIPROC =>
            Put ("*proc*  ");
         when SHN_ABS =>
            Put ("*ABS*   ");
         when SHN_COMMON =>
            Put ("*COMMON*");
         when others =>
            Put ("??      ");
      end case;
      --Put (" sect:" & Hex_Image (Sym.St_Shndx));
      Put (' ');
      Put_Line (Get_String (Strtab, Elf_Size (Sym.St_Name)));
   end Disp_Sym;

   function Get_Offset (File : Elf_File; Off : Elf_Off; Size : Elf_Size)
                       return Address
   is
   begin
      if Off > File.Length or Off + Size > File.Length then
         return Null_Address;
      end if;
      return File.Base + Storage_Offset (Off);
   end Get_Offset;

   function Get_Section_Base (File : Elf_File; Shdr : Elf_Shdr)
                             return Address
   is
   begin
      return Get_Offset (File, Shdr.Sh_Offset, Shdr.Sh_Size);
   end Get_Section_Base;

   function Get_Section_Base (File : Elf_File; Index : Elf_Half)
                             return Address
   is
      Shdr : Elf_Shdr_Acc;
   begin
      Shdr := Get_Shdr (File, Index);
      return Get_Section_Base (File, Shdr.all);
   end Get_Section_Base;

   function Get_Segment_Base (File : Elf_File; Phdr : Elf_Phdr)
                             return Address
   is
   begin
      return Get_Offset (File, Phdr.P_Offset, Phdr.P_Filesz);
   end Get_Segment_Base;

   function Get_Segment_Base (File : Elf_File; Index : Elf_Half)
                             return Address
   is
      Phdr : Elf_Phdr_Acc;
   begin
      Phdr := Get_Phdr (File, Index);
      return Get_Segment_Base (File, Phdr.all);
   end Get_Segment_Base;

   procedure Open_File (File : out Elf_File; Filename : String)
   is
      function Malloc (Size : Integer) return Address;
      pragma Import (C, Malloc);

      use GNAT.OS_Lib;
      Length : Long_Integer;
      Len : Integer;
      Fd : File_Descriptor;
   begin
      File := (Filename => new String'(Filename),
               Status => Status_Ok,
               Length => 0,
               Base => Null_Address,
               Ehdr => null,
               Shdr_Base => Null_Address,
               Sh_Strtab => (null, 0),
               Phdr_Base => Null_Address);

      --  Open the file.
      Fd := Open_Read (Filename, Binary);
      if Fd = Invalid_FD then
         File.Status := Status_Open_Failure;
         return;
      end if;

      --  Get length.
      Length := File_Length (Fd);
      Len := Integer (Length);
      if Len < Elf_Ehdr_Size then
         File.Status := Status_Bad_File;
         Close (Fd);
         return;
      end if;

      File.Length := Elf_Off (Len);

      --  Allocate memory for the file.
      File.Base := Malloc (Len);
      if File.Base = Null_Address then
         File.Status := Status_Memory;
         Close (Fd);
         return;
      end if;

      --  Read the whole file.
      if Read (Fd, File.Base, Integer (Length)) /= Integer (Length) then
         File.Status := Status_Read_Error;
         Close (Fd);
         return;
      end if;

      Close (Fd);

      File.Ehdr := To_Elf_Ehdr_Acc (File.Base);

      if File.Ehdr.E_Ident (EI_MAG0) /= ELFMAG0
        or File.Ehdr.E_Ident (EI_MAG1) /= ELFMAG1
        or File.Ehdr.E_Ident (EI_MAG2) /= ELFMAG2
        or File.Ehdr.E_Ident (EI_MAG3) /= ELFMAG3
      then
         File.Status := Status_Bad_Magic;
         return;
      end if;

      if File.Ehdr.E_Ident (EI_CLASS) /= Elf_Arch_Class
--        or Ehdr.E_Ident (EI_DATA) /= ELFDATA2LSB
        or File.Ehdr.E_Ident (EI_VERSION) /= EV_CURRENT
      then
         File.Status := Status_Bad_Class;
         return;
      end if;
   end Open_File;

   function Get_Status (File : Elf_File) return Elf_File_Status is
   begin
      return File.Status;
   end Get_Status;

   function Get_Ehdr (File : Elf_File) return Elf_Ehdr_Acc is
   begin
      return File.Ehdr;
   end Get_Ehdr;

   function Get_Shdr (File : Elf_File; Index : Elf_Half)
                     return Elf_Shdr_Acc
   is
   begin
      if Index >= File.Ehdr.E_Shnum then
         raise Constraint_Error;
      end if;
      return To_Elf_Shdr_Acc
        (File.Shdr_Base
         + Storage_Offset (Index * Elf_Half (Elf_Shdr_Size)));
   end Get_Shdr;

   procedure Load_Phdr (File : in out Elf_File)
   is
   begin
      if Get_Ehdr (File).E_Phentsize /= Elf_Half (Elf_Phdr_Size) then
         return;
      end if;

      File.Phdr_Base :=
        Get_Offset (File, Get_Ehdr (File).E_Phoff,
                    Elf_Size (Get_Ehdr (File).E_Phnum
                              * Elf_Half (Elf_Phdr_Size)));
   end Load_Phdr;

   function Get_Phdr (File : Elf_File; Index : Elf_Half)
                     return Elf_Phdr_Acc
   is
   begin
      if Index >= File.Ehdr.E_Phnum then
         raise Constraint_Error;
      end if;
      return To_Elf_Phdr_Acc
        (File.Phdr_Base
         + Storage_Offset (Index * Elf_Half (Elf_Phdr_Size)));
   end Get_Phdr;

   function Get_Strtab (File : Elf_File; Index : Elf_Half)
                       return Strtab_Type
   is
      Shdr : Elf_Shdr_Acc;
   begin
      Shdr := Get_Shdr (File, Index);
      if Shdr = null or Shdr.Sh_Type /= SHT_STRTAB then
         return Null_Strtab;
      end if;
      return (Base => To_Strtab_Fat_Acc (Get_Section_Base (File, Shdr.all)),
              Length => Shdr.Sh_Size);
   end Get_Strtab;

   procedure Load_Shdr (File : in out Elf_File)
   is
   begin
      if Get_Ehdr (File).E_Shentsize /= Elf_Half (Elf_Shdr_Size) then
         return;
      end if;

      File.Shdr_Base :=
        Get_Offset (File, Get_Ehdr (File).E_Shoff,
                    Elf_Size (Get_Ehdr (File).E_Shnum
                              * Elf_Half (Elf_Shdr_Size)));
      File.Sh_Strtab := Get_Strtab (File, Get_Ehdr (File).E_Shstrndx);
   end Load_Shdr;

   function Get_Sh_Strtab (File : Elf_File) return Strtab_Type is
   begin
      return File.Sh_Strtab;
   end Get_Sh_Strtab;

   function Get_Section_Name (File : Elf_File; Index : Elf_Half)
                             return String
   is
   begin
      return Get_String (Get_Sh_Strtab (File),
                         Elf_Size (Get_Shdr (File, Index).Sh_Name));
   end Get_Section_Name;

   function Get_Section_By_Name (File : Elf_File; Name : String)
                                return Elf_Half
   is
      Ehdr : Elf_Ehdr_Acc;
      Shdr : Elf_Shdr_Acc;
      Sh_Strtab : Strtab_Type;
   begin
      Ehdr := Get_Ehdr (File);
      Sh_Strtab := Get_Sh_Strtab (File);
      for I in 1 .. Ehdr.E_Shnum - 1 loop
         Shdr := Get_Shdr (File, I);
         if Get_String (Sh_Strtab, Elf_Size (Shdr.Sh_Name)) = Name then
            return I;
         end if;
      end loop;
      return 0;
   end Get_Section_By_Name;

   procedure Disp_Symtab (File : Elf_File; Index : Elf_Half)
   is
      Shdr : Elf_Shdr_Acc;
      S_Strtab : Strtab_Type;
      Base : Address;
      Off : Storage_Offset;
   begin
      Shdr := Get_Shdr (File, Index);
      if Shdr.Sh_Entsize /= Elf_Size (Elf_Sym_Size) then
         return;
      end if;
      S_Strtab := Get_Strtab (File, Elf_Half (Shdr.Sh_Link));
      Base := Get_Section_Base (File, Shdr.all);
      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Disp_Sym (File, To_Elf_Sym_Acc (Base + Off).all, S_Strtab);
         Off := Off + Storage_Offset (Elf_Sym_Size);
      end loop;
   end Disp_Symtab;

   procedure Disp_Strtab (File : Elf_File; Index : Elf_Half)
   is
      Strtab : Strtab_Type;
      S, E : Elf_Size;
   begin
      Strtab := Get_Strtab (File, Index);
      S := 1;
      while S < Strtab.Length loop
         E := S;
         while Strtab.Base (E) /= Nul loop
            E := E + 1;
         end loop;
         Put_Line (Hex_Image (S) & ": "
                   & String (Strtab.Base (S .. E - 1)));
         S := E + 1;
      end loop;
   end Disp_Strtab;

   function Read_Byte (Addr : Address) return Unsigned_8
   is
      type Unsigned_8_Acc is access all Unsigned_8;
      function To_Unsigned_8_Acc is new Ada.Unchecked_Conversion
        (Address, Unsigned_8_Acc);
   begin
      return To_Unsigned_8_Acc (Addr).all;
   end Read_Byte;

   procedure Read_ULEB128 (Base : Address;
                           Off : in out Storage_Offset;
                           Res : out Unsigned_32)
   is
      B : Unsigned_8;
      Shift : Integer;
   begin
      Res := 0;
      Shift := 0;
      loop
         B := Read_Byte (Base + Off);
         Off := Off + 1;
         Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift);
         exit when (B and 16#80#) = 0;
         Shift := Shift + 7;
      end loop;
   end Read_ULEB128;

   procedure Read_SLEB128 (Base : Address;
                           Off : in out Storage_Offset;
                           Res : out Unsigned_32)
   is
      B : Unsigned_8;
      Shift : Integer;
   begin
      Res := 0;
      Shift := 0;
      loop
         B := Read_Byte (Base + Off);
         Off := Off + 1;
         Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift);
         Shift := Shift + 7;
         exit when (B and 16#80#) = 0;
      end loop;
      if Shift < 32 and (Res and Shift_Left (1, Shift - 1)) /= 0 then
         Res := Res or Shift_Left (-1, Shift);
      end if;
   end Read_SLEB128;

   procedure Read_Word4 (Base : Address;
                         Off : in out Storage_Offset;
                         Res : out Unsigned_32)
   is
      B0, B1, B2, B3 : Unsigned_8;
   begin
      B0 := Read_Byte (Base + Off + 0);
      B1 := Read_Byte (Base + Off + 1);
      B2 := Read_Byte (Base + Off + 2);
      B3 := Read_Byte (Base + Off + 3);
      Res := Shift_Left (Unsigned_32 (B3), 24)
        or Shift_Left (Unsigned_32 (B2), 16)
        or Shift_Left (Unsigned_32 (B1), 8)
        or Shift_Left (Unsigned_32 (B0), 0);
      Off := Off + 4;
   end Read_Word4;

   procedure Read_Word2 (Base : Address;
                         Off : in out Storage_Offset;
                         Res : out Unsigned_16)
   is
      B0, B1 : Unsigned_8;
   begin
      B0 := Read_Byte (Base + Off + 0);
      B1 := Read_Byte (Base + Off + 1);
      Res := Shift_Left (Unsigned_16 (B1), 8)
        or Shift_Left (Unsigned_16 (B0), 0);
      Off := Off + 2;
   end Read_Word2;

   procedure Read_Byte (Base : Address;
                        Off : in out Storage_Offset;
                        Res : out Unsigned_8)
   is
   begin
      Res := Read_Byte (Base + Off);
      Off := Off + 1;
   end Read_Byte;

   procedure Disp_Note (Base : Address; Size : Storage_Offset)
   is
      Off : Storage_Offset;
      Namesz : Unsigned_32;
      Descsz : Unsigned_32;
      Ntype : Unsigned_32;
      B : Unsigned_8;
      Is_Full : Boolean;
   begin
      Off := 0;
      while Off < Size loop
         Read_Word4 (Base, Off, Namesz);
         Read_Word4 (Base, Off, Descsz);
         Read_Word4 (Base, Off, Ntype);
         Put ("type : ");
         Put (Hex_Image (Ntype));
         New_Line;
         Put ("name : ");
         Put (Hex_Image (Namesz));
         Put ("  ");
         for I in 1 .. Namesz loop
            Read_Byte (Base, Off, B);
            if B /= 0 then
               Put (Character'Val (B));
            end if;
         end loop;
         if Namesz mod 4 /= 0 then
            for I in (Namesz mod 4) .. 3 loop
               Read_Byte (Base, Off, B);
            end loop;
         end if;
         New_Line;
         Put ("desc : ");
         Put (Hex_Image (Descsz));
         Put (" ");
         Is_Full := Descsz >= 20;
         for I in 1 .. Descsz loop
            if Is_Full and (I mod 16) = 1 then
               New_Line;
            end if;
            Read_Byte (Base, Off, B);
            Put (' ');
            Put (Hex_Image (B));
         end loop;
         if Descsz mod 4 /= 0 then
            for I in (Descsz mod 4) .. 3 loop
               Read_Byte (Base, Off, B);
            end loop;
         end if;
         New_Line;
      end loop;
   end Disp_Note;

   procedure Disp_Section_Note (File : Elf_File; Index : Elf_Half)
   is
      Shdr : Elf_Shdr_Acc;
      Base : Address;
   begin
      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);
      Disp_Note (Base, Storage_Offset (Shdr.Sh_Size));
   end Disp_Section_Note;

   procedure Disp_Segment_Note (File : Elf_File; Index : Elf_Half)
   is
      Phdr : Elf_Phdr_Acc;
      Base : Address;
   begin
      Phdr := Get_Phdr (File, Index);
      Base := Get_Segment_Base (File, Phdr.all);
      Disp_Note (Base, Storage_Offset (Phdr.P_Filesz));
   end Disp_Segment_Note;


   function Get_Dt_Name (Name : Elf_Word) return String is
   begin
      case Name is
         when DT_NULL =>
            return "NULL";
         when DT_NEEDED =>
            return "NEEDED";
         when DT_PLTRELSZ =>
            return "PLTRELSZ";
         when DT_PLTGOT =>
            return "PLTGOT";
         when DT_HASH =>
            return "HASH";
         when DT_STRTAB =>
            return "STRTAB";
         when DT_SYMTAB =>
            return "SYMTAB";
         when DT_RELA =>
            return "RELA";
         when DT_RELASZ =>
            return "RELASZ";
         when DT_RELAENT =>
            return "RELAENT";
         when DT_STRSZ =>
            return "STRSZ";
         when DT_SYMENT =>
            return "SYMENT";
         when DT_INIT =>
            return "INIT";
         when DT_FINI =>
            return "FINI";
         when DT_SONAME =>
            return "SONAME";
         when DT_RPATH =>
            return "RPATH";
         when DT_SYMBOLIC =>
            return "SYMBOLIC";
         when DT_REL =>
            return "REL";
         when DT_RELSZ =>
            return "RELSZ";
         when DT_RELENT =>
            return "RELENT";
         when DT_PLTREL =>
            return "PLTREL";
         when DT_DEBUG =>
            return "DEBUG";
         when DT_TEXTREL =>
            return "TEXTREL";
         when DT_JMPREL =>
            return "JMPREL";
         when DT_BIND_NOW =>
            return "BIND_NOW";
         when DT_INIT_ARRAY =>
            return "INIT_ARRAY";
         when DT_FINI_ARRAY =>
            return "FINI_ARRAY";
         when DT_INIT_ARRAYSZ =>
            return "INIT_ARRAYSZ";
         when DT_FINI_ARRAYSZ =>
            return "FINI_ARRAYSZ";
         when DT_RUNPATH =>
            return "RUNPATH";
         when DT_FLAGS =>
            return "FLAGS";
--           when DT_ENCODING =>
--              return "ENCODING";
         when DT_PREINIT_ARRAY =>
            return "PREINIT_ARRAY";
         when DT_PREINIT_ARRAYSZ =>
            return "PREINIT_ARRAYSZ";
         when DT_NUM =>
            return "NUM";
         when DT_LOOS =>
            return "LOOS";
--           when DT_HIOS =>
--              return "HIOS";
         when DT_LOPROC =>
            return "LOPROC";
--           when DT_HIPROC =>
--              return "HIPROC";
         when DT_VALRNGLO =>
            return "VALRNGLO";
         when DT_GNU_PRELINKED =>
            return "GNU_PRELINKED";
         when DT_GNU_CONFLICTSZ =>
            return "GNU_CONFLICTSZ";
         when DT_GNU_LIBLISTSZ =>
            return "GNU_LIBLISTSZ";
         when DT_CHECKSUM =>
            return "CHECKSUM";
         when DT_PLTPADSZ =>
            return "PLTPADSZ";
         when DT_MOVEENT =>
            return "MOVEENT";
         when DT_MOVESZ =>
            return "MOVESZ";
         when DT_FEATURE_1 =>
            return "FEATURE_1";
         when DT_POSFLAG_1 =>
            return "POSFLAG_1";
         when DT_SYMINSZ =>
            return "SYMINSZ";
         when DT_SYMINENT =>
            return "SYMINENT";
--           when DT_VALRNGHI =>
--              return "VALRNGHI";
         when DT_ADDRRNGLO =>
            return "ADDRRNGLO";
         when DT_GNU_CONFLICT =>
            return "GNU_CONFLICT";
         when DT_GNU_LIBLIST =>
            return "GNU_LIBLIST";
         when DT_CONFIG =>
            return "CONFIG";
         when DT_DEPAUDIT =>
            return "DEPAUDIT";
         when DT_AUDIT =>
            return "AUDIT";
         when DT_PLTPAD =>
            return "PLTPAD";
         when DT_MOVETAB =>
            return "MOVETAB";
         when DT_SYMINFO =>
            return "SYMINFO";
--           when DT_ADDRRNGHI =>
--              return "ADDRRNGHI";
         when DT_VERSYM =>
            return "VERSYM";
         when DT_RELACOUNT =>
            return "RELACOUNT";
         when DT_RELCOUNT =>
            return "RELCOUNT";
         when DT_FLAGS_1 =>
            return "FLAGS_1";
         when DT_VERDEF =>
            return "VERDEF";
         when DT_VERDEFNUM =>
            return "VERDEFNUM";
         when DT_VERNEED =>
            return "VERNEED";
         when DT_VERNEEDNUM =>
            return "VERNEEDNUM";
         when DT_AUXILIARY =>
            return "AUXILIARY";
         when DT_FILTER =>
            return "FILTER";
         when others =>
            return "?unknown?";
      end case;
   end Get_Dt_Name;

   procedure Disp_Dynamic (File : Elf_File; Index : Elf_Half)
   is
      Shdr : Elf_Shdr_Acc;
      Base : Address;
      Off : Storage_Offset;
      Tag : Unsigned_32;
      Val : Unsigned_32;
   begin
      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);
      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Read_Word4 (Base, Off, Tag);
         Read_Word4 (Base, Off, Val);
         Put ("tag : ");
         Put (Hex_Image (Tag));
         Put ("  (");
         Put (Get_Dt_Name (Tag));
         Put (")");
         Set_Col (34);
         Put ("val : ");
         Put (Hex_Image (Val));
         New_Line;
      end loop;
   end Disp_Dynamic;

   function Get_Dwarf_Form_Name (Name : Unsigned_32) return String
   is
      use Dwarf;
   begin
      case Name is
         when DW_FORM_Addr =>
            return "addr";
         when DW_FORM_Block2 =>
            return "block2";
         when DW_FORM_Block4 =>
            return "block4";
         when DW_FORM_Data2 =>
            return "data2";
         when DW_FORM_Data4 =>
            return "data4";
         when DW_FORM_Data8 =>
            return "data8";
         when DW_FORM_String =>
            return "string";
         when DW_FORM_Block =>
            return "block";
         when DW_FORM_Block1 =>
            return "block1";
         when DW_FORM_Data1 =>
            return "data1";
         when DW_FORM_Flag =>
            return "flag";
         when DW_FORM_Sdata =>
            return "sdata";
         when DW_FORM_Strp =>
            return "strp";
         when DW_FORM_Udata =>
            return "udata";
         when DW_FORM_Ref_Addr =>
            return "ref_addr";
         when DW_FORM_Ref1 =>
            return "ref1";
         when DW_FORM_Ref2 =>
            return "ref2";
         when DW_FORM_Ref4 =>
            return "ref4";
         when DW_FORM_Ref8 =>
            return "ref8";
         when DW_FORM_Ref_Udata =>
            return "ref_udata";
         when DW_FORM_Indirect =>
            return "indirect";
         when others =>
            return "unknown";
      end case;
   end Get_Dwarf_Form_Name;

   function Get_Dwarf_Tag_Name (Tag : Unsigned_32) return String
   is
      use Dwarf;
   begin
      case Tag is
         when DW_TAG_Array_Type =>
            return "array_type";
         when DW_TAG_Class_Type =>
            return "class_type";
         when DW_TAG_Entry_Point =>
            return "entry_point";
         when DW_TAG_Enumeration_Type =>
            return "enumeration_type";
         when DW_TAG_Formal_Parameter =>
            return "formal_parameter";
         when DW_TAG_Imported_Declaration =>
            return "imported_declaration";
         when DW_TAG_Label =>
            return "label";
         when DW_TAG_Lexical_Block =>
            return "lexical_block";
         when DW_TAG_Member =>
            return "member";
         when DW_TAG_Pointer_Type =>
            return "pointer_type";
         when DW_TAG_Reference_Type =>
            return "reference_type";
         when DW_TAG_Compile_Unit =>
            return "compile_unit";
         when DW_TAG_String_Type =>
            return "string_type";
         when DW_TAG_Structure_Type =>
            return "structure_type";
         when DW_TAG_Subroutine_Type =>
            return "subroutine_type";
         when DW_TAG_Typedef =>
            return "typedef";
         when DW_TAG_Union_Type =>
            return "union_type";
         when DW_TAG_Unspecified_Parameters =>
            return "unspecified_parameters";
         when DW_TAG_Variant =>
            return "variant";
         when DW_TAG_Common_Block =>
            return "common_block";
         when DW_TAG_Common_Inclusion =>
            return "common_inclusion";
         when DW_TAG_Inheritance =>
            return "inheritance";
         when DW_TAG_Inlined_Subroutine =>
            return "inlined_subroutine";
         when DW_TAG_Module =>
            return "module";
         when DW_TAG_Ptr_To_Member_Type =>
            return "ptr_to_member_type";
         when DW_TAG_Set_Type =>
            return "set_type";
         when DW_TAG_Subrange_Type =>
            return "subrange_type";
         when DW_TAG_With_Stmt =>
            return "with_stmt";
         when DW_TAG_Access_Declaration =>
            return "access_declaration";
         when DW_TAG_Base_Type =>
            return "base_type";
         when DW_TAG_Catch_Block =>
            return "catch_block";
         when DW_TAG_Const_Type =>
            return "const_type";
         when DW_TAG_Constant =>
            return "constant";
         when DW_TAG_Enumerator =>
            return "enumerator";
         when DW_TAG_File_Type =>
            return "file_type";
         when DW_TAG_Friend =>
            return "friend";
         when DW_TAG_Namelist =>
            return "namelist";
         when DW_TAG_Namelist_Item =>
            return "namelist_item";
         when DW_TAG_Packed_Type =>
            return "packed_type";
         when DW_TAG_Subprogram =>
            return "subprogram";
         when DW_TAG_Template_Type_Parameter =>
            return "template_type_parameter";
         when DW_TAG_Template_Value_Parameter =>
            return "template_value_parameter";
         when DW_TAG_Thrown_Type =>
            return "thrown_type";
         when DW_TAG_Try_Block =>
            return "try_block";
         when DW_TAG_Variant_Part =>
            return "variant_part";
         when DW_TAG_Variable =>
            return "variable";
         when DW_TAG_Volatile_Type =>
            return "volatile_type";
         when DW_TAG_Dwarf_Procedure =>
            return "dwarf_procedure";
         when DW_TAG_Restrict_Type =>
            return "restrict_type";
         when DW_TAG_Interface_Type =>
            return "interface_type";
         when DW_TAG_Namespace =>
            return "namespace";
         when DW_TAG_Imported_Module =>
            return "imported_module";
         when DW_TAG_Unspecified_Type =>
            return "unspecified_type";
         when DW_TAG_Partial_Unit =>
            return "partial_unit";
         when DW_TAG_Imported_Unit =>
            return "imported_unit";
         when DW_TAG_Mutable_Type =>
            return "mutable_type";
         when others =>
            return "unknown";
      end case;
   end Get_Dwarf_Tag_Name;

   function Get_Dwarf_At_Name (Attr : Unsigned_32) return String
   is
      use Dwarf;
   begin
      case Attr is
         when DW_AT_Sibling =>
            return "sibling";
         when DW_AT_Location =>
            return "location";
         when DW_AT_Name =>
            return "name";
         when DW_AT_Ordering =>
            return "ordering";
         when DW_AT_Byte_Size =>
            return "byte_size";
         when DW_AT_Bit_Offset =>
            return "bit_offset";
         when DW_AT_Bit_Size =>
            return "bit_size";
         when DW_AT_Stmt_List =>
            return "stmt_list";
         when DW_AT_Low_Pc =>
            return "low_pc";
         when DW_AT_High_Pc =>
            return "high_pc";
         when DW_AT_Language =>
            return "language";
         when DW_AT_Discr =>
            return "discr";
         when DW_AT_Discr_Value =>
            return "discr_value";
         when DW_AT_Visibility =>
            return "visibility";
         when DW_AT_Import =>
            return "import";
         when DW_AT_String_Length =>
            return "string_length";
         when DW_AT_Common_Reference =>
            return "common_reference";
         when DW_AT_Comp_Dir =>
            return "comp_dir";
         when DW_AT_Const_Value =>
            return "const_value";
         when DW_AT_Containing_Type =>
            return "containing_type";
         when DW_AT_Default_Value =>
            return "default_value";
         when DW_AT_Inline =>
            return "inline";
         when DW_AT_Is_Optional =>
            return "is_optional";
         when DW_AT_Lower_Bound =>
            return "lower_bound";
         when DW_AT_Producer =>
            return "producer";
         when DW_AT_Prototyped =>
            return "prototyped";
         when DW_AT_Return_Addr =>
            return "return_addr";
         when DW_AT_Start_Scope =>
            return "start_scope";
         when DW_AT_Stride_Size =>
            return "stride_size";
         when DW_AT_Upper_Bound =>
            return "upper_bound";
         when DW_AT_Abstract_Origin =>
            return "abstract_origin";
         when DW_AT_Accessibility =>
            return "accessibility";
         when DW_AT_Address_Class =>
            return "address_class";
         when DW_AT_Artificial =>
            return "artificial";
         when DW_AT_Base_Types =>
            return "base_types";
         when DW_AT_Calling_Convention =>
            return "calling_convention";
         when DW_AT_Count =>
            return "count";
         when DW_AT_Data_Member_Location =>
            return "data_member_location";
         when DW_AT_Decl_Column =>
            return "decl_column";
         when DW_AT_Decl_File =>
            return "decl_file";
         when DW_AT_Decl_Line =>
            return "decl_line";
         when DW_AT_Declaration =>
            return "declaration";
         when DW_AT_Discr_List =>
            return "discr_list";
         when DW_AT_Encoding =>
            return "encoding";
         when DW_AT_External =>
            return "external";
         when DW_AT_Frame_Base =>
            return "frame_base";
         when DW_AT_Friend =>
            return "friend";
         when DW_AT_Identifier_Case =>
            return "identifier_case";
         when DW_AT_Macro_Info =>
            return "macro_info";
         when DW_AT_Namelist_Item =>
            return "namelist_item";
         when DW_AT_Priority =>
            return "priority";
         when DW_AT_Segment =>
            return "segment";
         when DW_AT_Specification =>
            return "specification";
         when DW_AT_Static_Link =>
            return "static_link";
         when DW_AT_Type =>
            return "type";
         when DW_AT_Use_Location =>
            return "use_location";
         when DW_AT_Variable_Parameter =>
            return "variable_parameter";
         when DW_AT_Virtuality =>
            return "virtuality";
         when DW_AT_Vtable_Elem_Location =>
            return "vtable_elem_location";
         when DW_AT_Allocated =>
            return "allocated";
         when DW_AT_Associated =>
            return "associated";
         when DW_AT_Data_Location =>
            return "data_location";
         when DW_AT_Stride =>
            return "stride";
         when DW_AT_Entry_Pc =>
            return "entry_pc";
         when DW_AT_Use_UTF8 =>
            return "use_utf8";
         when DW_AT_Extension =>
            return "extension";
         when DW_AT_Ranges =>
            return "ranges";
         when DW_AT_Trampoline =>
            return "trampoline";
         when DW_AT_Call_Column =>
            return "call_column";
         when DW_AT_Call_File =>
            return "call_file";
         when DW_AT_Call_Line =>
            return "call_line";
         when DW_AT_Description =>
            return "description";
         when others =>
            return "unknown";
      end case;
   end Get_Dwarf_At_Name;

   procedure Disp_Debug_Abbrev (File : Elf_File; Index : Elf_Half)
   is
      Shdr : Elf_Shdr_Acc;
      Base : Address;
      Old_Off : Storage_Offset;
      Off : Storage_Offset;
      V : Unsigned_32;
      Tag : Unsigned_32;
      Name : Unsigned_32;
      Form : Unsigned_32;
   begin
      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);

      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Old_Off := Off;
         Read_ULEB128 (Base, Off, V);
         Put_Line ("abbrev #" & Hex_Image (V) & " at "
                   & Hex_Image (Unsigned_32 (Old_Off)) & ':');
         if V = 0 then
            Put_Line ("pad");
            goto Again;
         end if;
         Read_ULEB128 (Base, Off, Tag);
         Put (" tag: " & Hex_Image (Tag));
         Put (" (");
         Put (Get_Dwarf_Tag_Name (Tag));
         Put ("),  children: " & Hex_Image (Read_Byte (Base + Off)));
         New_Line;
         Off := Off + 1;
         loop
            Read_ULEB128 (Base, Off, Name);
            Read_ULEB128 (Base, Off, Form);
            Put ("   name: " & Hex_Image (Name));
            Put (" (");
            Put (Get_Dwarf_At_Name (Name));
            Put (")");
            Set_Col (42);
            Put ("form: " & Hex_Image (Form));
            Put (" (");
            Put (Get_Dwarf_Form_Name (Form));
            Put (")");
            New_Line;
            exit when Name = 0 and Form = 0;
         end loop;
         << Again >> null;
      end loop;
   end Disp_Debug_Abbrev;

   type Abbrev_Map_Type is array (Unsigned_32 range <>) of Address;
   type Abbrev_Map_Acc is access Abbrev_Map_Type;
   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
     (Abbrev_Map_Type, Abbrev_Map_Acc);

   procedure Build_Abbrev_Map (Base : Address; Res : out Abbrev_Map_Acc)
   is
      Max : Unsigned_32;
      Off : Storage_Offset;
      V : Unsigned_32;
      V1 : Unsigned_32;
      N_Res : Abbrev_Map_Acc;
   begin
      Off := 0;
      Max := 0;
      Res := new Abbrev_Map_Type (0 .. 128);
      Res.all := (others => Null_Address);
      loop
         Read_ULEB128 (Base, Off, V);
         if V > Max then
            Max := V;
         end if;
         exit when V = 0;
         if Max > Res.all'Last then
            N_Res := new Abbrev_Map_Type (0 .. 2 * Max);
            N_Res (Res'Range) := Res.all;
            N_Res (Res'Last + 1 .. N_Res'Last) := (others => Null_Address);
            Unchecked_Deallocation (Res);
            Res := N_Res;
         end if;
         if Res (V) /= Null_Address then
            Put_Line ("!! abbrev override !!");
            return;
         end if;
         Res (V) := Base + Off;
         Read_ULEB128 (Base, Off, V);
         --  Skip child flag.
         Off := Off + 1;
         loop
            Read_ULEB128 (Base, Off, V);
            Read_ULEB128 (Base, Off, V1);
            exit when V = 0 and V1 = 0;
         end loop;
      end loop;
   end Build_Abbrev_Map;

   procedure Disp_Block (Base : Address;
                         Off : in out Storage_Offset;
                         Cnt : Unsigned_32)
   is
   begin
      for I in 1 .. Cnt loop
         Put (" ");
         Put (Hex_Image (Read_Byte (Base + Off + Storage_Offset (I - 1))));
      end loop;
      Off := Off + Storage_Offset (Cnt);
   end Disp_Block;

   procedure Disp_Dwarf_Form (Base : Address;
                              Off : in out Storage_Offset;
                              Form : Unsigned_32)
   is
      use Dwarf;
   begin
      case Form is
         when DW_FORM_Addr =>
            declare
               V : Unsigned_32;
            begin
               Read_Word4 (Base, Off, V);
               Put ("address: " & Hex_Image (V));
            end;
         when DW_FORM_Flag =>
            declare
               V : Unsigned_8;
            begin
               Read_Byte (Base, Off, V);
               Put ("flag: " & Hex_Image (V));
            end;
         when DW_FORM_Block1 =>
            declare
               V : Unsigned_8;
            begin
               Read_Byte (Base, Off, V);
               Put ("block1: " & Hex_Image (V));
               Disp_Block (Base, Off, Unsigned_32 (V));
            end;
         when DW_FORM_Data1 =>
            declare
               V : Unsigned_8;
            begin
               Read_Byte (Base, Off, V);
               Put ("data1: " & Hex_Image (V));
            end;
         when DW_FORM_Data2 =>
            declare
               V : Unsigned_16;
            begin
               Read_Word2 (Base, Off, V);
               Put ("data2: " & Hex_Image (V));
            end;
         when DW_FORM_Data4 =>
            declare
               V : Unsigned_32;
            begin
               Read_Word4 (Base, Off, V);
               Put ("data4: " & Hex_Image (V));
            end;
         when DW_FORM_Sdata =>
            declare
               V : Unsigned_32;
            begin
               Read_SLEB128 (Base, Off, V);
               Put ("sdata: " & Hex_Image (V));
            end;
         when DW_FORM_Udata =>
            declare
               V : Unsigned_32;
            begin
               Read_ULEB128 (Base, Off, V);
               Put ("udata: " & Hex_Image (V));
            end;
         when DW_FORM_Ref4 =>
            declare
               V : Unsigned_32;
            begin
               Read_Word4 (Base, Off, V);
               Put ("ref4: " & Hex_Image (V));
            end;
         when DW_FORM_Strp =>
            declare
               V : Unsigned_32;
            begin
               Read_Word4 (Base, Off, V);
               Put ("strp: " & Hex_Image (V));
            end;
         when DW_FORM_String =>
            declare
               C : Unsigned_8;
            begin
               Put ("string: ");
               loop
                  Read_Byte (Base, Off, C);
                  exit when C = 0;
                  Put (Character'Val (C));
               end loop;
            end;
         when others =>
            Put ("???");
            raise Program_Error;
      end case;
   end Disp_Dwarf_Form;

   function Get_Dwarf_ATE_Name (Val : Unsigned_32) return String
   is
      use Dwarf;
   begin
      case Val is
         when DW_ATE_Address =>
            return "address";
         when DW_ATE_Boolean =>
            return "boolean";
         when DW_ATE_Complex_Float =>
            return "complex_float";
         when DW_ATE_Float =>
            return "float";
         when DW_ATE_Signed =>
            return "signed";
         when DW_ATE_Signed_Char =>
            return "signed_char";
         when DW_ATE_Unsigned =>
            return "unsigned";
         when DW_ATE_Unsigned_Char =>
            return "unsigned_char";
         when DW_ATE_Imaginary_Float =>
            return "imaginary_float";
         when others =>
            return "unknown";
      end case;
   end Get_Dwarf_ATE_Name;

   procedure Read_Dwarf_Constant (Base : Address;
                                  Off : in out Storage_Offset;
                                  Form : Unsigned_32;
                                  Res : out Unsigned_32)
   is
      use Dwarf;
   begin
      case Form is
         when DW_FORM_Data1 =>
            declare
               V : Unsigned_8;
            begin
               Read_Byte (Base, Off, V);
               Res := Unsigned_32 (V);
            end;
         when DW_FORM_Data2 =>
            declare
               V : Unsigned_16;
            begin
               Read_Word2 (Base, Off, V);
               Res := Unsigned_32 (V);
            end;
         when DW_FORM_Data4 =>
            declare
               V : Unsigned_32;
            begin
               Read_Word4 (Base, Off, V);
               Res := V;
            end;
         when DW_FORM_Sdata =>
            declare
               V : Unsigned_32;
            begin
               Read_SLEB128 (Base, Off, V);
               Res := V;
            end;
         when others =>
            raise Program_Error;
      end case;
   end Read_Dwarf_Constant;

   procedure Disp_Dwarf_Encoding
     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
   is
      Val : Unsigned_32;
   begin
      Read_Dwarf_Constant (Base, Off, Form, Val);
      Put (Get_Dwarf_ATE_Name (Val));
   end Disp_Dwarf_Encoding;

   function Get_Dwarf_Lang_Name (Lang : Unsigned_32) return String
   is
      use Dwarf;
   begin
      case Lang is
         when DW_LANG_C89 =>
            return "C89";
         when DW_LANG_C =>
            return "C";
         when DW_LANG_Ada83 =>
            return "Ada83";
         when DW_LANG_C_Plus_Plus =>
            return "C_Plus_Plus";
         when DW_LANG_Cobol74 =>
            return "Cobol74";
         when DW_LANG_Cobol85 =>
            return "Cobol85";
         when DW_LANG_Fortran77 =>
            return "Fortran77";
         when DW_LANG_Fortran90 =>
            return "Fortran90";
         when DW_LANG_Pascal83 =>
            return "Pascal83";
         when DW_LANG_Modula2 =>
            return "Modula2";
         when DW_LANG_Java =>
            return "Java";
         when DW_LANG_C99 =>
            return "C99";
         when DW_LANG_Ada95 =>
            return "Ada95";
         when DW_LANG_Fortran95 =>
            return "Fortran95";
         when DW_LANG_PLI =>
            return "PLI";
         when others =>
            return "?unknown?";
      end case;
   end Get_Dwarf_Lang_Name;

   procedure Disp_Dwarf_Language
     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
   is
      Val : Unsigned_32;
   begin
      Read_Dwarf_Constant (Base, Off, Form, Val);
      Put (Get_Dwarf_Lang_Name (Val));
   end Disp_Dwarf_Language;

   function Get_Dwarf_Op_Name (Op : Unsigned_8) return String
   is
      use Dwarf;
   begin
      case Op is
         when DW_OP_Addr =>
            return "addr";
         when DW_OP_Deref =>
            return "deref";
         when DW_OP_Const1u =>
            return "const1u";
         when DW_OP_Const1s =>
            return "const1s";
         when DW_OP_Const2u =>
            return "const2u";
         when DW_OP_Const2s =>
            return "const2s";
         when DW_OP_Const4u =>
            return "const4u";
         when DW_OP_Const4s =>
            return "const4s";
         when DW_OP_Const8u =>
            return "const8u";
         when DW_OP_Const8s =>
            return "const8s";
         when DW_OP_Constu =>
            return "constu";
         when DW_OP_Consts =>
            return "consts";
         when DW_OP_Dup =>
            return "dup";
         when DW_OP_Drop =>
            return "drop";
         when DW_OP_Over =>
            return "over";
         when DW_OP_Pick =>
            return "pick";
         when DW_OP_Swap =>
            return "swap";
         when DW_OP_Rot =>
            return "rot";
         when DW_OP_Xderef =>
            return "xderef";
         when DW_OP_Abs =>
            return "abs";
         when DW_OP_And =>
            return "and";
         when DW_OP_Div =>
            return "div";
         when DW_OP_Minus =>
            return "minus";
         when DW_OP_Mod =>
            return "mod";
         when DW_OP_Mul =>
            return "mul";
         when DW_OP_Neg =>
            return "neg";
         when DW_OP_Not =>
            return "not";
         when DW_OP_Or =>
            return "or";
         when DW_OP_Plus =>
            return "plus";
         when DW_OP_Plus_Uconst =>
            return "plus_uconst";
         when DW_OP_Shl =>
            return "shl";
         when DW_OP_Shr =>
            return "shr";
         when DW_OP_Shra =>
            return "shra";
         when DW_OP_Xor =>
            return "xor";
         when DW_OP_Skip =>
            return "skip";
         when DW_OP_Bra =>
            return "bra";
         when DW_OP_Eq =>
            return "eq";
         when DW_OP_Ge =>
            return "ge";
         when DW_OP_Gt =>
            return "gt";
         when DW_OP_Le =>
            return "le";
         when DW_OP_Lt =>
            return "lt";
         when DW_OP_Ne =>
            return "ne";
         when DW_OP_Lit0 =>
            return "lit0";
         when DW_OP_Lit1 =>
            return "lit1";
         when DW_OP_Lit2 =>
            return "lit2";
         when DW_OP_Lit3 =>
            return "lit3";
         when DW_OP_Lit4 =>
            return "lit4";
         when DW_OP_Lit5 =>
            return "lit5";
         when DW_OP_Lit6 =>
            return "lit6";
         when DW_OP_Lit7 =>
            return "lit7";
         when DW_OP_Lit8 =>
            return "lit8";
         when DW_OP_Lit9 =>
            return "lit9";
         when DW_OP_Lit10 =>
            return "lit10";
         when DW_OP_Lit11 =>
            return "lit11";
         when DW_OP_Lit12 =>
            return "lit12";
         when DW_OP_Lit13 =>
            return "lit13";
         when DW_OP_Lit14 =>
            return "lit14";
         when DW_OP_Lit15 =>
            return "lit15";
         when DW_OP_Lit16 =>
            return "lit16";
         when DW_OP_Lit17 =>
            return "lit17";
         when DW_OP_Lit18 =>
            return "lit18";
         when DW_OP_Lit19 =>
            return "lit19";
         when DW_OP_Lit20 =>
            return "lit20";
         when DW_OP_Lit21 =>
            return "lit21";
         when DW_OP_Lit22 =>
            return "lit22";
         when DW_OP_Lit23 =>
            return "lit23";
         when DW_OP_Lit24 =>
            return "lit24";
         when DW_OP_Lit25 =>
            return "lit25";
         when DW_OP_Lit26 =>
            return "lit26";
         when DW_OP_Lit27 =>
            return "lit27";
         when DW_OP_Lit28 =>
            return "lit28";
         when DW_OP_Lit29 =>
            return "lit29";
         when DW_OP_Lit30 =>
            return "lit30";
         when DW_OP_Lit31 =>
            return "lit31";
         when DW_OP_Reg0 =>
            return "reg0";
         when DW_OP_Reg1 =>
            return "reg1";
         when DW_OP_Reg2 =>
            return "reg2";
         when DW_OP_Reg3 =>
            return "reg3";
         when DW_OP_Reg4 =>
            return "reg4";
         when DW_OP_Reg5 =>
            return "reg5";
         when DW_OP_Reg6 =>
            return "reg6";
         when DW_OP_Reg7 =>
            return "reg7";
         when DW_OP_Reg8 =>
            return "reg8";
         when DW_OP_Reg9 =>
            return "reg9";
         when DW_OP_Reg10 =>
            return "reg10";
         when DW_OP_Reg11 =>
            return "reg11";
         when DW_OP_Reg12 =>
            return "reg12";
         when DW_OP_Reg13 =>
            return "reg13";
         when DW_OP_Reg14 =>
            return "reg14";
         when DW_OP_Reg15 =>
            return "reg15";
         when DW_OP_Reg16 =>
            return "reg16";
         when DW_OP_Reg17 =>
            return "reg17";
         when DW_OP_Reg18 =>
            return "reg18";
         when DW_OP_Reg19 =>
            return "reg19";
         when DW_OP_Reg20 =>
            return "reg20";
         when DW_OP_Reg21 =>
            return "reg21";
         when DW_OP_Reg22 =>
            return "reg22";
         when DW_OP_Reg23 =>
            return "reg23";
         when DW_OP_Reg24 =>
            return "reg24";
         when DW_OP_Reg25 =>
            return "reg25";
         when DW_OP_Reg26 =>
            return "reg26";
         when DW_OP_Reg27 =>
            return "reg27";
         when DW_OP_Reg28 =>
            return "reg28";
         when DW_OP_Reg29 =>
            return "reg29";
         when DW_OP_Reg30 =>
            return "reg30";
         when DW_OP_Reg31 =>
            return "reg31";
         when DW_OP_Breg0 =>
            return "breg0";
         when DW_OP_Breg1 =>
            return "breg1";
         when DW_OP_Breg2 =>
            return "breg2";
         when DW_OP_Breg3 =>
            return "breg3";
         when DW_OP_Breg4 =>
            return "breg4";
         when DW_OP_Breg5 =>
            return "breg5";
         when DW_OP_Breg6 =>
            return "breg6";
         when DW_OP_Breg7 =>
            return "breg7";
         when DW_OP_Breg8 =>
            return "breg8";
         when DW_OP_Breg9 =>
            return "breg9";
         when DW_OP_Breg10 =>
            return "breg10";
         when DW_OP_Breg11 =>
            return "breg11";
         when DW_OP_Breg12 =>
            return "breg12";
         when DW_OP_Breg13 =>
            return "breg13";
         when DW_OP_Breg14 =>
            return "breg14";
         when DW_OP_Breg15 =>
            return "breg15";
         when DW_OP_Breg16 =>
            return "breg16";
         when DW_OP_Breg17 =>
            return "breg17";
         when DW_OP_Breg18 =>
            return "breg18";
         when DW_OP_Breg19 =>
            return "breg19";
         when DW_OP_Breg20 =>
            return "breg20";
         when DW_OP_Breg21 =>
            return "breg21";
         when DW_OP_Breg22 =>
            return "breg22";
         when DW_OP_Breg23 =>
            return "breg23";
         when DW_OP_Breg24 =>
            return "breg24";
         when DW_OP_Breg25 =>
            return "breg25";
         when DW_OP_Breg26 =>
            return "breg26";
         when DW_OP_Breg27 =>
            return "breg27";
         when DW_OP_Breg28 =>
            return "breg28";
         when DW_OP_Breg29 =>
            return "breg29";
         when DW_OP_Breg30 =>
            return "breg30";
         when DW_OP_Breg31 =>
            return "breg31";
         when DW_OP_Regx =>
            return "regx";
         when DW_OP_Fbreg =>
            return "fbreg";
         when DW_OP_Bregx =>
            return "bregx";
         when DW_OP_Piece =>
            return "piece";
         when DW_OP_Deref_Size =>
            return "deref_size";
         when DW_OP_Xderef_Size =>
            return "xderef_size";
         when DW_OP_Nop =>
            return "nop";
         when DW_OP_Push_Object_Address =>
            return "push_object_address";
         when DW_OP_Call2 =>
            return "call2";
         when DW_OP_Call4 =>
            return "call4";
         when DW_OP_Call_Ref =>
            return "call_ref";
         when others =>
            return "unknown";
      end case;
   end Get_Dwarf_Op_Name;

   procedure Read_Dwarf_Block (Base : Address;
                               Off : in out Storage_Offset;
                               Form : Unsigned_32;
                               B : out Address;
                               L : out Unsigned_32)
   is
      use Dwarf;
   begin
      case Form is
         when DW_FORM_Block1 =>
            B := Base + Off + 1;
            L := Unsigned_32 (Read_Byte (Base + Off));
            Off := Off + 1;
         when others =>
            raise Program_Error;
      end case;
      Off := Off + Storage_Offset (L);
   end Read_Dwarf_Block;

   procedure Disp_Dwarf_Location
     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
   is
      use Dwarf;
      B : Address;
      L : Unsigned_32;
      Op : Unsigned_8;
      Boff : Storage_Offset;
      Is_Full : Boolean;
   begin
      Read_Dwarf_Block (Base, Off, Form, B, L);
      if L = 0 then
         return;
      end if;
      Is_Full := L > 6;
      Boff := 0;
      while Boff < Storage_Offset (L) loop
         if Is_Full then
            New_Line;
            Put ("   ");
            Put (Hex_Image (Unsigned_32 (Boff)));
            Put (": ");
         end if;
         Op := Read_Byte (B + Boff);
         Put (' ');
         Put (Get_Dwarf_Op_Name (Op));
         Boff := Boff + 1;
         case Op is
            when DW_OP_Addr =>
               declare
                  V : Unsigned_32;
               begin
                  Read_Word4 (B, Boff, V);
                  Put (':');
                  Put (Hex_Image (V));
               end;
            when DW_OP_Deref =>
               null;
            when DW_OP_Const1u
              | DW_OP_Const1s =>
               declare
                  V : Unsigned_8;
               begin
                  Read_Byte (B, Boff, V);
                  Put (':');
                  Put (Hex_Image (V));
               end;
--     DW_OP_Const2u     : constant := 16#0a#; -- 1 2-byte constant
--     DW_OP_Const2s     : constant := 16#0b#; -- 1 2-byte constant
--     DW_OP_Const4u     : constant := 16#0c#; -- 1 4-byte constant
--     DW_OP_Const4s     : constant := 16#0d#; -- 1 4-byte constant
--     DW_OP_Const8u     : constant := 16#0e#; -- 1 8-byte constant
--     DW_OP_Const8s     : constant := 16#0f#; -- 1 8-byte constant
--     DW_OP_Constu      : constant := 16#10#; -- 1 ULEB128 constant
--     DW_OP_Consts      : constant := 16#11#; -- 1 SLEB128 constant
--     DW_OP_Dup         : constant := 16#12#; -- 0
--     DW_OP_Drop        : constant := 16#13#; -- 0
--     DW_OP_Over        : constant := 16#14#; -- 0
--     DW_OP_Pick        : constant := 16#15#; -- 1 1-byte stack index

            when DW_OP_Swap
              | DW_OP_Rot
              | DW_OP_Xderef
              | DW_OP_Abs
              | DW_OP_And
              | DW_OP_Div
              | DW_OP_Minus
              | DW_OP_Mod
              | DW_OP_Mul
              | DW_OP_Neg
              | DW_OP_Not
              | DW_OP_Or
              | DW_OP_Plus =>
               null;
            when DW_OP_Plus_Uconst
              | DW_OP_Piece
              | DW_OP_Regx =>
               declare
                  V : Unsigned_32;
               begin
                  Read_ULEB128 (B, Boff, V);
                  Put (':');
                  Put (Hex_Image (V));
               end;
            when DW_OP_Shl
              | DW_OP_Shr
              | DW_OP_Shra
              | DW_OP_Xor =>
               null;
            when DW_OP_Skip
              | DW_OP_Bra =>
               declare
                  V : Unsigned_16;
               begin
                  Read_Word2 (B, Boff, V);
                  Put (':');
                  Put (Hex_Image (V));
                  Put (" (@");
                  --  FIXME: signed
                  Put (Hex_Image (Unsigned_32 (Boff) + Unsigned_32 (V)));
                  Put (")");
               end;
            when DW_OP_Eq
              | DW_OP_Ge
              | DW_OP_Gt
              | DW_OP_Le
              | DW_OP_Lt
              | DW_OP_Ne =>
               null;
            when DW_OP_Lit0 .. DW_OP_Lit31 =>
               null;
            when DW_OP_Reg0 .. DW_OP_Reg31 =>
               null;
            when DW_OP_Breg0 .. DW_OP_Breg31
              | DW_OP_Fbreg =>
               declare
                  V : Unsigned_32;
               begin
                  Read_SLEB128 (B, Boff, V);
                  Put (':');
                  Put (Hex_Image (V));
               end;

--   DW_OP_Regx        : constant := 16#90#; -- 1 ULEB128 register
--   DW_OP_Bregx       : constant := 16#92#; -- 2 ULEB128 reg + SLEB128 offset
--   DW_OP_Deref_Size  : constant := 16#94#; -- 1 1-byte size of data retrieved
--   DW_OP_Xderef_Size : constant := 16#95#; -- 1 1-byte size of data retrieved
            when DW_OP_Nop =>
               null;
--     DW_OP_Push_Object_Address : constant := 16#97#; -- 0
--     DW_OP_Call2       : constant := 16#98#; -- 1 2-byte offset of DIE
--     DW_OP_Call4       : constant := 16#99#; -- 1 4-byte offset of DIE
--     DW_OP_Call_Ref    : constant := 16#9a#; -- 1 4- or 8-byte offset of DIE
            when others =>
               raise Program_Error;
         end case;
      end loop;
   end Disp_Dwarf_Location;

   procedure Disp_Debug_Info (File : Elf_File; Index : Elf_Half)
   is
      use Dwarf;

      Abbrev_Index : Elf_Half;
      Abbrev_Base : Address;
      Map : Abbrev_Map_Acc;
      Abbrev : Address;

      Shdr : Elf_Shdr_Acc;
      Base : Address;
      Off : Storage_Offset;
      Aoff : Storage_Offset;
      Old_Off : Storage_Offset;

      Len : Unsigned_32;
      Ver : Unsigned_16;
      Abbrev_Off : Unsigned_32;
      Ptr_Sz : Unsigned_8;
      Last : Storage_Offset;
      Num : Unsigned_32;

      Tag : Unsigned_32;
      Name : Unsigned_32;
      Form : Unsigned_32;

      Level : Unsigned_8;
   begin
      Abbrev_Index := Get_Section_By_Name (File, ".debug_abbrev");
      Abbrev_Base := Get_Section_Base (File, Abbrev_Index);
      Map := null;

      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);

      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Put_Line ("Compilation unit at #"
                   & Hex_Image (Unsigned_32 (Off)) & ":");
         Read_Word4 (Base, Off, Len);
         Last := Off + Storage_Offset (Len);
         Read_Word2 (Base, Off, Ver);
         Read_Word4 (Base, Off, Abbrev_Off);
         Read_Byte (Base, Off, Ptr_Sz);
         Put (' ');
         Put ("length: " & Hex_Image (Len));
         Put (", version: " & Hex_Image (Ver));
         Put (", abbrev offset: " & Hex_Image (Abbrev_Off));
         Put (", ptr_sz: " & Hex_Image (Ptr_Sz));
         New_Line;
         Level := 0;

         Build_Abbrev_Map (Abbrev_Base + Storage_Offset (Abbrev_Off), Map);
         loop
            << Again >> null;
            exit when Off >= Last;
            Old_Off := Off;
            Read_ULEB128 (Base, Off, Num);
            Put ("<" & Hex_Image (Unsigned_32 (Old_Off)) & ">");
            Put ("<" & Hex_Image (Level) & ">");
            Put (" with abbrev #" & Hex_Image (Num));
            if Num = 0 then
               Level := Level - 1;
               New_Line;
               goto Again;
            end if;
            if Num <= Map.all'Last then
               Abbrev := Map (Num);
            else
               Abbrev := Null_Address;
            end if;
            if Abbrev = Null_Address then
               New_Line;
               Put ("!! abbrev #" & Hex_Image (Num) & " does not exist !!");
               New_Line;
               return;
            end if;
            Aoff := 0;
            Read_ULEB128 (Abbrev, Aoff, Tag);
            if Read_Byte (Abbrev + Aoff) /= 0 then
               Put (" [has_child]");
               Level := Level + 1;
            end if;
            New_Line;

            --  skip child.
            Aoff := Aoff + 1;
            Put (" tag: " & Hex_Image (Tag));
            Put (" (");
            Put (Get_Dwarf_Tag_Name (Tag));
            Put (")");
            New_Line;

            loop
               Read_ULEB128 (Abbrev, Aoff, Name);
               Read_ULEB128 (Abbrev, Aoff, Form);
               exit when Name = 0 and Form = 0;
               Put ("  ");
               Put (Get_Dwarf_At_Name (Name));
               Set_Col (24);
               Put (": ");
               Old_Off := Off;
               Disp_Dwarf_Form (Base, Off, Form);
               case Name is
                  when DW_AT_Encoding =>
                     Put (": ");
                     Disp_Dwarf_Encoding (Base, Old_Off, Form);
                  when DW_AT_Location
                    | DW_AT_Frame_Base
                    | DW_AT_Data_Member_Location =>
                     Put (":");
                     Disp_Dwarf_Location (Base, Old_Off, Form);
                  when DW_AT_Language =>
                     Put (": ");
                     Disp_Dwarf_Language (Base, Old_Off, Form);
                  when others =>
                     null;
               end case;
               New_Line;
            end loop;
         end loop;
         Unchecked_Deallocation (Map);
         New_Line;
      end loop;
   end Disp_Debug_Info;

   function Get_Phdr_Type_Name (Ptype : Elf_Word) return String is
   begin
      case Ptype is
         when PT_NULL =>
            return "NULL";
         when PT_LOAD =>
            return "LOAD";
         when PT_DYNAMIC =>
            return "DYNAMIC";
         when PT_INTERP =>
            return "INTERP";
         when PT_NOTE =>
            return "NOTE";
         when PT_SHLIB =>
            return "SHLIB";
         when PT_PHDR =>
            return "PHDR";
         when PT_TLS =>
            return "TLS";
         when PT_NUM =>
            return "NUM";
         when PT_GNU_EH_FRAME =>
            return "GNU_EH_FRAME";
         when PT_SUNWBSS =>
            return "SUNWBSS";
         when PT_SUNWSTACK =>
            return "SUNWSTACK";
         when others =>
            return "?unknown?";
      end case;
   end Get_Phdr_Type_Name;

   procedure Disp_Phdr (Phdr : Elf_Phdr)
   is
   begin
      Put ("type  : " & Hex_Image (Phdr.P_Type));
      Put ("  ");
      Put (Get_Phdr_Type_Name (Phdr.P_Type));
      New_Line;
      Put ("offset: " & Hex_Image (Phdr.P_Offset));
      Put ("  vaddr: " & Hex_Image (Phdr.P_Vaddr));
      Put ("  paddr: " & Hex_Image (Phdr.P_Paddr));
      New_Line;
      Put ("filesz: " & Hex_Image (Phdr.P_Filesz));
      Put ("  memsz: " & Hex_Image (Phdr.P_Memsz));
      Put ("  align: " & Hex_Image (Phdr.P_Align));
      --New_Line;
      Put ("  flags: " & Hex_Image (Phdr.P_Flags));
      Put (" (");
      if (Phdr.P_Flags and PF_X) /= 0 then
         Put ('X');
      end if;
      if (Phdr.P_Flags and PF_W) /= 0 then
         Put ('W');
      end if;
      if (Phdr.P_Flags and PF_R) /= 0 then
         Put ('R');
      end if;
      Put (")");
      New_Line;
   end Disp_Phdr;

   procedure Disp_Debug_Pubnames (File : Elf_File; Index : Elf_Half)
   is
      Shdr : Elf_Shdr_Acc;
      Base : Address;
      Off : Storage_Offset;
      B : Unsigned_8;

      Len : Unsigned_32;
      Ver : Unsigned_16;
      Info_Off : Unsigned_32;
      Info_Length : Unsigned_32;
      Last : Storage_Offset;
      Ioff : Unsigned_32;
   begin
      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);

      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Read_Word4 (Base, Off, Len);
         Last := Off + Storage_Offset (Len);
         Read_Word2 (Base, Off, Ver);
         Read_Word4 (Base, Off, Info_Off);
         Read_Word4 (Base, Off, Info_Length);
         Put ("length: " & Hex_Image (Len));
         Put (", version: " & Hex_Image (Ver));
         Put (", offset: " & Hex_Image (Info_Off));
         Put (", length: " & Hex_Image (Info_Length));
         New_Line;

         loop
            Read_Word4 (Base, Off, Ioff);
            Put ("  ");
            Put (Hex_Image (Ioff));
            if Ioff /= 0 then
               Put (": ");
               loop
                  Read_Byte (Base, Off, B);
                  exit when B = 0;
                  Put (Character'Val (B));
               end loop;
            end if;
            New_Line;
            exit when Ioff = 0;
         end loop;
      end loop;
   end Disp_Debug_Pubnames;

   procedure Disp_Debug_Aranges (File : Elf_File; Index : Elf_Half)
   is
      Shdr : Elf_Shdr_Acc;
      Base : Address;
      Off : Storage_Offset;

      Set_Len : Unsigned_32;
      Ver : Unsigned_16;
      Info_Off : Unsigned_32;
      Last : Storage_Offset;
      Addr_Sz : Unsigned_8;
      Seg_Sz : Unsigned_8;
      Pad : Unsigned_32;

      Addr : Unsigned_32;
      Len : Unsigned_32;
   begin
      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);

      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Read_Word4 (Base, Off, Set_Len);
         Last := Off + Storage_Offset (Set_Len);
         Read_Word2 (Base, Off, Ver);
         Read_Word4 (Base, Off, Info_Off);
         Read_Byte (Base, Off, Addr_Sz);
         Read_Byte (Base, Off, Seg_Sz);
         Read_Word4 (Base, Off, Pad);
         Put ("length: " & Hex_Image (Set_Len));
         Put (", version: " & Hex_Image (Ver));
         Put (", offset: " & Hex_Image (Info_Off));
         Put (", ptr_sz: " & Hex_Image (Addr_Sz));
         Put (", seg_sz: " & Hex_Image (Seg_Sz));
         New_Line;

         loop
            Read_Word4 (Base, Off, Addr);
            Read_Word4 (Base, Off, Len);
            Put ("  ");
            Put (Hex_Image (Addr));
            Put ('+');
            Put (Hex_Image (Len));
            New_Line;
            exit when Addr = 0 and Len = 0;
         end loop;
      end loop;
   end Disp_Debug_Aranges;

   procedure Disp_String (Base : Address; Off : in out Storage_Offset)
   is
      B : Unsigned_8;
   begin
      loop
         B := Read_Byte (Base + Off);
         Off := Off + 1;
         exit when B = 0;
         Put (Character'Val (B));
      end loop;
   end Disp_String;

   procedure Read_String (Base : Address; Off : in out Storage_Offset)
   is
      B : Unsigned_8;
   begin
      loop
         Read_Byte (Base, Off, B);
         exit when B = 0;
      end loop;
   end Read_String;

   function Get_Dwarf_LNS_Name (Lns : Unsigned_8) return String
   is
      use Dwarf;
   begin
      case Lns is
         when DW_LNS_Copy =>
            return "copy";
         when DW_LNS_Advance_Pc =>
            return "advance_pc";
         when DW_LNS_Advance_Line =>
            return "advance_line";
         when DW_LNS_Set_File =>
            return "set_file";
         when DW_LNS_Set_Column =>
            return "set_column";
         when DW_LNS_Negate_Stmt =>
            return "negate_stmt";
         when DW_LNS_Set_Basic_Block =>
            return "set_basic_block";
         when DW_LNS_Const_Add_Pc =>
            return "const_add_pc";
         when DW_LNS_Fixed_Advance_Pc =>
            return "fixed_advance_pc";
         when DW_LNS_Set_Prologue_End =>
            return "set_prologue_end";
         when DW_LNS_Set_Epilogue_Begin =>
            return "set_epilogue_begin";
         when DW_LNS_Set_Isa =>
            return "set_isa";
         when others =>
            return "?unknown?";
      end case;
   end Get_Dwarf_LNS_Name;

   procedure Disp_Debug_Line (File : Elf_File; Index : Elf_Half)
   is
      use Dwarf;
      Shdr : Elf_Shdr_Acc;
      Base : Address;
      Off : Storage_Offset;

      type Opc_Length_Type is array (Unsigned_8 range <>) of Unsigned_8;
      type Opc_Length_Acc is access Opc_Length_Type;
      Opc_Length : Opc_Length_Acc;

      Total_Len : Unsigned_32;
      Version : Unsigned_16;
      Prolog_Len : Unsigned_32;
      Min_Insn_Len : Unsigned_8;
      Dflt_Is_Stmt : Unsigned_8;
      Line_Base : Unsigned_8;
      Line_Range : Unsigned_8;
      Opc_Base : Unsigned_8;

      B : Unsigned_8;
      Arg : Unsigned_32;

      Old_Off : Storage_Offset;
      File_Dir : Unsigned_32;
      File_Time : Unsigned_32;
      File_Len : Unsigned_32;

      Ext_Len : Unsigned_32;
      Ext_Opc : Unsigned_8;

      Last : Storage_Offset;

      Pc : Unsigned_32;
      Line : Unsigned_32;
      Line_Base2 : Unsigned_32;
   begin
      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);

      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Read_Word4 (Base, Off, Total_Len);
         Last := Off + Storage_Offset (Total_Len);
         Read_Word2 (Base, Off, Version);
         Read_Word4 (Base, Off, Prolog_Len);
         Read_Byte (Base, Off, Min_Insn_Len);
         Read_Byte (Base, Off, Dflt_Is_Stmt);
         Read_Byte (Base, Off, Line_Base);
         Read_Byte (Base, Off, Line_Range);
         Read_Byte (Base, Off, Opc_Base);

         Pc := 0;
         Line := 1;

         Put ("length: " & Hex_Image (Total_Len));
         Put (", version: " & Hex_Image (Version));
         Put (", prolog_len: " & Hex_Image (Prolog_Len));
         New_Line;
         Put (" minimum_instruction_len: " & Hex_Image (Min_Insn_Len));
         Put (", default_is_stmt: " & Hex_Image (Dflt_Is_Stmt));
         New_Line;
         Put (" line_base: " & Hex_Image (Line_Base));
         Put (", line_range: " & Hex_Image (Line_Range));
         Put (", opc_base: " & Hex_Image (Opc_Base));
         New_Line;
         Line_Base2 := Unsigned_32 (Line_Base);
         if (Line_Base and 16#80#) /= 0 then
            Line_Base2 := Line_Base2 or 16#Ff_Ff_Ff_00#;
         end if;
         Put_Line ("standard_opcode_length:");
         Opc_Length := new Opc_Length_Type (1 .. Opc_Base - 1);
         for I in 1 .. Opc_Base - 1 loop
            Read_Byte (Base, Off, B);
            Put (' ');
            Put (Hex_Image (I));
            Put (" => ");
            Put (Hex_Image (B));
            Opc_Length (I) := B;
            New_Line;
         end loop;
         Put_Line ("include_directories:");
         loop
            B := Read_Byte (Base + Off);
            exit when B = 0;
            Put (' ');
            Disp_String (Base, Off);
            New_Line;
         end loop;
         Off := Off + 1;
         Put_Line ("file_names:");
         loop
            B := Read_Byte (Base + Off);
            exit when B = 0;
            Old_Off := Off;
            Read_String (Base, Off);
            Read_ULEB128 (Base, Off, File_Dir);
            Read_ULEB128 (Base, Off, File_Time);
            Read_ULEB128 (Base, Off, File_Len);
            Put (' ');
            Put (Hex_Image (File_Dir));
            Put (' ');
            Put (Hex_Image (File_Time));
            Put (' ');
            Put (Hex_Image (File_Len));
            Put (' ');
            Disp_String (Base, Old_Off);
            New_Line;
         end loop;
         Off := Off + 1;

         while Off < Last loop
            Put ("  ");
            Read_Byte (Base, Off, B);
            Put (Hex_Image (B));
            Old_Off := Off;
            if B < Opc_Base then
               case B is
                  when 0 =>
                     Put (" (extended)");
                     Read_ULEB128 (Base, Off, Ext_Len);
                     Put (", len: ");
                     Put (Hex_Image (Ext_Len));
                     Old_Off := Off;
                     Read_Byte (Base, Off, Ext_Opc);
                     Put (" opc:");
                     Put (Hex_Image (Ext_Opc));
                     Off := Old_Off + Storage_Offset (Ext_Len);
                  when others =>
                     Put (" (");
                     Put (Get_Dwarf_LNS_Name (B));
                     Put (")");
                     Set_Col (20);
                     for J in 1 .. Opc_Length (B) loop
                        Read_ULEB128 (Base, Off, Arg);
                        Put (" ");
                        Put (Hex_Image (Arg));
                     end loop;
               end case;
               case B is
                  when DW_LNS_Copy =>
                     Put (" pc=");
                     Put (Hex_Image (Pc));
                     Put (", line=");
                     Put (Unsigned_32'Image (Line));
                  when DW_LNS_Advance_Pc =>
                     Read_ULEB128 (Base, Old_Off, Arg);
                     Pc := Pc + Arg * Unsigned_32 (Min_Insn_Len);
                     Put ("  pc=");
                     Put (Hex_Image (Pc));
                  when DW_LNS_Advance_Line =>
                     Read_SLEB128 (Base, Old_Off, Arg);
                     Line := Line + Arg;
                     Put ("  line=");
                     Put (Unsigned_32'Image (Line));
                  when DW_LNS_Set_File =>
                     null;
                  when DW_LNS_Set_Column =>
                     null;
                  when DW_LNS_Negate_Stmt =>
                     null;
                  when DW_LNS_Set_Basic_Block =>
                     null;
                  when DW_LNS_Const_Add_Pc =>
                     Pc := Pc + Unsigned_32 ((255 - Opc_Base) / Line_Range)
                       * Unsigned_32 (Min_Insn_Len);
                     Put ("  pc=");
                     Put (Hex_Image (Pc));
                  when others =>
                     null;
               end case;
               New_Line;
            else
               B := B - Opc_Base;
               Pc := Pc + Unsigned_32 (B / Line_Range)
                 * Unsigned_32 (Min_Insn_Len);
               Line := Line + Line_Base2 + Unsigned_32 (B mod Line_Range);
               Put (" pc=");
               Put (Hex_Image (Pc));
               Put (", line=");
               Put (Unsigned_32'Image (Line));
               New_Line;
            end if;
         end loop;
      end loop;
   end Disp_Debug_Line;

   function Get_Dwarf_Cfi_Name (Cfi : Unsigned_8) return String
   is
      use Dwarf;
   begin
      case Cfi is
         when DW_CFA_Advance_Loc_Min .. DW_CFA_Advance_Loc_Max =>
            return "advance_loc";
         when DW_CFA_Offset_Min .. DW_CFA_Offset_Max =>
            return "offset";
         when DW_CFA_Restore_Min .. DW_CFA_Restore_Max =>
            return "restore";
         when DW_CFA_Nop =>
            return "nop";
         when DW_CFA_Set_Loc =>
            return "set_loc";
         when DW_CFA_Advance_Loc1 =>
            return "advance_loc1";
         when DW_CFA_Advance_Loc2 =>
            return "advance_loc2";
         when DW_CFA_Advance_Loc4 =>
            return "advance_loc4";
         when DW_CFA_Offset_Extended =>
            return "offset_extended";
         when DW_CFA_Restore_Extended =>
            return "restore_extended";
         when DW_CFA_Undefined =>
            return "undefined";
         when DW_CFA_Same_Value =>
            return "same_value";
         when DW_CFA_Register =>
            return "register";
         when DW_CFA_Remember_State =>
            return "remember_state";
         when DW_CFA_Restore_State =>
            return "restore_state";
         when DW_CFA_Def_Cfa =>
            return "def_cfa";
         when DW_CFA_Def_Cfa_Register =>
            return "def_cfa_register";
         when DW_CFA_Def_Cfa_Offset =>
            return "def_cfa_offset";
         when DW_CFA_Def_Cfa_Expression =>
            return "def_cfa_expression";
         when others =>
            return "?unknown?";
      end case;
   end Get_Dwarf_Cfi_Name;

   procedure Disp_Cfi (Base : Address; Length : Storage_Count)
   is
      use Dwarf;
      L : Storage_Offset;
      Op : Unsigned_8;
      Off : Unsigned_32;
      Reg : Unsigned_32;
   begin
      L := 0;
      while L < Length loop
         Op := Read_Byte (Base + L);
         Put (" ");
         Put (Hex_Image (Op));
         Put (" ");
         Put (Get_Dwarf_Cfi_Name (Op));
         Put (" ");
         L := L + 1;
         case Op is
            when DW_CFA_Nop =>
               null;
            when DW_CFA_Advance_Loc_Min .. DW_CFA_Advance_Loc_Max =>
               Put (Hex_Image (Op and 16#3f#));
            when DW_CFA_Offset_Min .. DW_CFA_Offset_Max =>
               Read_ULEB128 (Base, L, Off);
               Put ("reg:");
               Put (Hex_Image (Op and 16#3f#));
               Put (", offset:");
               Put (Hex_Image (Off));
            when DW_CFA_Def_Cfa =>
               Read_ULEB128 (Base, L, Reg);
               Read_ULEB128 (Base, L, Off);
               Put ("reg:");
               Put (Hex_Image (Reg));
               Put (", offset:");
               Put (Hex_Image (Off));
            when DW_CFA_Def_Cfa_Offset =>
               Read_ULEB128 (Base, L, Off);
               Put (Hex_Image (Off));
            when DW_CFA_Def_Cfa_Register =>
               Read_ULEB128 (Base, L, Reg);
               Put ("reg:");
               Put (Hex_Image (Reg));
            when others =>
               Put ("?unknown?");
               New_Line;
               exit;
         end case;
         New_Line;
      end loop;
   end Disp_Cfi;

   procedure Disp_Debug_Frame (File : Elf_File; Index : Elf_Half)
   is
      Shdr : Elf_Shdr_Acc;
      Base : Address;
      Off : Storage_Offset;
      Old_Off : Storage_Offset;

      Length : Unsigned_32;
      Cie_Id : Unsigned_32;
      Version : Unsigned_8;
      Augmentation : Unsigned_8;
      Code_Align : Unsigned_32;
      Data_Align : Unsigned_32;
      Ret_Addr_Reg : Unsigned_8;

      Init_Loc : Unsigned_32;
      Addr_Rng : Unsigned_32;
   begin
      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);

      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Read_Word4 (Base, Off, Length);
         Old_Off := Off;

         Read_Word4 (Base, Off, Cie_Id);
         if Cie_Id = 16#Ff_Ff_Ff_Ff# then
            Read_Byte (Base, Off, Version);
            Read_Byte (Base, Off, Augmentation);
            Put ("length: ");
            Put (Hex_Image (Length));
            Put (", CIE_id: ");
            Put (Hex_Image (Cie_Id));
            Put (", version: ");
            Put (Hex_Image (Version));
            if Augmentation /= 0 then
               Put (" +augmentation");
               New_Line;
            else
               New_Line;
               Read_ULEB128 (Base, Off, Code_Align);
               Read_SLEB128 (Base, Off, Data_Align);
               Read_Byte (Base, Off, Ret_Addr_Reg);
               Put ("code_align: ");
               Put (Hex_Image (Code_Align));
               Put (", data_align: ");
               Put (Hex_Image (Data_Align));
               Put (", ret_addr_reg: ");
               Put (Hex_Image (Ret_Addr_Reg));
               New_Line;
               Put ("initial instructions:");
               New_Line;
               Disp_Cfi (Base + Off, Old_Off + Storage_Offset (Length) - Off);
            end if;
         else
            Read_Word4 (Base, Off, Init_Loc);
            Read_Word4 (Base, Off, Addr_Rng);
            Put ("length: ");
            Put (Hex_Image (Length));
            Put (", CIE_pointer: ");
            Put (Hex_Image (Cie_Id));
            Put (", address_range: ");
            Put (Hex_Image (Init_Loc));
            Put ("-");
            Put (Hex_Image (Init_Loc + Addr_Rng));
            New_Line;
            Put ("instructions:");
            New_Line;
            Disp_Cfi (Base + Off, Old_Off + Storage_Offset (Length) - Off);
         end if;
         Off := Old_Off + Storage_Offset (Length);
      end loop;
   end Disp_Debug_Frame;

   procedure Read_Coded (Base : Address;
                         Offset : in out Storage_Offset;
                         Code : Unsigned_8;
                         Val : out Unsigned_32)
   is
      use Dwarf;

      V2 : Unsigned_16;
   begin
      if Code = DW_EH_PE_Omit then
         return;
      end if;
      case Code and DW_EH_PE_Format_Mask is
         when DW_EH_PE_Uleb128 =>
            Read_ULEB128 (Base, Offset, Val);
         when DW_EH_PE_Udata2 =>
            Read_Word2 (Base, Offset, V2);
            Val := Unsigned_32 (V2);
         when DW_EH_PE_Udata4 =>
            Read_Word4 (Base, Offset, Val);
         when DW_EH_PE_Sleb128 =>
            Read_SLEB128 (Base, Offset, Val);
         when DW_EH_PE_Sdata2 =>
            Read_Word2 (Base, Offset, V2);
            Val := Unsigned_32 (V2);
            if (V2 and 16#80_00#) /= 0 then
               Val := Val or 16#Ff_Ff_00_00#;
            end if;
         when DW_EH_PE_Sdata4 =>
            Read_Word4 (Base, Offset, Val);
         when others =>
            raise Program_Error;
      end case;
   end Read_Coded;

   procedure Disp_Eh_Frame_Hdr (File : Elf_File; Index : Elf_Half)
   is
      Shdr : Elf_Shdr_Acc;
      Base : Address;
      Off : Storage_Offset;

      Version : Unsigned_8;
      Eh_Frame_Ptr_Enc : Unsigned_8;
      Fde_Count_Enc : Unsigned_8;
      Table_Enc : Unsigned_8;

      Eh_Frame_Ptr : Unsigned_32;
      Fde_Count : Unsigned_32;

      Loc : Unsigned_32;
      Addr : Unsigned_32;
   begin
      Shdr := Get_Shdr (File, Index);
      Base := Get_Section_Base (File, Shdr.all);

      Off := 0;
      while Off < Storage_Offset (Shdr.Sh_Size) loop
         Read_Byte (Base, Off, Version);
         Read_Byte (Base, Off, Eh_Frame_Ptr_Enc);
         Read_Byte (Base, Off, Fde_Count_Enc);
         Read_Byte (Base, Off, Table_Enc);
         Put ("version: ");
         Put (Hex_Image (Version));
         Put (", encodings: ptr:");
         Put (Hex_Image (Eh_Frame_Ptr_Enc));
         Put (" count:");
         Put (Hex_Image (Fde_Count_Enc));
         Put (" table:");
         Put (Hex_Image (Table_Enc));
         New_Line;
         Read_Coded (Base, Off, Eh_Frame_Ptr_Enc, Eh_Frame_Ptr);
         Read_Coded (Base, Off, Fde_Count_Enc, Fde_Count);
         Put ("eh_frame_ptr: ");
         Put (Hex_Image (Eh_Frame_Ptr));
         Put (", fde_count: ");
         Put (Hex_Image (Fde_Count));
         New_Line;
         for I in 1 .. Fde_Count loop
            Read_Coded (Base, Off, Table_Enc, Loc);
            Read_Coded (Base, Off, Table_Enc, Addr);
            Put ("  init loc: ");
            Put (Hex_Image (Loc));
            Put (", addr : ");
            Put (Hex_Image (Addr));
            New_Line;
         end loop;
      end loop;
   end Disp_Eh_Frame_Hdr;
end Elfdumper;