diff options
| author | Tristan Gingold <tgingold@free.fr> | 2014-11-04 20:14:19 +0100 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2014-11-04 20:14:19 +0100 |
| commit | 9c195bf5d86d67ea5eb419ccf6e48dc153e57c68 (patch) | |
| tree | 575346e529b99e26382b4a06f6ff2caa0b391ab2 /src/ortho/mcode/elfdumper.adb | |
| parent | 184a123f91e07c927292d67462561dc84f3a920d (diff) | |
| download | ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.gz ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.bz2 ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.zip | |
Move sources to src/ subdirectory.
Diffstat (limited to 'src/ortho/mcode/elfdumper.adb')
| -rw-r--r-- | src/ortho/mcode/elfdumper.adb | 2818 |
1 files changed, 2818 insertions, 0 deletions
diff --git a/src/ortho/mcode/elfdumper.adb b/src/ortho/mcode/elfdumper.adb new file mode 100644 index 000000000..b3a3b70f2 --- /dev/null +++ b/src/ortho/mcode/elfdumper.adb @@ -0,0 +1,2818 @@ +-- ELF dumper (library). +-- Copyright (C) 2006 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with System.Storage_Elements; use System.Storage_Elements; +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Unchecked_Deallocation; +with GNAT.OS_Lib; +with Interfaces; use Interfaces; +with Hex_Images; use Hex_Images; +with Elf_Common; use Elf_Common; +with Dwarf; + +package body Elfdumper is + function Get_String (Strtab : Strtab_Type; N : Elf_Size) return String + is + E : Elf_Size; + begin + E := N; + while Strtab.Base (E) /= Nul loop + E := E + 1; + end loop; + if E = N then + return ""; + else + return String (Strtab.Base (N .. E - 1)); + end if; + end Get_String; + + procedure Disp_Ehdr (Ehdr : Elf_Ehdr) is + begin + Put ("File class: "); + case Ehdr.E_Ident (EI_CLASS) is + when ELFCLASSNONE => + Put ("none"); + when ELFCLASS32 => + Put ("class_32"); + when ELFCLASS64 => + Put ("class_64"); + when others => + Put ("others"); + end case; + New_Line; + + Put ("encoding : "); + case Ehdr.E_Ident (EI_DATA) is + when ELFDATANONE => + Put ("none"); + when ELFDATA2LSB => + Put ("LSB byte order"); + when ELFDATA2MSB => + Put ("MSB byte order"); + when others => + Put ("unknown"); + end case; + New_Line; + + Put ("version : "); + case Ehdr.E_Ident (EI_VERSION) is + when EV_NONE => + Put ("none"); + when EV_CURRENT => + Put ("current (1)"); + when others => + Put ("future"); + end case; + New_Line; + + if Ehdr.E_Ident (EI_CLASS) /= Elf_Arch_Class +-- or Ehdr.E_Ident (EI_DATA) /= ELFDATA2LSB + or Ehdr.E_Ident (EI_VERSION) /= EV_CURRENT + then + Put_Line ("bad class/data encoding/version"); + return; + end if; + + Put ("File type : "); + case Ehdr.E_Type is + when ET_NONE => + Put ("no file type"); + when ET_REL => + Put ("relocatable file"); + when ET_EXEC => + Put ("executable file"); + when ET_CORE => + Put ("core file"); + when ET_LOPROC .. ET_HIPROC => + Put ("processor-specific"); + when others => + Put ("unknown"); + end case; + New_Line; + + Put ("machine : "); + case Ehdr.E_Machine is + when EM_NONE => + Put ("no machine"); + when EM_M32 => + Put ("AT&T WE 32100"); + when EM_SPARC => + Put ("SPARC"); + when EM_386 => + Put ("Intel architecture"); + when EM_68K => + Put ("Motorola 68000"); + when EM_88K => + Put ("Motorola 88000"); + when EM_860 => + Put ("Intel 80860"); + when EM_MIPS => + Put ("MIPS RS3000 Big-Endian"); + when EM_MIPS_RS4_BE => + Put ("MIPS RS4000 Big-Endian"); + when others => + Put ("unknown"); + end case; + New_Line; + + Put_Line ("Version : " & Hex_Image (Ehdr.E_Version)); + Put_Line ("Phoff : " & Hex_Image (Ehdr.E_Phoff)); + Put_Line ("Shoff : " & Hex_Image (Ehdr.E_Shoff)); + Put_Line ("flags : " & Hex_Image (Ehdr.E_Flags)); + Put_Line ("phentsize : " & Hex_Image (Ehdr.E_Ehsize)); + Put_Line ("phnum : " & Hex_Image (Ehdr.E_Phentsize)); + Put_Line ("shentsize : " & Hex_Image (Ehdr.E_Shentsize)); + Put_Line ("shnum : " & Hex_Image (Ehdr.E_Shnum)); + Put_Line ("shstrndx : " & Hex_Image (Ehdr.E_Shstrndx)); + end Disp_Ehdr; + + function Get_Shdr_Type_Name (Stype : Elf_Word) return String is + begin + case Stype is + when SHT_NULL => + return "NULL"; + when SHT_PROGBITS => + return "PROGBITS"; + when SHT_SYMTAB => + return "SYMTAB"; + when SHT_STRTAB => + return "STRTAB"; + when SHT_RELA => + return "RELA"; + when SHT_HASH => + return "HASH"; + when SHT_DYNAMIC => + return "DYNAMIC"; + when SHT_NOTE => + return "NOTE"; + when SHT_NOBITS => + return "NOBITS"; + when SHT_REL => + return "REL"; + when SHT_SHLIB => + return "SHLIB"; + when SHT_DYNSYM => + return "DYNSYM"; + when SHT_INIT_ARRAY => + return "INIT_ARRAY"; + when SHT_FINI_ARRAY => + return "FINI_ARRAY"; + when SHT_PREINIT_ARRAY => + return "PREINIT_ARRAY"; + when SHT_GROUP => + return "GROUP"; + when SHT_SYMTAB_SHNDX => + return "SYMTAB_SHNDX"; + when SHT_NUM => + return "NUM"; + when SHT_LOOS => + return "LOOS"; + when SHT_GNU_LIBLIST => + return "GNU_LIBLIST"; + when SHT_CHECKSUM => + return "CHECKSUM"; + when SHT_SUNW_Move => + return "SUNW_move"; + when SHT_SUNW_COMDAT => + return "SUNW_COMDAT"; + when SHT_SUNW_Syminfo => + return "SUNW_syminfo"; + when SHT_GNU_Verdef => + return "GNU_verdef"; + when SHT_GNU_Verneed => + return "GNU_verneed"; + when SHT_GNU_Versym => + return "GNU_versym"; + when SHT_LOPROC .. SHT_HIPROC => + return "Processor dependant"; + when SHT_LOUSER .. SHT_HIUSER => + return "User dependant"; + when others => + return "unknown"; + end case; + end Get_Shdr_Type_Name; + + procedure Disp_Shdr (Shdr : Elf_Shdr; Sh_Strtab : Strtab_Type) + is + begin + Put_Line ("name : " & Hex_Image (Shdr.Sh_Name) & " """ + & Get_String (Sh_Strtab, Elf_Size (Shdr.Sh_Name)) & """"); + Put ("type : " & Hex_Image (Shdr.Sh_Type) & " "); + Put (Get_Shdr_Type_Name (Shdr.Sh_Type)); + New_Line; + Put ("flags : " & Hex_Image (Shdr.Sh_Flags)); + if (Shdr.Sh_Flags and SHF_WRITE) /= 0 then + Put (" WRITE"); + end if; + if (Shdr.Sh_Flags and SHF_ALLOC) /= 0 then + Put (" ALLOC"); + end if; + if (Shdr.Sh_Flags and SHF_EXECINSTR) /= 0 then + Put (" EXEC"); + end if; + New_Line; + Put ("addr : " & Hex_Image (Shdr.Sh_Addr)); + Put (" offset : " & Hex_Image (Shdr.Sh_Offset)); + Put (" size : " & Hex_Image (Shdr.Sh_Size)); + New_Line; + Put ("link : " & Hex_Image (Shdr.Sh_Link)); + Put (" info : " & Hex_Image (Shdr.Sh_Info)); + Put (" addralign : " & Hex_Image (Shdr.Sh_Addralign)); + Put (" entsize : " & Hex_Image (Shdr.Sh_Entsize)); + New_Line; + end Disp_Shdr; + + procedure Disp_Sym (File : Elf_File; + Sym : Elf_Sym; + Strtab : Strtab_Type) + is + begin + Put (Hex_Image (Sym.St_Value)); + Put (" " & Hex_Image (Sym.St_Size)); + Put (' '); + --Put (" info:" & Hex_Image (Sym.St_Info) & " "); + case Elf_St_Bind (Sym.St_Info) is + when STB_LOCAL => + Put ("loc "); + when STB_GLOBAL => + Put ("glob"); + when STB_WEAK => + Put ("weak"); + when others => + Put ("? "); + end case; + Put (' '); + case Elf_St_Type (Sym.St_Info) is + when STT_NOTYPE => + Put ("none"); + when STT_OBJECT => + Put ("obj "); + when STT_FUNC => + Put ("func"); + when STT_SECTION => + Put ("sect"); + when STT_FILE => + Put ("file"); + when others => + Put ("? "); + end case; + --Put (" other:" & Hex_Image (Sym.St_Other)); + Put (' '); + case Sym.St_Shndx is + when SHN_UNDEF => + Put ("UNDEF "); + when 1 .. SHN_LORESERVE - 1 => + declare + S : String := Get_Section_Name (File, Sym.St_Shndx); + Max : constant Natural := 8; + begin + if S'Length <= Max then + Put (S); + for I in S'Length + 1 .. Max loop + Put (' '); + end loop; + else + Put (S (S'First .. S'First + Max - 1)); + end if; + end; + when SHN_LOPROC .. SHN_HIPROC => + Put ("*proc* "); + when SHN_ABS => + Put ("*ABS* "); + when SHN_COMMON => + Put ("*COMMON*"); + when others => + Put ("?? "); + end case; + --Put (" sect:" & Hex_Image (Sym.St_Shndx)); + Put (' '); + Put_Line (Get_String (Strtab, Elf_Size (Sym.St_Name))); + end Disp_Sym; + + function Get_Offset (File : Elf_File; Off : Elf_Off; Size : Elf_Size) + return Address + is + begin + if Off > File.Length or Off + Size > File.Length then + return Null_Address; + end if; + return File.Base + Storage_Offset (Off); + end Get_Offset; + + function Get_Section_Base (File : Elf_File; Shdr : Elf_Shdr) + return Address + is + begin + return Get_Offset (File, Shdr.Sh_Offset, Shdr.Sh_Size); + end Get_Section_Base; + + function Get_Section_Base (File : Elf_File; Index : Elf_Half) + return Address + is + Shdr : Elf_Shdr_Acc; + begin + Shdr := Get_Shdr (File, Index); + return Get_Section_Base (File, Shdr.all); + end Get_Section_Base; + + function Get_Segment_Base (File : Elf_File; Phdr : Elf_Phdr) + return Address + is + begin + return Get_Offset (File, Phdr.P_Offset, Phdr.P_Filesz); + end Get_Segment_Base; + + function Get_Segment_Base (File : Elf_File; Index : Elf_Half) + return Address + is + Phdr : Elf_Phdr_Acc; + begin + Phdr := Get_Phdr (File, Index); + return Get_Segment_Base (File, Phdr.all); + end Get_Segment_Base; + + procedure Open_File (File : out Elf_File; Filename : String) + is + function Malloc (Size : Integer) return Address; + pragma Import (C, Malloc); + + use GNAT.OS_Lib; + Length : Long_Integer; + Len : Integer; + Fd : File_Descriptor; + begin + File := (Filename => new String'(Filename), + Status => Status_Ok, + Length => 0, + Base => Null_Address, + Ehdr => null, + Shdr_Base => Null_Address, + Sh_Strtab => (null, 0), + Phdr_Base => Null_Address); + + -- Open the file. + Fd := Open_Read (Filename, Binary); + if Fd = Invalid_FD then + File.Status := Status_Open_Failure; + return; + end if; + + -- Get length. + Length := File_Length (Fd); + Len := Integer (Length); + if Len < Elf_Ehdr_Size then + File.Status := Status_Bad_File; + Close (Fd); + return; + end if; + + File.Length := Elf_Off (Len); + + -- Allocate memory for the file. + File.Base := Malloc (Len); + if File.Base = Null_Address then + File.Status := Status_Memory; + Close (Fd); + return; + end if; + + -- Read the whole file. + if Read (Fd, File.Base, Integer (Length)) /= Integer (Length) then + File.Status := Status_Read_Error; + Close (Fd); + return; + end if; + + Close (Fd); + + File.Ehdr := To_Elf_Ehdr_Acc (File.Base); + + if File.Ehdr.E_Ident (EI_MAG0) /= ELFMAG0 + or File.Ehdr.E_Ident (EI_MAG1) /= ELFMAG1 + or File.Ehdr.E_Ident (EI_MAG2) /= ELFMAG2 + or File.Ehdr.E_Ident (EI_MAG3) /= ELFMAG3 + then + File.Status := Status_Bad_Magic; + return; + end if; + + if File.Ehdr.E_Ident (EI_CLASS) /= Elf_Arch_Class +-- or Ehdr.E_Ident (EI_DATA) /= ELFDATA2LSB + or File.Ehdr.E_Ident (EI_VERSION) /= EV_CURRENT + then + File.Status := Status_Bad_Class; + return; + end if; + end Open_File; + + function Get_Status (File : Elf_File) return Elf_File_Status is + begin + return File.Status; + end Get_Status; + + function Get_Ehdr (File : Elf_File) return Elf_Ehdr_Acc is + begin + return File.Ehdr; + end Get_Ehdr; + + function Get_Shdr (File : Elf_File; Index : Elf_Half) + return Elf_Shdr_Acc + is + begin + if Index >= File.Ehdr.E_Shnum then + raise Constraint_Error; + end if; + return To_Elf_Shdr_Acc + (File.Shdr_Base + + Storage_Offset (Index * Elf_Half (Elf_Shdr_Size))); + end Get_Shdr; + + procedure Load_Phdr (File : in out Elf_File) + is + begin + if Get_Ehdr (File).E_Phentsize /= Elf_Half (Elf_Phdr_Size) then + return; + end if; + + File.Phdr_Base := + Get_Offset (File, Get_Ehdr (File).E_Phoff, + Elf_Size (Get_Ehdr (File).E_Phnum + * Elf_Half (Elf_Phdr_Size))); + end Load_Phdr; + + function Get_Phdr (File : Elf_File; Index : Elf_Half) + return Elf_Phdr_Acc + is + begin + if Index >= File.Ehdr.E_Phnum then + raise Constraint_Error; + end if; + return To_Elf_Phdr_Acc + (File.Phdr_Base + + Storage_Offset (Index * Elf_Half (Elf_Phdr_Size))); + end Get_Phdr; + + function Get_Strtab (File : Elf_File; Index : Elf_Half) + return Strtab_Type + is + Shdr : Elf_Shdr_Acc; + begin + Shdr := Get_Shdr (File, Index); + if Shdr = null or Shdr.Sh_Type /= SHT_STRTAB then + return Null_Strtab; + end if; + return (Base => To_Strtab_Fat_Acc (Get_Section_Base (File, Shdr.all)), + Length => Shdr.Sh_Size); + end Get_Strtab; + + procedure Load_Shdr (File : in out Elf_File) + is + begin + if Get_Ehdr (File).E_Shentsize /= Elf_Half (Elf_Shdr_Size) then + return; + end if; + + File.Shdr_Base := + Get_Offset (File, Get_Ehdr (File).E_Shoff, + Elf_Size (Get_Ehdr (File).E_Shnum + * Elf_Half (Elf_Shdr_Size))); + File.Sh_Strtab := Get_Strtab (File, Get_Ehdr (File).E_Shstrndx); + end Load_Shdr; + + function Get_Sh_Strtab (File : Elf_File) return Strtab_Type is + begin + return File.Sh_Strtab; + end Get_Sh_Strtab; + + function Get_Section_Name (File : Elf_File; Index : Elf_Half) + return String + is + begin + return Get_String (Get_Sh_Strtab (File), + Elf_Size (Get_Shdr (File, Index).Sh_Name)); + end Get_Section_Name; + + function Get_Section_By_Name (File : Elf_File; Name : String) + return Elf_Half + is + Ehdr : Elf_Ehdr_Acc; + Shdr : Elf_Shdr_Acc; + Sh_Strtab : Strtab_Type; + begin + Ehdr := Get_Ehdr (File); + Sh_Strtab := Get_Sh_Strtab (File); + for I in 1 .. Ehdr.E_Shnum - 1 loop + Shdr := Get_Shdr (File, I); + if Get_String (Sh_Strtab, Elf_Size (Shdr.Sh_Name)) = Name then + return I; + end if; + end loop; + return 0; + end Get_Section_By_Name; + + procedure Disp_Symtab (File : Elf_File; Index : Elf_Half) + is + Shdr : Elf_Shdr_Acc; + S_Strtab : Strtab_Type; + Base : Address; + Off : Storage_Offset; + begin + Shdr := Get_Shdr (File, Index); + if Shdr.Sh_Entsize /= Elf_Size (Elf_Sym_Size) then + return; + end if; + S_Strtab := Get_Strtab (File, Elf_Half (Shdr.Sh_Link)); + Base := Get_Section_Base (File, Shdr.all); + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Disp_Sym (File, To_Elf_Sym_Acc (Base + Off).all, S_Strtab); + Off := Off + Storage_Offset (Elf_Sym_Size); + end loop; + end Disp_Symtab; + + procedure Disp_Strtab (File : Elf_File; Index : Elf_Half) + is + Strtab : Strtab_Type; + S, E : Elf_Size; + begin + Strtab := Get_Strtab (File, Index); + S := 1; + while S < Strtab.Length loop + E := S; + while Strtab.Base (E) /= Nul loop + E := E + 1; + end loop; + Put_Line (Hex_Image (S) & ": " + & String (Strtab.Base (S .. E - 1))); + S := E + 1; + end loop; + end Disp_Strtab; + + function Read_Byte (Addr : Address) return Unsigned_8 + is + type Unsigned_8_Acc is access all Unsigned_8; + function To_Unsigned_8_Acc is new Ada.Unchecked_Conversion + (Address, Unsigned_8_Acc); + begin + return To_Unsigned_8_Acc (Addr).all; + end Read_Byte; + + procedure Read_ULEB128 (Base : Address; + Off : in out Storage_Offset; + Res : out Unsigned_32) + is + B : Unsigned_8; + Shift : Integer; + begin + Res := 0; + Shift := 0; + loop + B := Read_Byte (Base + Off); + Off := Off + 1; + Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift); + exit when (B and 16#80#) = 0; + Shift := Shift + 7; + end loop; + end Read_ULEB128; + + procedure Read_SLEB128 (Base : Address; + Off : in out Storage_Offset; + Res : out Unsigned_32) + is + B : Unsigned_8; + Shift : Integer; + begin + Res := 0; + Shift := 0; + loop + B := Read_Byte (Base + Off); + Off := Off + 1; + Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift); + Shift := Shift + 7; + exit when (B and 16#80#) = 0; + end loop; + if Shift < 32 and (Res and Shift_Left (1, Shift - 1)) /= 0 then + Res := Res or Shift_Left (-1, Shift); + end if; + end Read_SLEB128; + + procedure Read_Word4 (Base : Address; + Off : in out Storage_Offset; + Res : out Unsigned_32) + is + B0, B1, B2, B3 : Unsigned_8; + begin + B0 := Read_Byte (Base + Off + 0); + B1 := Read_Byte (Base + Off + 1); + B2 := Read_Byte (Base + Off + 2); + B3 := Read_Byte (Base + Off + 3); + Res := Shift_Left (Unsigned_32 (B3), 24) + or Shift_Left (Unsigned_32 (B2), 16) + or Shift_Left (Unsigned_32 (B1), 8) + or Shift_Left (Unsigned_32 (B0), 0); + Off := Off + 4; + end Read_Word4; + + procedure Read_Word2 (Base : Address; + Off : in out Storage_Offset; + Res : out Unsigned_16) + is + B0, B1 : Unsigned_8; + begin + B0 := Read_Byte (Base + Off + 0); + B1 := Read_Byte (Base + Off + 1); + Res := Shift_Left (Unsigned_16 (B1), 8) + or Shift_Left (Unsigned_16 (B0), 0); + Off := Off + 2; + end Read_Word2; + + procedure Read_Byte (Base : Address; + Off : in out Storage_Offset; + Res : out Unsigned_8) + is + begin + Res := Read_Byte (Base + Off); + Off := Off + 1; + end Read_Byte; + + procedure Disp_Note (Base : Address; Size : Storage_Offset) + is + Off : Storage_Offset; + Namesz : Unsigned_32; + Descsz : Unsigned_32; + Ntype : Unsigned_32; + B : Unsigned_8; + Is_Full : Boolean; + begin + Off := 0; + while Off < Size loop + Read_Word4 (Base, Off, Namesz); + Read_Word4 (Base, Off, Descsz); + Read_Word4 (Base, Off, Ntype); + Put ("type : "); + Put (Hex_Image (Ntype)); + New_Line; + Put ("name : "); + Put (Hex_Image (Namesz)); + Put (" "); + for I in 1 .. Namesz loop + Read_Byte (Base, Off, B); + if B /= 0 then + Put (Character'Val (B)); + end if; + end loop; + if Namesz mod 4 /= 0 then + for I in (Namesz mod 4) .. 3 loop + Read_Byte (Base, Off, B); + end loop; + end if; + New_Line; + Put ("desc : "); + Put (Hex_Image (Descsz)); + Put (" "); + Is_Full := Descsz >= 20; + for I in 1 .. Descsz loop + if Is_Full and (I mod 16) = 1 then + New_Line; + end if; + Read_Byte (Base, Off, B); + Put (' '); + Put (Hex_Image (B)); + end loop; + if Descsz mod 4 /= 0 then + for I in (Descsz mod 4) .. 3 loop + Read_Byte (Base, Off, B); + end loop; + end if; + New_Line; + end loop; + end Disp_Note; + + procedure Disp_Section_Note (File : Elf_File; Index : Elf_Half) + is + Shdr : Elf_Shdr_Acc; + Base : Address; + begin + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + Disp_Note (Base, Storage_Offset (Shdr.Sh_Size)); + end Disp_Section_Note; + + procedure Disp_Segment_Note (File : Elf_File; Index : Elf_Half) + is + Phdr : Elf_Phdr_Acc; + Base : Address; + begin + Phdr := Get_Phdr (File, Index); + Base := Get_Segment_Base (File, Phdr.all); + Disp_Note (Base, Storage_Offset (Phdr.P_Filesz)); + end Disp_Segment_Note; + + + function Get_Dt_Name (Name : Elf_Word) return String is + begin + case Name is + when DT_NULL => + return "NULL"; + when DT_NEEDED => + return "NEEDED"; + when DT_PLTRELSZ => + return "PLTRELSZ"; + when DT_PLTGOT => + return "PLTGOT"; + when DT_HASH => + return "HASH"; + when DT_STRTAB => + return "STRTAB"; + when DT_SYMTAB => + return "SYMTAB"; + when DT_RELA => + return "RELA"; + when DT_RELASZ => + return "RELASZ"; + when DT_RELAENT => + return "RELAENT"; + when DT_STRSZ => + return "STRSZ"; + when DT_SYMENT => + return "SYMENT"; + when DT_INIT => + return "INIT"; + when DT_FINI => + return "FINI"; + when DT_SONAME => + return "SONAME"; + when DT_RPATH => + return "RPATH"; + when DT_SYMBOLIC => + return "SYMBOLIC"; + when DT_REL => + return "REL"; + when DT_RELSZ => + return "RELSZ"; + when DT_RELENT => + return "RELENT"; + when DT_PLTREL => + return "PLTREL"; + when DT_DEBUG => + return "DEBUG"; + when DT_TEXTREL => + return "TEXTREL"; + when DT_JMPREL => + return "JMPREL"; + when DT_BIND_NOW => + return "BIND_NOW"; + when DT_INIT_ARRAY => + return "INIT_ARRAY"; + when DT_FINI_ARRAY => + return "FINI_ARRAY"; + when DT_INIT_ARRAYSZ => + return "INIT_ARRAYSZ"; + when DT_FINI_ARRAYSZ => + return "FINI_ARRAYSZ"; + when DT_RUNPATH => + return "RUNPATH"; + when DT_FLAGS => + return "FLAGS"; +-- when DT_ENCODING => +-- return "ENCODING"; + when DT_PREINIT_ARRAY => + return "PREINIT_ARRAY"; + when DT_PREINIT_ARRAYSZ => + return "PREINIT_ARRAYSZ"; + when DT_NUM => + return "NUM"; + when DT_LOOS => + return "LOOS"; +-- when DT_HIOS => +-- return "HIOS"; + when DT_LOPROC => + return "LOPROC"; +-- when DT_HIPROC => +-- return "HIPROC"; + when DT_VALRNGLO => + return "VALRNGLO"; + when DT_GNU_PRELINKED => + return "GNU_PRELINKED"; + when DT_GNU_CONFLICTSZ => + return "GNU_CONFLICTSZ"; + when DT_GNU_LIBLISTSZ => + return "GNU_LIBLISTSZ"; + when DT_CHECKSUM => + return "CHECKSUM"; + when DT_PLTPADSZ => + return "PLTPADSZ"; + when DT_MOVEENT => + return "MOVEENT"; + when DT_MOVESZ => + return "MOVESZ"; + when DT_FEATURE_1 => + return "FEATURE_1"; + when DT_POSFLAG_1 => + return "POSFLAG_1"; + when DT_SYMINSZ => + return "SYMINSZ"; + when DT_SYMINENT => + return "SYMINENT"; +-- when DT_VALRNGHI => +-- return "VALRNGHI"; + when DT_ADDRRNGLO => + return "ADDRRNGLO"; + when DT_GNU_CONFLICT => + return "GNU_CONFLICT"; + when DT_GNU_LIBLIST => + return "GNU_LIBLIST"; + when DT_CONFIG => + return "CONFIG"; + when DT_DEPAUDIT => + return "DEPAUDIT"; + when DT_AUDIT => + return "AUDIT"; + when DT_PLTPAD => + return "PLTPAD"; + when DT_MOVETAB => + return "MOVETAB"; + when DT_SYMINFO => + return "SYMINFO"; +-- when DT_ADDRRNGHI => +-- return "ADDRRNGHI"; + when DT_VERSYM => + return "VERSYM"; + when DT_RELACOUNT => + return "RELACOUNT"; + when DT_RELCOUNT => + return "RELCOUNT"; + when DT_FLAGS_1 => + return "FLAGS_1"; + when DT_VERDEF => + return "VERDEF"; + when DT_VERDEFNUM => + return "VERDEFNUM"; + when DT_VERNEED => + return "VERNEED"; + when DT_VERNEEDNUM => + return "VERNEEDNUM"; + when DT_AUXILIARY => + return "AUXILIARY"; + when DT_FILTER => + return "FILTER"; + when others => + return "?unknown?"; + end case; + end Get_Dt_Name; + + procedure Disp_Dynamic (File : Elf_File; Index : Elf_Half) + is + Shdr : Elf_Shdr_Acc; + Base : Address; + Off : Storage_Offset; + Tag : Unsigned_32; + Val : Unsigned_32; + begin + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Read_Word4 (Base, Off, Tag); + Read_Word4 (Base, Off, Val); + Put ("tag : "); + Put (Hex_Image (Tag)); + Put (" ("); + Put (Get_Dt_Name (Tag)); + Put (")"); + Set_Col (34); + Put ("val : "); + Put (Hex_Image (Val)); + New_Line; + end loop; + end Disp_Dynamic; + + function Get_Dwarf_Form_Name (Name : Unsigned_32) return String + is + use Dwarf; + begin + case Name is + when DW_FORM_Addr => + return "addr"; + when DW_FORM_Block2 => + return "block2"; + when DW_FORM_Block4 => + return "block4"; + when DW_FORM_Data2 => + return "data2"; + when DW_FORM_Data4 => + return "data4"; + when DW_FORM_Data8 => + return "data8"; + when DW_FORM_String => + return "string"; + when DW_FORM_Block => + return "block"; + when DW_FORM_Block1 => + return "block1"; + when DW_FORM_Data1 => + return "data1"; + when DW_FORM_Flag => + return "flag"; + when DW_FORM_Sdata => + return "sdata"; + when DW_FORM_Strp => + return "strp"; + when DW_FORM_Udata => + return "udata"; + when DW_FORM_Ref_Addr => + return "ref_addr"; + when DW_FORM_Ref1 => + return "ref1"; + when DW_FORM_Ref2 => + return "ref2"; + when DW_FORM_Ref4 => + return "ref4"; + when DW_FORM_Ref8 => + return "ref8"; + when DW_FORM_Ref_Udata => + return "ref_udata"; + when DW_FORM_Indirect => + return "indirect"; + when others => + return "unknown"; + end case; + end Get_Dwarf_Form_Name; + + function Get_Dwarf_Tag_Name (Tag : Unsigned_32) return String + is + use Dwarf; + begin + case Tag is + when DW_TAG_Array_Type => + return "array_type"; + when DW_TAG_Class_Type => + return "class_type"; + when DW_TAG_Entry_Point => + return "entry_point"; + when DW_TAG_Enumeration_Type => + return "enumeration_type"; + when DW_TAG_Formal_Parameter => + return "formal_parameter"; + when DW_TAG_Imported_Declaration => + return "imported_declaration"; + when DW_TAG_Label => + return "label"; + when DW_TAG_Lexical_Block => + return "lexical_block"; + when DW_TAG_Member => + return "member"; + when DW_TAG_Pointer_Type => + return "pointer_type"; + when DW_TAG_Reference_Type => + return "reference_type"; + when DW_TAG_Compile_Unit => + return "compile_unit"; + when DW_TAG_String_Type => + return "string_type"; + when DW_TAG_Structure_Type => + return "structure_type"; + when DW_TAG_Subroutine_Type => + return "subroutine_type"; + when DW_TAG_Typedef => + return "typedef"; + when DW_TAG_Union_Type => + return "union_type"; + when DW_TAG_Unspecified_Parameters => + return "unspecified_parameters"; + when DW_TAG_Variant => + return "variant"; + when DW_TAG_Common_Block => + return "common_block"; + when DW_TAG_Common_Inclusion => + return "common_inclusion"; + when DW_TAG_Inheritance => + return "inheritance"; + when DW_TAG_Inlined_Subroutine => + return "inlined_subroutine"; + when DW_TAG_Module => + return "module"; + when DW_TAG_Ptr_To_Member_Type => + return "ptr_to_member_type"; + when DW_TAG_Set_Type => + return "set_type"; + when DW_TAG_Subrange_Type => + return "subrange_type"; + when DW_TAG_With_Stmt => + return "with_stmt"; + when DW_TAG_Access_Declaration => + return "access_declaration"; + when DW_TAG_Base_Type => + return "base_type"; + when DW_TAG_Catch_Block => + return "catch_block"; + when DW_TAG_Const_Type => + return "const_type"; + when DW_TAG_Constant => + return "constant"; + when DW_TAG_Enumerator => + return "enumerator"; + when DW_TAG_File_Type => + return "file_type"; + when DW_TAG_Friend => + return "friend"; + when DW_TAG_Namelist => + return "namelist"; + when DW_TAG_Namelist_Item => + return "namelist_item"; + when DW_TAG_Packed_Type => + return "packed_type"; + when DW_TAG_Subprogram => + return "subprogram"; + when DW_TAG_Template_Type_Parameter => + return "template_type_parameter"; + when DW_TAG_Template_Value_Parameter => + return "template_value_parameter"; + when DW_TAG_Thrown_Type => + return "thrown_type"; + when DW_TAG_Try_Block => + return "try_block"; + when DW_TAG_Variant_Part => + return "variant_part"; + when DW_TAG_Variable => + return "variable"; + when DW_TAG_Volatile_Type => + return "volatile_type"; + when DW_TAG_Dwarf_Procedure => + return "dwarf_procedure"; + when DW_TAG_Restrict_Type => + return "restrict_type"; + when DW_TAG_Interface_Type => + return "interface_type"; + when DW_TAG_Namespace => + return "namespace"; + when DW_TAG_Imported_Module => + return "imported_module"; + when DW_TAG_Unspecified_Type => + return "unspecified_type"; + when DW_TAG_Partial_Unit => + return "partial_unit"; + when DW_TAG_Imported_Unit => + return "imported_unit"; + when DW_TAG_Mutable_Type => + return "mutable_type"; + when others => + return "unknown"; + end case; + end Get_Dwarf_Tag_Name; + + function Get_Dwarf_At_Name (Attr : Unsigned_32) return String + is + use Dwarf; + begin + case Attr is + when DW_AT_Sibling => + return "sibling"; + when DW_AT_Location => + return "location"; + when DW_AT_Name => + return "name"; + when DW_AT_Ordering => + return "ordering"; + when DW_AT_Byte_Size => + return "byte_size"; + when DW_AT_Bit_Offset => + return "bit_offset"; + when DW_AT_Bit_Size => + return "bit_size"; + when DW_AT_Stmt_List => + return "stmt_list"; + when DW_AT_Low_Pc => + return "low_pc"; + when DW_AT_High_Pc => + return "high_pc"; + when DW_AT_Language => + return "language"; + when DW_AT_Discr => + return "discr"; + when DW_AT_Discr_Value => + return "discr_value"; + when DW_AT_Visibility => + return "visibility"; + when DW_AT_Import => + return "import"; + when DW_AT_String_Length => + return "string_length"; + when DW_AT_Common_Reference => + return "common_reference"; + when DW_AT_Comp_Dir => + return "comp_dir"; + when DW_AT_Const_Value => + return "const_value"; + when DW_AT_Containing_Type => + return "containing_type"; + when DW_AT_Default_Value => + return "default_value"; + when DW_AT_Inline => + return "inline"; + when DW_AT_Is_Optional => + return "is_optional"; + when DW_AT_Lower_Bound => + return "lower_bound"; + when DW_AT_Producer => + return "producer"; + when DW_AT_Prototyped => + return "prototyped"; + when DW_AT_Return_Addr => + return "return_addr"; + when DW_AT_Start_Scope => + return "start_scope"; + when DW_AT_Stride_Size => + return "stride_size"; + when DW_AT_Upper_Bound => + return "upper_bound"; + when DW_AT_Abstract_Origin => + return "abstract_origin"; + when DW_AT_Accessibility => + return "accessibility"; + when DW_AT_Address_Class => + return "address_class"; + when DW_AT_Artificial => + return "artificial"; + when DW_AT_Base_Types => + return "base_types"; + when DW_AT_Calling_Convention => + return "calling_convention"; + when DW_AT_Count => + return "count"; + when DW_AT_Data_Member_Location => + return "data_member_location"; + when DW_AT_Decl_Column => + return "decl_column"; + when DW_AT_Decl_File => + return "decl_file"; + when DW_AT_Decl_Line => + return "decl_line"; + when DW_AT_Declaration => + return "declaration"; + when DW_AT_Discr_List => + return "discr_list"; + when DW_AT_Encoding => + return "encoding"; + when DW_AT_External => + return "external"; + when DW_AT_Frame_Base => + return "frame_base"; + when DW_AT_Friend => + return "friend"; + when DW_AT_Identifier_Case => + return "identifier_case"; + when DW_AT_Macro_Info => + return "macro_info"; + when DW_AT_Namelist_Item => + return "namelist_item"; + when DW_AT_Priority => + return "priority"; + when DW_AT_Segment => + return "segment"; + when DW_AT_Specification => + return "specification"; + when DW_AT_Static_Link => + return "static_link"; + when DW_AT_Type => + return "type"; + when DW_AT_Use_Location => + return "use_location"; + when DW_AT_Variable_Parameter => + return "variable_parameter"; + when DW_AT_Virtuality => + return "virtuality"; + when DW_AT_Vtable_Elem_Location => + return "vtable_elem_location"; + when DW_AT_Allocated => + return "allocated"; + when DW_AT_Associated => + return "associated"; + when DW_AT_Data_Location => + return "data_location"; + when DW_AT_Stride => + return "stride"; + when DW_AT_Entry_Pc => + return "entry_pc"; + when DW_AT_Use_UTF8 => + return "use_utf8"; + when DW_AT_Extension => + return "extension"; + when DW_AT_Ranges => + return "ranges"; + when DW_AT_Trampoline => + return "trampoline"; + when DW_AT_Call_Column => + return "call_column"; + when DW_AT_Call_File => + return "call_file"; + when DW_AT_Call_Line => + return "call_line"; + when DW_AT_Description => + return "description"; + when others => + return "unknown"; + end case; + end Get_Dwarf_At_Name; + + procedure Disp_Debug_Abbrev (File : Elf_File; Index : Elf_Half) + is + Shdr : Elf_Shdr_Acc; + Base : Address; + Old_Off : Storage_Offset; + Off : Storage_Offset; + V : Unsigned_32; + Tag : Unsigned_32; + Name : Unsigned_32; + Form : Unsigned_32; + begin + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Old_Off := Off; + Read_ULEB128 (Base, Off, V); + Put_Line ("abbrev #" & Hex_Image (V) & " at " + & Hex_Image (Unsigned_32 (Old_Off)) & ':'); + if V = 0 then + Put_Line ("pad"); + goto Again; + end if; + Read_ULEB128 (Base, Off, Tag); + Put (" tag: " & Hex_Image (Tag)); + Put (" ("); + Put (Get_Dwarf_Tag_Name (Tag)); + Put ("), children: " & Hex_Image (Read_Byte (Base + Off))); + New_Line; + Off := Off + 1; + loop + Read_ULEB128 (Base, Off, Name); + Read_ULEB128 (Base, Off, Form); + Put (" name: " & Hex_Image (Name)); + Put (" ("); + Put (Get_Dwarf_At_Name (Name)); + Put (")"); + Set_Col (42); + Put ("form: " & Hex_Image (Form)); + Put (" ("); + Put (Get_Dwarf_Form_Name (Form)); + Put (")"); + New_Line; + exit when Name = 0 and Form = 0; + end loop; + << Again >> null; + end loop; + end Disp_Debug_Abbrev; + + type Abbrev_Map_Type is array (Unsigned_32 range <>) of Address; + type Abbrev_Map_Acc is access Abbrev_Map_Type; + procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation + (Abbrev_Map_Type, Abbrev_Map_Acc); + + procedure Build_Abbrev_Map (Base : Address; Res : out Abbrev_Map_Acc) + is + Max : Unsigned_32; + Off : Storage_Offset; + V : Unsigned_32; + V1 : Unsigned_32; + N_Res : Abbrev_Map_Acc; + begin + Off := 0; + Max := 0; + Res := new Abbrev_Map_Type (0 .. 128); + Res.all := (others => Null_Address); + loop + Read_ULEB128 (Base, Off, V); + if V > Max then + Max := V; + end if; + exit when V = 0; + if Max > Res.all'Last then + N_Res := new Abbrev_Map_Type (0 .. 2 * Max); + N_Res (Res'Range) := Res.all; + N_Res (Res'Last + 1 .. N_Res'Last) := (others => Null_Address); + Unchecked_Deallocation (Res); + Res := N_Res; + end if; + if Res (V) /= Null_Address then + Put_Line ("!! abbrev override !!"); + return; + end if; + Res (V) := Base + Off; + Read_ULEB128 (Base, Off, V); + -- Skip child flag. + Off := Off + 1; + loop + Read_ULEB128 (Base, Off, V); + Read_ULEB128 (Base, Off, V1); + exit when V = 0 and V1 = 0; + end loop; + end loop; + end Build_Abbrev_Map; + + procedure Disp_Block (Base : Address; + Off : in out Storage_Offset; + Cnt : Unsigned_32) + is + begin + for I in 1 .. Cnt loop + Put (" "); + Put (Hex_Image (Read_Byte (Base + Off + Storage_Offset (I - 1)))); + end loop; + Off := Off + Storage_Offset (Cnt); + end Disp_Block; + + procedure Disp_Dwarf_Form (Base : Address; + Off : in out Storage_Offset; + Form : Unsigned_32) + is + use Dwarf; + begin + case Form is + when DW_FORM_Addr => + declare + V : Unsigned_32; + begin + Read_Word4 (Base, Off, V); + Put ("address: " & Hex_Image (V)); + end; + when DW_FORM_Flag => + declare + V : Unsigned_8; + begin + Read_Byte (Base, Off, V); + Put ("flag: " & Hex_Image (V)); + end; + when DW_FORM_Block1 => + declare + V : Unsigned_8; + begin + Read_Byte (Base, Off, V); + Put ("block1: " & Hex_Image (V)); + Disp_Block (Base, Off, Unsigned_32 (V)); + end; + when DW_FORM_Data1 => + declare + V : Unsigned_8; + begin + Read_Byte (Base, Off, V); + Put ("data1: " & Hex_Image (V)); + end; + when DW_FORM_Data2 => + declare + V : Unsigned_16; + begin + Read_Word2 (Base, Off, V); + Put ("data2: " & Hex_Image (V)); + end; + when DW_FORM_Data4 => + declare + V : Unsigned_32; + begin + Read_Word4 (Base, Off, V); + Put ("data4: " & Hex_Image (V)); + end; + when DW_FORM_Sdata => + declare + V : Unsigned_32; + begin + Read_SLEB128 (Base, Off, V); + Put ("sdata: " & Hex_Image (V)); + end; + when DW_FORM_Udata => + declare + V : Unsigned_32; + begin + Read_ULEB128 (Base, Off, V); + Put ("udata: " & Hex_Image (V)); + end; + when DW_FORM_Ref4 => + declare + V : Unsigned_32; + begin + Read_Word4 (Base, Off, V); + Put ("ref4: " & Hex_Image (V)); + end; + when DW_FORM_Strp => + declare + V : Unsigned_32; + begin + Read_Word4 (Base, Off, V); + Put ("strp: " & Hex_Image (V)); + end; + when DW_FORM_String => + declare + C : Unsigned_8; + begin + Put ("string: "); + loop + Read_Byte (Base, Off, C); + exit when C = 0; + Put (Character'Val (C)); + end loop; + end; + when others => + Put ("???"); + raise Program_Error; + end case; + end Disp_Dwarf_Form; + + function Get_Dwarf_ATE_Name (Val : Unsigned_32) return String + is + use Dwarf; + begin + case Val is + when DW_ATE_Address => + return "address"; + when DW_ATE_Boolean => + return "boolean"; + when DW_ATE_Complex_Float => + return "complex_float"; + when DW_ATE_Float => + return "float"; + when DW_ATE_Signed => + return "signed"; + when DW_ATE_Signed_Char => + return "signed_char"; + when DW_ATE_Unsigned => + return "unsigned"; + when DW_ATE_Unsigned_Char => + return "unsigned_char"; + when DW_ATE_Imaginary_Float => + return "imaginary_float"; + when others => + return "unknown"; + end case; + end Get_Dwarf_ATE_Name; + + procedure Read_Dwarf_Constant (Base : Address; + Off : in out Storage_Offset; + Form : Unsigned_32; + Res : out Unsigned_32) + is + use Dwarf; + begin + case Form is + when DW_FORM_Data1 => + declare + V : Unsigned_8; + begin + Read_Byte (Base, Off, V); + Res := Unsigned_32 (V); + end; + when DW_FORM_Data2 => + declare + V : Unsigned_16; + begin + Read_Word2 (Base, Off, V); + Res := Unsigned_32 (V); + end; + when DW_FORM_Data4 => + declare + V : Unsigned_32; + begin + Read_Word4 (Base, Off, V); + Res := V; + end; + when DW_FORM_Sdata => + declare + V : Unsigned_32; + begin + Read_SLEB128 (Base, Off, V); + Res := V; + end; + when others => + raise Program_Error; + end case; + end Read_Dwarf_Constant; + + procedure Disp_Dwarf_Encoding + (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32) + is + Val : Unsigned_32; + begin + Read_Dwarf_Constant (Base, Off, Form, Val); + Put (Get_Dwarf_ATE_Name (Val)); + end Disp_Dwarf_Encoding; + + function Get_Dwarf_Lang_Name (Lang : Unsigned_32) return String + is + use Dwarf; + begin + case Lang is + when DW_LANG_C89 => + return "C89"; + when DW_LANG_C => + return "C"; + when DW_LANG_Ada83 => + return "Ada83"; + when DW_LANG_C_Plus_Plus => + return "C_Plus_Plus"; + when DW_LANG_Cobol74 => + return "Cobol74"; + when DW_LANG_Cobol85 => + return "Cobol85"; + when DW_LANG_Fortran77 => + return "Fortran77"; + when DW_LANG_Fortran90 => + return "Fortran90"; + when DW_LANG_Pascal83 => + return "Pascal83"; + when DW_LANG_Modula2 => + return "Modula2"; + when DW_LANG_Java => + return "Java"; + when DW_LANG_C99 => + return "C99"; + when DW_LANG_Ada95 => + return "Ada95"; + when DW_LANG_Fortran95 => + return "Fortran95"; + when DW_LANG_PLI => + return "PLI"; + when others => + return "?unknown?"; + end case; + end Get_Dwarf_Lang_Name; + + procedure Disp_Dwarf_Language + (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32) + is + Val : Unsigned_32; + begin + Read_Dwarf_Constant (Base, Off, Form, Val); + Put (Get_Dwarf_Lang_Name (Val)); + end Disp_Dwarf_Language; + + function Get_Dwarf_Op_Name (Op : Unsigned_8) return String + is + use Dwarf; + begin + case Op is + when DW_OP_Addr => + return "addr"; + when DW_OP_Deref => + return "deref"; + when DW_OP_Const1u => + return "const1u"; + when DW_OP_Const1s => + return "const1s"; + when DW_OP_Const2u => + return "const2u"; + when DW_OP_Const2s => + return "const2s"; + when DW_OP_Const4u => + return "const4u"; + when DW_OP_Const4s => + return "const4s"; + when DW_OP_Const8u => + return "const8u"; + when DW_OP_Const8s => + return "const8s"; + when DW_OP_Constu => + return "constu"; + when DW_OP_Consts => + return "consts"; + when DW_OP_Dup => + return "dup"; + when DW_OP_Drop => + return "drop"; + when DW_OP_Over => + return "over"; + when DW_OP_Pick => + return "pick"; + when DW_OP_Swap => + return "swap"; + when DW_OP_Rot => + return "rot"; + when DW_OP_Xderef => + return "xderef"; + when DW_OP_Abs => + return "abs"; + when DW_OP_And => + return "and"; + when DW_OP_Div => + return "div"; + when DW_OP_Minus => + return "minus"; + when DW_OP_Mod => + return "mod"; + when DW_OP_Mul => + return "mul"; + when DW_OP_Neg => + return "neg"; + when DW_OP_Not => + return "not"; + when DW_OP_Or => + return "or"; + when DW_OP_Plus => + return "plus"; + when DW_OP_Plus_Uconst => + return "plus_uconst"; + when DW_OP_Shl => + return "shl"; + when DW_OP_Shr => + return "shr"; + when DW_OP_Shra => + return "shra"; + when DW_OP_Xor => + return "xor"; + when DW_OP_Skip => + return "skip"; + when DW_OP_Bra => + return "bra"; + when DW_OP_Eq => + return "eq"; + when DW_OP_Ge => + return "ge"; + when DW_OP_Gt => + return "gt"; + when DW_OP_Le => + return "le"; + when DW_OP_Lt => + return "lt"; + when DW_OP_Ne => + return "ne"; + when DW_OP_Lit0 => + return "lit0"; + when DW_OP_Lit1 => + return "lit1"; + when DW_OP_Lit2 => + return "lit2"; + when DW_OP_Lit3 => + return "lit3"; + when DW_OP_Lit4 => + return "lit4"; + when DW_OP_Lit5 => + return "lit5"; + when DW_OP_Lit6 => + return "lit6"; + when DW_OP_Lit7 => + return "lit7"; + when DW_OP_Lit8 => + return "lit8"; + when DW_OP_Lit9 => + return "lit9"; + when DW_OP_Lit10 => + return "lit10"; + when DW_OP_Lit11 => + return "lit11"; + when DW_OP_Lit12 => + return "lit12"; + when DW_OP_Lit13 => + return "lit13"; + when DW_OP_Lit14 => + return "lit14"; + when DW_OP_Lit15 => + return "lit15"; + when DW_OP_Lit16 => + return "lit16"; + when DW_OP_Lit17 => + return "lit17"; + when DW_OP_Lit18 => + return "lit18"; + when DW_OP_Lit19 => + return "lit19"; + when DW_OP_Lit20 => + return "lit20"; + when DW_OP_Lit21 => + return "lit21"; + when DW_OP_Lit22 => + return "lit22"; + when DW_OP_Lit23 => + return "lit23"; + when DW_OP_Lit24 => + return "lit24"; + when DW_OP_Lit25 => + return "lit25"; + when DW_OP_Lit26 => + return "lit26"; + when DW_OP_Lit27 => + return "lit27"; + when DW_OP_Lit28 => + return "lit28"; + when DW_OP_Lit29 => + return "lit29"; + when DW_OP_Lit30 => + return "lit30"; + when DW_OP_Lit31 => + return "lit31"; + when DW_OP_Reg0 => + return "reg0"; + when DW_OP_Reg1 => + return "reg1"; + when DW_OP_Reg2 => + return "reg2"; + when DW_OP_Reg3 => + return "reg3"; + when DW_OP_Reg4 => + return "reg4"; + when DW_OP_Reg5 => + return "reg5"; + when DW_OP_Reg6 => + return "reg6"; + when DW_OP_Reg7 => + return "reg7"; + when DW_OP_Reg8 => + return "reg8"; + when DW_OP_Reg9 => + return "reg9"; + when DW_OP_Reg10 => + return "reg10"; + when DW_OP_Reg11 => + return "reg11"; + when DW_OP_Reg12 => + return "reg12"; + when DW_OP_Reg13 => + return "reg13"; + when DW_OP_Reg14 => + return "reg14"; + when DW_OP_Reg15 => + return "reg15"; + when DW_OP_Reg16 => + return "reg16"; + when DW_OP_Reg17 => + return "reg17"; + when DW_OP_Reg18 => + return "reg18"; + when DW_OP_Reg19 => + return "reg19"; + when DW_OP_Reg20 => + return "reg20"; + when DW_OP_Reg21 => + return "reg21"; + when DW_OP_Reg22 => + return "reg22"; + when DW_OP_Reg23 => + return "reg23"; + when DW_OP_Reg24 => + return "reg24"; + when DW_OP_Reg25 => + return "reg25"; + when DW_OP_Reg26 => + return "reg26"; + when DW_OP_Reg27 => + return "reg27"; + when DW_OP_Reg28 => + return "reg28"; + when DW_OP_Reg29 => + return "reg29"; + when DW_OP_Reg30 => + return "reg30"; + when DW_OP_Reg31 => + return "reg31"; + when DW_OP_Breg0 => + return "breg0"; + when DW_OP_Breg1 => + return "breg1"; + when DW_OP_Breg2 => + return "breg2"; + when DW_OP_Breg3 => + return "breg3"; + when DW_OP_Breg4 => + return "breg4"; + when DW_OP_Breg5 => + return "breg5"; + when DW_OP_Breg6 => + return "breg6"; + when DW_OP_Breg7 => + return "breg7"; + when DW_OP_Breg8 => + return "breg8"; + when DW_OP_Breg9 => + return "breg9"; + when DW_OP_Breg10 => + return "breg10"; + when DW_OP_Breg11 => + return "breg11"; + when DW_OP_Breg12 => + return "breg12"; + when DW_OP_Breg13 => + return "breg13"; + when DW_OP_Breg14 => + return "breg14"; + when DW_OP_Breg15 => + return "breg15"; + when DW_OP_Breg16 => + return "breg16"; + when DW_OP_Breg17 => + return "breg17"; + when DW_OP_Breg18 => + return "breg18"; + when DW_OP_Breg19 => + return "breg19"; + when DW_OP_Breg20 => + return "breg20"; + when DW_OP_Breg21 => + return "breg21"; + when DW_OP_Breg22 => + return "breg22"; + when DW_OP_Breg23 => + return "breg23"; + when DW_OP_Breg24 => + return "breg24"; + when DW_OP_Breg25 => + return "breg25"; + when DW_OP_Breg26 => + return "breg26"; + when DW_OP_Breg27 => + return "breg27"; + when DW_OP_Breg28 => + return "breg28"; + when DW_OP_Breg29 => + return "breg29"; + when DW_OP_Breg30 => + return "breg30"; + when DW_OP_Breg31 => + return "breg31"; + when DW_OP_Regx => + return "regx"; + when DW_OP_Fbreg => + return "fbreg"; + when DW_OP_Bregx => + return "bregx"; + when DW_OP_Piece => + return "piece"; + when DW_OP_Deref_Size => + return "deref_size"; + when DW_OP_Xderef_Size => + return "xderef_size"; + when DW_OP_Nop => + return "nop"; + when DW_OP_Push_Object_Address => + return "push_object_address"; + when DW_OP_Call2 => + return "call2"; + when DW_OP_Call4 => + return "call4"; + when DW_OP_Call_Ref => + return "call_ref"; + when others => + return "unknown"; + end case; + end Get_Dwarf_Op_Name; + + procedure Read_Dwarf_Block (Base : Address; + Off : in out Storage_Offset; + Form : Unsigned_32; + B : out Address; + L : out Unsigned_32) + is + use Dwarf; + begin + case Form is + when DW_FORM_Block1 => + B := Base + Off + 1; + L := Unsigned_32 (Read_Byte (Base + Off)); + Off := Off + 1; + when others => + raise Program_Error; + end case; + Off := Off + Storage_Offset (L); + end Read_Dwarf_Block; + + procedure Disp_Dwarf_Location + (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32) + is + use Dwarf; + B : Address; + L : Unsigned_32; + Op : Unsigned_8; + Boff : Storage_Offset; + Is_Full : Boolean; + begin + Read_Dwarf_Block (Base, Off, Form, B, L); + if L = 0 then + return; + end if; + Is_Full := L > 6; + Boff := 0; + while Boff < Storage_Offset (L) loop + if Is_Full then + New_Line; + Put (" "); + Put (Hex_Image (Unsigned_32 (Boff))); + Put (": "); + end if; + Op := Read_Byte (B + Boff); + Put (' '); + Put (Get_Dwarf_Op_Name (Op)); + Boff := Boff + 1; + case Op is + when DW_OP_Addr => + declare + V : Unsigned_32; + begin + Read_Word4 (B, Boff, V); + Put (':'); + Put (Hex_Image (V)); + end; + when DW_OP_Deref => + null; + when DW_OP_Const1u + | DW_OP_Const1s => + declare + V : Unsigned_8; + begin + Read_Byte (B, Boff, V); + Put (':'); + Put (Hex_Image (V)); + end; +-- DW_OP_Const2u : constant := 16#0a#; -- 1 2-byte constant +-- DW_OP_Const2s : constant := 16#0b#; -- 1 2-byte constant +-- DW_OP_Const4u : constant := 16#0c#; -- 1 4-byte constant +-- DW_OP_Const4s : constant := 16#0d#; -- 1 4-byte constant +-- DW_OP_Const8u : constant := 16#0e#; -- 1 8-byte constant +-- DW_OP_Const8s : constant := 16#0f#; -- 1 8-byte constant +-- DW_OP_Constu : constant := 16#10#; -- 1 ULEB128 constant +-- DW_OP_Consts : constant := 16#11#; -- 1 SLEB128 constant +-- DW_OP_Dup : constant := 16#12#; -- 0 +-- DW_OP_Drop : constant := 16#13#; -- 0 +-- DW_OP_Over : constant := 16#14#; -- 0 +-- DW_OP_Pick : constant := 16#15#; -- 1 1-byte stack index + + when DW_OP_Swap + | DW_OP_Rot + | DW_OP_Xderef + | DW_OP_Abs + | DW_OP_And + | DW_OP_Div + | DW_OP_Minus + | DW_OP_Mod + | DW_OP_Mul + | DW_OP_Neg + | DW_OP_Not + | DW_OP_Or + | DW_OP_Plus => + null; + when DW_OP_Plus_Uconst + | DW_OP_Piece + | DW_OP_Regx => + declare + V : Unsigned_32; + begin + Read_ULEB128 (B, Boff, V); + Put (':'); + Put (Hex_Image (V)); + end; + when DW_OP_Shl + | DW_OP_Shr + | DW_OP_Shra + | DW_OP_Xor => + null; + when DW_OP_Skip + | DW_OP_Bra => + declare + V : Unsigned_16; + begin + Read_Word2 (B, Boff, V); + Put (':'); + Put (Hex_Image (V)); + Put (" (@"); + -- FIXME: signed + Put (Hex_Image (Unsigned_32 (Boff) + Unsigned_32 (V))); + Put (")"); + end; + when DW_OP_Eq + | DW_OP_Ge + | DW_OP_Gt + | DW_OP_Le + | DW_OP_Lt + | DW_OP_Ne => + null; + when DW_OP_Lit0 .. DW_OP_Lit31 => + null; + when DW_OP_Reg0 .. DW_OP_Reg31 => + null; + when DW_OP_Breg0 .. DW_OP_Breg31 + | DW_OP_Fbreg => + declare + V : Unsigned_32; + begin + Read_SLEB128 (B, Boff, V); + Put (':'); + Put (Hex_Image (V)); + end; + +-- DW_OP_Regx : constant := 16#90#; -- 1 ULEB128 register +-- DW_OP_Bregx : constant := 16#92#; -- 2 ULEB128 reg + SLEB128 offset +-- DW_OP_Deref_Size : constant := 16#94#; -- 1 1-byte size of data retrieved +-- DW_OP_Xderef_Size : constant := 16#95#; -- 1 1-byte size of data retrieved + when DW_OP_Nop => + null; +-- DW_OP_Push_Object_Address : constant := 16#97#; -- 0 +-- DW_OP_Call2 : constant := 16#98#; -- 1 2-byte offset of DIE +-- DW_OP_Call4 : constant := 16#99#; -- 1 4-byte offset of DIE +-- DW_OP_Call_Ref : constant := 16#9a#; -- 1 4- or 8-byte offset of DIE + when others => + raise Program_Error; + end case; + end loop; + end Disp_Dwarf_Location; + + procedure Disp_Debug_Info (File : Elf_File; Index : Elf_Half) + is + use Dwarf; + + Abbrev_Index : Elf_Half; + Abbrev_Base : Address; + Map : Abbrev_Map_Acc; + Abbrev : Address; + + Shdr : Elf_Shdr_Acc; + Base : Address; + Off : Storage_Offset; + Aoff : Storage_Offset; + Old_Off : Storage_Offset; + + Len : Unsigned_32; + Ver : Unsigned_16; + Abbrev_Off : Unsigned_32; + Ptr_Sz : Unsigned_8; + Last : Storage_Offset; + Num : Unsigned_32; + + Tag : Unsigned_32; + Name : Unsigned_32; + Form : Unsigned_32; + + Level : Unsigned_8; + begin + Abbrev_Index := Get_Section_By_Name (File, ".debug_abbrev"); + Abbrev_Base := Get_Section_Base (File, Abbrev_Index); + Map := null; + + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Put_Line ("Compilation unit at #" + & Hex_Image (Unsigned_32 (Off)) & ":"); + Read_Word4 (Base, Off, Len); + Last := Off + Storage_Offset (Len); + Read_Word2 (Base, Off, Ver); + Read_Word4 (Base, Off, Abbrev_Off); + Read_Byte (Base, Off, Ptr_Sz); + Put (' '); + Put ("length: " & Hex_Image (Len)); + Put (", version: " & Hex_Image (Ver)); + Put (", abbrev offset: " & Hex_Image (Abbrev_Off)); + Put (", ptr_sz: " & Hex_Image (Ptr_Sz)); + New_Line; + Level := 0; + + Build_Abbrev_Map (Abbrev_Base + Storage_Offset (Abbrev_Off), Map); + loop + << Again >> null; + exit when Off >= Last; + Old_Off := Off; + Read_ULEB128 (Base, Off, Num); + Put ("<" & Hex_Image (Unsigned_32 (Old_Off)) & ">"); + Put ("<" & Hex_Image (Level) & ">"); + Put (" with abbrev #" & Hex_Image (Num)); + if Num = 0 then + Level := Level - 1; + New_Line; + goto Again; + end if; + if Num <= Map.all'Last then + Abbrev := Map (Num); + else + Abbrev := Null_Address; + end if; + if Abbrev = Null_Address then + New_Line; + Put ("!! abbrev #" & Hex_Image (Num) & " does not exist !!"); + New_Line; + return; + end if; + Aoff := 0; + Read_ULEB128 (Abbrev, Aoff, Tag); + if Read_Byte (Abbrev + Aoff) /= 0 then + Put (" [has_child]"); + Level := Level + 1; + end if; + New_Line; + + -- skip child. + Aoff := Aoff + 1; + Put (" tag: " & Hex_Image (Tag)); + Put (" ("); + Put (Get_Dwarf_Tag_Name (Tag)); + Put (")"); + New_Line; + + loop + Read_ULEB128 (Abbrev, Aoff, Name); + Read_ULEB128 (Abbrev, Aoff, Form); + exit when Name = 0 and Form = 0; + Put (" "); + Put (Get_Dwarf_At_Name (Name)); + Set_Col (24); + Put (": "); + Old_Off := Off; + Disp_Dwarf_Form (Base, Off, Form); + case Name is + when DW_AT_Encoding => + Put (": "); + Disp_Dwarf_Encoding (Base, Old_Off, Form); + when DW_AT_Location + | DW_AT_Frame_Base + | DW_AT_Data_Member_Location => + Put (":"); + Disp_Dwarf_Location (Base, Old_Off, Form); + when DW_AT_Language => + Put (": "); + Disp_Dwarf_Language (Base, Old_Off, Form); + when others => + null; + end case; + New_Line; + end loop; + end loop; + Unchecked_Deallocation (Map); + New_Line; + end loop; + end Disp_Debug_Info; + + function Get_Phdr_Type_Name (Ptype : Elf_Word) return String is + begin + case Ptype is + when PT_NULL => + return "NULL"; + when PT_LOAD => + return "LOAD"; + when PT_DYNAMIC => + return "DYNAMIC"; + when PT_INTERP => + return "INTERP"; + when PT_NOTE => + return "NOTE"; + when PT_SHLIB => + return "SHLIB"; + when PT_PHDR => + return "PHDR"; + when PT_TLS => + return "TLS"; + when PT_NUM => + return "NUM"; + when PT_GNU_EH_FRAME => + return "GNU_EH_FRAME"; + when PT_SUNWBSS => + return "SUNWBSS"; + when PT_SUNWSTACK => + return "SUNWSTACK"; + when others => + return "?unknown?"; + end case; + end Get_Phdr_Type_Name; + + procedure Disp_Phdr (Phdr : Elf_Phdr) + is + begin + Put ("type : " & Hex_Image (Phdr.P_Type)); + Put (" "); + Put (Get_Phdr_Type_Name (Phdr.P_Type)); + New_Line; + Put ("offset: " & Hex_Image (Phdr.P_Offset)); + Put (" vaddr: " & Hex_Image (Phdr.P_Vaddr)); + Put (" paddr: " & Hex_Image (Phdr.P_Paddr)); + New_Line; + Put ("filesz: " & Hex_Image (Phdr.P_Filesz)); + Put (" memsz: " & Hex_Image (Phdr.P_Memsz)); + Put (" align: " & Hex_Image (Phdr.P_Align)); + --New_Line; + Put (" flags: " & Hex_Image (Phdr.P_Flags)); + Put (" ("); + if (Phdr.P_Flags and PF_X) /= 0 then + Put ('X'); + end if; + if (Phdr.P_Flags and PF_W) /= 0 then + Put ('W'); + end if; + if (Phdr.P_Flags and PF_R) /= 0 then + Put ('R'); + end if; + Put (")"); + New_Line; + end Disp_Phdr; + + procedure Disp_Debug_Pubnames (File : Elf_File; Index : Elf_Half) + is + Shdr : Elf_Shdr_Acc; + Base : Address; + Off : Storage_Offset; + B : Unsigned_8; + + Len : Unsigned_32; + Ver : Unsigned_16; + Info_Off : Unsigned_32; + Info_Length : Unsigned_32; + Last : Storage_Offset; + Ioff : Unsigned_32; + begin + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Read_Word4 (Base, Off, Len); + Last := Off + Storage_Offset (Len); + Read_Word2 (Base, Off, Ver); + Read_Word4 (Base, Off, Info_Off); + Read_Word4 (Base, Off, Info_Length); + Put ("length: " & Hex_Image (Len)); + Put (", version: " & Hex_Image (Ver)); + Put (", offset: " & Hex_Image (Info_Off)); + Put (", length: " & Hex_Image (Info_Length)); + New_Line; + + loop + Read_Word4 (Base, Off, Ioff); + Put (" "); + Put (Hex_Image (Ioff)); + if Ioff /= 0 then + Put (": "); + loop + Read_Byte (Base, Off, B); + exit when B = 0; + Put (Character'Val (B)); + end loop; + end if; + New_Line; + exit when Ioff = 0; + end loop; + end loop; + end Disp_Debug_Pubnames; + + procedure Disp_Debug_Aranges (File : Elf_File; Index : Elf_Half) + is + Shdr : Elf_Shdr_Acc; + Base : Address; + Off : Storage_Offset; + + Set_Len : Unsigned_32; + Ver : Unsigned_16; + Info_Off : Unsigned_32; + Last : Storage_Offset; + Addr_Sz : Unsigned_8; + Seg_Sz : Unsigned_8; + Pad : Unsigned_32; + + Addr : Unsigned_32; + Len : Unsigned_32; + begin + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Read_Word4 (Base, Off, Set_Len); + Last := Off + Storage_Offset (Set_Len); + Read_Word2 (Base, Off, Ver); + Read_Word4 (Base, Off, Info_Off); + Read_Byte (Base, Off, Addr_Sz); + Read_Byte (Base, Off, Seg_Sz); + Read_Word4 (Base, Off, Pad); + Put ("length: " & Hex_Image (Set_Len)); + Put (", version: " & Hex_Image (Ver)); + Put (", offset: " & Hex_Image (Info_Off)); + Put (", ptr_sz: " & Hex_Image (Addr_Sz)); + Put (", seg_sz: " & Hex_Image (Seg_Sz)); + New_Line; + + loop + Read_Word4 (Base, Off, Addr); + Read_Word4 (Base, Off, Len); + Put (" "); + Put (Hex_Image (Addr)); + Put ('+'); + Put (Hex_Image (Len)); + New_Line; + exit when Addr = 0 and Len = 0; + end loop; + end loop; + end Disp_Debug_Aranges; + + procedure Disp_String (Base : Address; Off : in out Storage_Offset) + is + B : Unsigned_8; + begin + loop + B := Read_Byte (Base + Off); + Off := Off + 1; + exit when B = 0; + Put (Character'Val (B)); + end loop; + end Disp_String; + + procedure Read_String (Base : Address; Off : in out Storage_Offset) + is + B : Unsigned_8; + begin + loop + Read_Byte (Base, Off, B); + exit when B = 0; + end loop; + end Read_String; + + function Get_Dwarf_LNS_Name (Lns : Unsigned_8) return String + is + use Dwarf; + begin + case Lns is + when DW_LNS_Copy => + return "copy"; + when DW_LNS_Advance_Pc => + return "advance_pc"; + when DW_LNS_Advance_Line => + return "advance_line"; + when DW_LNS_Set_File => + return "set_file"; + when DW_LNS_Set_Column => + return "set_column"; + when DW_LNS_Negate_Stmt => + return "negate_stmt"; + when DW_LNS_Set_Basic_Block => + return "set_basic_block"; + when DW_LNS_Const_Add_Pc => + return "const_add_pc"; + when DW_LNS_Fixed_Advance_Pc => + return "fixed_advance_pc"; + when DW_LNS_Set_Prologue_End => + return "set_prologue_end"; + when DW_LNS_Set_Epilogue_Begin => + return "set_epilogue_begin"; + when DW_LNS_Set_Isa => + return "set_isa"; + when others => + return "?unknown?"; + end case; + end Get_Dwarf_LNS_Name; + + procedure Disp_Debug_Line (File : Elf_File; Index : Elf_Half) + is + use Dwarf; + Shdr : Elf_Shdr_Acc; + Base : Address; + Off : Storage_Offset; + + type Opc_Length_Type is array (Unsigned_8 range <>) of Unsigned_8; + type Opc_Length_Acc is access Opc_Length_Type; + Opc_Length : Opc_Length_Acc; + + Total_Len : Unsigned_32; + Version : Unsigned_16; + Prolog_Len : Unsigned_32; + Min_Insn_Len : Unsigned_8; + Dflt_Is_Stmt : Unsigned_8; + Line_Base : Unsigned_8; + Line_Range : Unsigned_8; + Opc_Base : Unsigned_8; + + B : Unsigned_8; + Arg : Unsigned_32; + + Old_Off : Storage_Offset; + File_Dir : Unsigned_32; + File_Time : Unsigned_32; + File_Len : Unsigned_32; + + Ext_Len : Unsigned_32; + Ext_Opc : Unsigned_8; + + Last : Storage_Offset; + + Pc : Unsigned_32; + Line : Unsigned_32; + Line_Base2 : Unsigned_32; + begin + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Read_Word4 (Base, Off, Total_Len); + Last := Off + Storage_Offset (Total_Len); + Read_Word2 (Base, Off, Version); + Read_Word4 (Base, Off, Prolog_Len); + Read_Byte (Base, Off, Min_Insn_Len); + Read_Byte (Base, Off, Dflt_Is_Stmt); + Read_Byte (Base, Off, Line_Base); + Read_Byte (Base, Off, Line_Range); + Read_Byte (Base, Off, Opc_Base); + + Pc := 0; + Line := 1; + + Put ("length: " & Hex_Image (Total_Len)); + Put (", version: " & Hex_Image (Version)); + Put (", prolog_len: " & Hex_Image (Prolog_Len)); + New_Line; + Put (" minimum_instruction_len: " & Hex_Image (Min_Insn_Len)); + Put (", default_is_stmt: " & Hex_Image (Dflt_Is_Stmt)); + New_Line; + Put (" line_base: " & Hex_Image (Line_Base)); + Put (", line_range: " & Hex_Image (Line_Range)); + Put (", opc_base: " & Hex_Image (Opc_Base)); + New_Line; + Line_Base2 := Unsigned_32 (Line_Base); + if (Line_Base and 16#80#) /= 0 then + Line_Base2 := Line_Base2 or 16#Ff_Ff_Ff_00#; + end if; + Put_Line ("standard_opcode_length:"); + Opc_Length := new Opc_Length_Type (1 .. Opc_Base - 1); + for I in 1 .. Opc_Base - 1 loop + Read_Byte (Base, Off, B); + Put (' '); + Put (Hex_Image (I)); + Put (" => "); + Put (Hex_Image (B)); + Opc_Length (I) := B; + New_Line; + end loop; + Put_Line ("include_directories:"); + loop + B := Read_Byte (Base + Off); + exit when B = 0; + Put (' '); + Disp_String (Base, Off); + New_Line; + end loop; + Off := Off + 1; + Put_Line ("file_names:"); + loop + B := Read_Byte (Base + Off); + exit when B = 0; + Old_Off := Off; + Read_String (Base, Off); + Read_ULEB128 (Base, Off, File_Dir); + Read_ULEB128 (Base, Off, File_Time); + Read_ULEB128 (Base, Off, File_Len); + Put (' '); + Put (Hex_Image (File_Dir)); + Put (' '); + Put (Hex_Image (File_Time)); + Put (' '); + Put (Hex_Image (File_Len)); + Put (' '); + Disp_String (Base, Old_Off); + New_Line; + end loop; + Off := Off + 1; + + while Off < Last loop + Put (" "); + Read_Byte (Base, Off, B); + Put (Hex_Image (B)); + Old_Off := Off; + if B < Opc_Base then + case B is + when 0 => + Put (" (extended)"); + Read_ULEB128 (Base, Off, Ext_Len); + Put (", len: "); + Put (Hex_Image (Ext_Len)); + Old_Off := Off; + Read_Byte (Base, Off, Ext_Opc); + Put (" opc:"); + Put (Hex_Image (Ext_Opc)); + Off := Old_Off + Storage_Offset (Ext_Len); + when others => + Put (" ("); + Put (Get_Dwarf_LNS_Name (B)); + Put (")"); + Set_Col (20); + for J in 1 .. Opc_Length (B) loop + Read_ULEB128 (Base, Off, Arg); + Put (" "); + Put (Hex_Image (Arg)); + end loop; + end case; + case B is + when DW_LNS_Copy => + Put (" pc="); + Put (Hex_Image (Pc)); + Put (", line="); + Put (Unsigned_32'Image (Line)); + when DW_LNS_Advance_Pc => + Read_ULEB128 (Base, Old_Off, Arg); + Pc := Pc + Arg * Unsigned_32 (Min_Insn_Len); + Put (" pc="); + Put (Hex_Image (Pc)); + when DW_LNS_Advance_Line => + Read_SLEB128 (Base, Old_Off, Arg); + Line := Line + Arg; + Put (" line="); + Put (Unsigned_32'Image (Line)); + when DW_LNS_Set_File => + null; + when DW_LNS_Set_Column => + null; + when DW_LNS_Negate_Stmt => + null; + when DW_LNS_Set_Basic_Block => + null; + when DW_LNS_Const_Add_Pc => + Pc := Pc + Unsigned_32 ((255 - Opc_Base) / Line_Range) + * Unsigned_32 (Min_Insn_Len); + Put (" pc="); + Put (Hex_Image (Pc)); + when others => + null; + end case; + New_Line; + else + B := B - Opc_Base; + Pc := Pc + Unsigned_32 (B / Line_Range) + * Unsigned_32 (Min_Insn_Len); + Line := Line + Line_Base2 + Unsigned_32 (B mod Line_Range); + Put (" pc="); + Put (Hex_Image (Pc)); + Put (", line="); + Put (Unsigned_32'Image (Line)); + New_Line; + end if; + end loop; + end loop; + end Disp_Debug_Line; + + function Get_Dwarf_Cfi_Name (Cfi : Unsigned_8) return String + is + use Dwarf; + begin + case Cfi is + when DW_CFA_Advance_Loc_Min .. DW_CFA_Advance_Loc_Max => + return "advance_loc"; + when DW_CFA_Offset_Min .. DW_CFA_Offset_Max => + return "offset"; + when DW_CFA_Restore_Min .. DW_CFA_Restore_Max => + return "restore"; + when DW_CFA_Nop => + return "nop"; + when DW_CFA_Set_Loc => + return "set_loc"; + when DW_CFA_Advance_Loc1 => + return "advance_loc1"; + when DW_CFA_Advance_Loc2 => + return "advance_loc2"; + when DW_CFA_Advance_Loc4 => + return "advance_loc4"; + when DW_CFA_Offset_Extended => + return "offset_extended"; + when DW_CFA_Restore_Extended => + return "restore_extended"; + when DW_CFA_Undefined => + return "undefined"; + when DW_CFA_Same_Value => + return "same_value"; + when DW_CFA_Register => + return "register"; + when DW_CFA_Remember_State => + return "remember_state"; + when DW_CFA_Restore_State => + return "restore_state"; + when DW_CFA_Def_Cfa => + return "def_cfa"; + when DW_CFA_Def_Cfa_Register => + return "def_cfa_register"; + when DW_CFA_Def_Cfa_Offset => + return "def_cfa_offset"; + when DW_CFA_Def_Cfa_Expression => + return "def_cfa_expression"; + when others => + return "?unknown?"; + end case; + end Get_Dwarf_Cfi_Name; + + procedure Disp_Cfi (Base : Address; Length : Storage_Count) + is + use Dwarf; + L : Storage_Offset; + Op : Unsigned_8; + Off : Unsigned_32; + Reg : Unsigned_32; + begin + L := 0; + while L < Length loop + Op := Read_Byte (Base + L); + Put (" "); + Put (Hex_Image (Op)); + Put (" "); + Put (Get_Dwarf_Cfi_Name (Op)); + Put (" "); + L := L + 1; + case Op is + when DW_CFA_Nop => + null; + when DW_CFA_Advance_Loc_Min .. DW_CFA_Advance_Loc_Max => + Put (Hex_Image (Op and 16#3f#)); + when DW_CFA_Offset_Min .. DW_CFA_Offset_Max => + Read_ULEB128 (Base, L, Off); + Put ("reg:"); + Put (Hex_Image (Op and 16#3f#)); + Put (", offset:"); + Put (Hex_Image (Off)); + when DW_CFA_Def_Cfa => + Read_ULEB128 (Base, L, Reg); + Read_ULEB128 (Base, L, Off); + Put ("reg:"); + Put (Hex_Image (Reg)); + Put (", offset:"); + Put (Hex_Image (Off)); + when DW_CFA_Def_Cfa_Offset => + Read_ULEB128 (Base, L, Off); + Put (Hex_Image (Off)); + when DW_CFA_Def_Cfa_Register => + Read_ULEB128 (Base, L, Reg); + Put ("reg:"); + Put (Hex_Image (Reg)); + when others => + Put ("?unknown?"); + New_Line; + exit; + end case; + New_Line; + end loop; + end Disp_Cfi; + + procedure Disp_Debug_Frame (File : Elf_File; Index : Elf_Half) + is + Shdr : Elf_Shdr_Acc; + Base : Address; + Off : Storage_Offset; + Old_Off : Storage_Offset; + + Length : Unsigned_32; + Cie_Id : Unsigned_32; + Version : Unsigned_8; + Augmentation : Unsigned_8; + Code_Align : Unsigned_32; + Data_Align : Unsigned_32; + Ret_Addr_Reg : Unsigned_8; + + Init_Loc : Unsigned_32; + Addr_Rng : Unsigned_32; + begin + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Read_Word4 (Base, Off, Length); + Old_Off := Off; + + Read_Word4 (Base, Off, Cie_Id); + if Cie_Id = 16#Ff_Ff_Ff_Ff# then + Read_Byte (Base, Off, Version); + Read_Byte (Base, Off, Augmentation); + Put ("length: "); + Put (Hex_Image (Length)); + Put (", CIE_id: "); + Put (Hex_Image (Cie_Id)); + Put (", version: "); + Put (Hex_Image (Version)); + if Augmentation /= 0 then + Put (" +augmentation"); + New_Line; + else + New_Line; + Read_ULEB128 (Base, Off, Code_Align); + Read_SLEB128 (Base, Off, Data_Align); + Read_Byte (Base, Off, Ret_Addr_Reg); + Put ("code_align: "); + Put (Hex_Image (Code_Align)); + Put (", data_align: "); + Put (Hex_Image (Data_Align)); + Put (", ret_addr_reg: "); + Put (Hex_Image (Ret_Addr_Reg)); + New_Line; + Put ("initial instructions:"); + New_Line; + Disp_Cfi (Base + Off, Old_Off + Storage_Offset (Length) - Off); + end if; + else + Read_Word4 (Base, Off, Init_Loc); + Read_Word4 (Base, Off, Addr_Rng); + Put ("length: "); + Put (Hex_Image (Length)); + Put (", CIE_pointer: "); + Put (Hex_Image (Cie_Id)); + Put (", address_range: "); + Put (Hex_Image (Init_Loc)); + Put ("-"); + Put (Hex_Image (Init_Loc + Addr_Rng)); + New_Line; + Put ("instructions:"); + New_Line; + Disp_Cfi (Base + Off, Old_Off + Storage_Offset (Length) - Off); + end if; + Off := Old_Off + Storage_Offset (Length); + end loop; + end Disp_Debug_Frame; + + procedure Read_Coded (Base : Address; + Offset : in out Storage_Offset; + Code : Unsigned_8; + Val : out Unsigned_32) + is + use Dwarf; + + V2 : Unsigned_16; + begin + if Code = DW_EH_PE_Omit then + return; + end if; + case Code and DW_EH_PE_Format_Mask is + when DW_EH_PE_Uleb128 => + Read_ULEB128 (Base, Offset, Val); + when DW_EH_PE_Udata2 => + Read_Word2 (Base, Offset, V2); + Val := Unsigned_32 (V2); + when DW_EH_PE_Udata4 => + Read_Word4 (Base, Offset, Val); + when DW_EH_PE_Sleb128 => + Read_SLEB128 (Base, Offset, Val); + when DW_EH_PE_Sdata2 => + Read_Word2 (Base, Offset, V2); + Val := Unsigned_32 (V2); + if (V2 and 16#80_00#) /= 0 then + Val := Val or 16#Ff_Ff_00_00#; + end if; + when DW_EH_PE_Sdata4 => + Read_Word4 (Base, Offset, Val); + when others => + raise Program_Error; + end case; + end Read_Coded; + + procedure Disp_Eh_Frame_Hdr (File : Elf_File; Index : Elf_Half) + is + Shdr : Elf_Shdr_Acc; + Base : Address; + Off : Storage_Offset; + + Version : Unsigned_8; + Eh_Frame_Ptr_Enc : Unsigned_8; + Fde_Count_Enc : Unsigned_8; + Table_Enc : Unsigned_8; + + Eh_Frame_Ptr : Unsigned_32; + Fde_Count : Unsigned_32; + + Loc : Unsigned_32; + Addr : Unsigned_32; + begin + Shdr := Get_Shdr (File, Index); + Base := Get_Section_Base (File, Shdr.all); + + Off := 0; + while Off < Storage_Offset (Shdr.Sh_Size) loop + Read_Byte (Base, Off, Version); + Read_Byte (Base, Off, Eh_Frame_Ptr_Enc); + Read_Byte (Base, Off, Fde_Count_Enc); + Read_Byte (Base, Off, Table_Enc); + Put ("version: "); + Put (Hex_Image (Version)); + Put (", encodings: ptr:"); + Put (Hex_Image (Eh_Frame_Ptr_Enc)); + Put (" count:"); + Put (Hex_Image (Fde_Count_Enc)); + Put (" table:"); + Put (Hex_Image (Table_Enc)); + New_Line; + Read_Coded (Base, Off, Eh_Frame_Ptr_Enc, Eh_Frame_Ptr); + Read_Coded (Base, Off, Fde_Count_Enc, Fde_Count); + Put ("eh_frame_ptr: "); + Put (Hex_Image (Eh_Frame_Ptr)); + Put (", fde_count: "); + Put (Hex_Image (Fde_Count)); + New_Line; + for I in 1 .. Fde_Count loop + Read_Coded (Base, Off, Table_Enc, Loc); + Read_Coded (Base, Off, Table_Enc, Addr); + Put (" init loc: "); + Put (Hex_Image (Loc)); + Put (", addr : "); + Put (Hex_Image (Addr)); + New_Line; + end loop; + end loop; + end Disp_Eh_Frame_Hdr; +end Elfdumper; |