diff options
Diffstat (limited to 'src/ortho/mcode/coffdump.adb')
| -rw-r--r-- | src/ortho/mcode/coffdump.adb | 274 |
1 files changed, 274 insertions, 0 deletions
diff --git a/src/ortho/mcode/coffdump.adb b/src/ortho/mcode/coffdump.adb new file mode 100644 index 000000000..6384b6c27 --- /dev/null +++ b/src/ortho/mcode/coffdump.adb @@ -0,0 +1,274 @@ +-- COFF dumper. +-- Copyright (C) 2006 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Coff; use Coff; +with Interfaces; use Interfaces; +with System; +with Ada.Unchecked_Conversion; +with Ada.Command_Line; use Ada.Command_Line; +with GNAT.OS_Lib; use GNAT.OS_Lib; +with Ada.Text_IO; use Ada.Text_IO; +with Hex_Images; use Hex_Images; + +procedure Coffdump is + type Cstring is array (Unsigned_32 range <>) of Character; + type Cstring_Acc is access Cstring; + type Section_Array is array (Unsigned_16 range <>) of Scnhdr; + type Section_Array_Acc is access Section_Array; + -- Array of sections. + Sections : Section_Array_Acc; + + type External_Symbol is array (0 .. Symesz - 1) of Character; + type External_Symbol_Array is array (Unsigned_32 range <>) + of External_Symbol; + type Symbol_Array_Acc is access External_Symbol_Array; + -- Symbols table. + External_Symbols : Symbol_Array_Acc; + + -- String table. + Str : Cstring_Acc; + Str_Size : Natural; + + Hdr : Filehdr; + --Sym : Syment; + Fd : File_Descriptor; + Skip : Natural; + Skip_Kind : Unsigned_8; + Aux_File : Auxent_File; + Aux_Scn : Auxent_Scn; + Rel : Reloc; + Len : Natural; + + Nul : constant Character := Character'Val (0); + + function Find_Nul (S : String) return String is + begin + for I in S'Range loop + if S (I) = Nul then + return S (S'First .. I - 1); + end if; + end loop; + return S; + end Find_Nul; + + function Get_String (N : Strent_Type; S : String) return String + is + begin + if N.E_Zeroes /= 0 then + return Find_Nul (S); + else + for I in N.E_Offset .. Str'Last loop + if Str (I) = Nul then + return String (Str (N.E_Offset .. I - 1)); + end if; + end loop; + raise Program_Error; + end if; + end Get_String; + + procedure Memcpy + (Dst : System.Address; Src : System.Address; Size : Natural); + pragma Import (C, Memcpy); + + function Get_Section_Name (N : Unsigned_16) return String is + begin + if N = N_UNDEF then + return "UNDEF"; + elsif N = N_ABS then + return "ABS"; + elsif N = N_DEBUG then + return "DEBUG"; + elsif N > Hdr.F_Nscns then + return "???"; + else + return Find_Nul (Sections (N).S_Name); + end if; + end Get_Section_Name; + + function Get_Symbol (N : Unsigned_32) return Syment is + function Unchecked_Conv is new Ada.Unchecked_Conversion + (Source => External_Symbol, Target => Syment); + begin + if N > Hdr.F_Nsyms then + raise Constraint_Error; + end if; + return Unchecked_Conv (External_Symbols (N)); + end Get_Symbol; + + function Get_Symbol_Name (N : Unsigned_32) return String + is + S : Syment := Get_Symbol (N); + begin + return Get_String (S.E.E, S.E.E_Name); + end Get_Symbol_Name; +begin + for I in 1 .. Argument_Count loop + Fd := Open_Read (Argument (I), Binary); + if Fd = Invalid_FD then + Put_Line ("cannot open " & Argument (I)); + return; + end if; + -- Read file header. + if Read (Fd, Hdr'Address, Filehdr_Size) /= Filehdr_Size then + Put_Line ("cannot read header"); + return; + end if; + Put_Line ("File: " & Argument (I)); + Put_Line ("magic: " & Hex_Image (Hdr.F_Magic)); + Put_Line ("number of sections: " & Hex_Image (Hdr.F_Nscns)); + Put_Line ("time and date stamp: " & Hex_Image (Hdr.F_Timdat)); + Put_Line ("symtab file pointer: " & Hex_Image (Hdr.F_Symptr)); + Put_Line ("nbr symtab entries: " & Hex_Image (Hdr.F_Nsyms)); + Put_Line ("opt header size: " & Hex_Image (Hdr.F_Opthdr)); + Put_Line ("flags: " & Hex_Image (Hdr.F_Flags)); + + -- Read sections header. + Lseek (Fd, Long_Integer (Hdr.F_Opthdr), Seek_Cur); + Sections := new Section_Array (1 .. Hdr.F_Nscns); + Len := Scnhdr_Size * Natural (Hdr.F_Nscns); + if Read (Fd, Sections (1)'Address, Len) /= Len then + Put_Line ("cannot read section header"); + return; + end if; + for I in 1 .. Hdr.F_Nscns loop + declare + S: Scnhdr renames Sections (I); + begin + Put_Line ("Section " & Find_Nul (S.S_Name)); + Put_Line ("Physical address : " & Hex_Image (S.S_Paddr)); + Put_Line ("Virtual address : " & Hex_Image (S.S_Vaddr)); + Put_Line ("section size : " & Hex_Image (S.S_Size)); + Put_Line ("section pointer : " & Hex_Image (S.S_Scnptr)); + Put_Line ("relocation pointer : " & Hex_Image (S.S_Relptr)); + Put_Line ("line num pointer : " & Hex_Image (S.S_Lnnoptr)); + Put_Line ("Nbr reloc entries : " & Hex_Image (S.S_Nreloc)); + Put_Line ("Nbr line num entries : " & Hex_Image (S.S_Nlnno)); + Put_Line ("Flags : " & Hex_Image (S.S_Flags)); + end; + end loop; + + -- Read string table. + Lseek (Fd, + Long_Integer (Hdr.F_Symptr + Hdr.F_Nsyms * Unsigned_32 (Symesz)), + Seek_Set); + if Read (Fd, Str_Size'Address, 4) /= 4 then + Put_Line ("cannot read string table size"); + return; + end if; + Str := new Cstring (0 .. Unsigned_32 (Str_Size)); + if Read (Fd, Str (4)'Address, Str_Size - 4) /= Str_Size - 4 then + Put_Line ("cannot read string table"); + return; + end if; + + -- Read symbol table. + Lseek (Fd, Long_Integer (Hdr.F_Symptr), Seek_Set); + External_Symbols := new External_Symbol_Array (0 .. Hdr.F_Nsyms - 1); + Len := Natural (Hdr.F_Nsyms) * Symesz; + if Read (Fd, External_Symbols (0)'Address, Len) /= Len then + Put_Line ("cannot read symbol"); + return; + end if; + + Skip := 0; + Skip_Kind := C_NULL; + for I in External_Symbols'range loop + if Skip > 0 then + case Skip_Kind is + when C_FILE => + Memcpy (Aux_File'Address, External_Symbols (I)'Address, + Aux_File'Size / 8); + Put_Line ("aux file : " & Get_String (Aux_File.X_N, + Aux_File.X_Fname)); + Skip_Kind := C_NULL; + when C_STAT => + Memcpy (Aux_Scn'Address, External_Symbols (I)'Address, + Aux_Scn'Size / 8); + Put_Line ("section len: " & Hex_Image (Aux_Scn.X_Scnlen)); + Put_Line ("nbr reloc ent: " & Hex_Image (Aux_Scn.X_Nreloc)); + Put_Line ("nbr line num: " & Hex_Image (Aux_Scn.X_Nlinno)); + when others => + Put_Line ("skip"); + end case; + Skip := Skip - 1; + else + declare + S : Syment := Get_Symbol (I); + begin + Put_Line ("Symbol #" & Hex_Image (I)); + Put_Line ("symbol name : " & Get_Symbol_Name (I)); + Put_Line ("symbol value: " & Hex_Image (S.E_Value)); + Put_Line ("section num : " & Hex_Image (S.E_Scnum) + & " " & Get_Section_Name (S.E_Scnum)); + Put_Line ("type : " & Hex_Image (S.E_Type)); + Put ("sclass : " & Hex_Image (S.E_Sclass)); + if Sclass_Desc (S.E_Sclass).Name /= null then + Put (" ("); + Put (Sclass_Desc (S.E_Sclass).Name.all); + Put (" - "); + Put (Sclass_Desc (S.E_Sclass).Meaning.all); + Put (")"); + end if; + New_Line; + Put_Line ("numaux : " & Hex_Image (S.E_Numaux)); + if S.E_Numaux > 0 then + case S.E_Sclass is + when C_FILE => + Skip_Kind := C_FILE; + when C_STAT => + Skip_Kind := C_STAT; + when others => + Skip_Kind := C_NULL; + end case; + end if; + Skip := Natural (S.E_Numaux); + end; + end if; + end loop; + + -- Disp relocs. + for I in 1 .. Hdr.F_Nscns loop + if Sections (I).S_Nreloc > 0 then + -- Read relocations. + Put_Line ("Relocations for section " & Get_Section_Name (I)); + Lseek (Fd, Long_Integer (Sections (I).S_Relptr), Seek_Set); + for J in 1 .. Sections (I).S_Nreloc loop + if Read (Fd, Rel'Address, Relsz) /= Relsz then + Put_Line ("cannot read reloc"); + return; + end if; + Put_Line ("reloc virtual addr: " & Hex_Image (Rel.R_Vaddr)); + Put_Line ("symbol index : " & Hex_Image (Rel.R_Symndx) + & " " & Get_Symbol_Name (Rel.R_Symndx)); + Put ("type of relocation: " & Hex_Image (Rel.R_Type)); + case Rel.R_Type is + when Reloc_Rel32 => + Put (" RELOC_REL32"); + when Reloc_Addr32 => + Put (" RELOC_ADDR32"); + when others => + null; + end case; + New_Line; + end loop; + end if; + end loop; + + Close (Fd); + end loop; +end Coffdump; + |