summaryrefslogtreecommitdiff
path: root/ortho/mcode/coffdump.adb
diff options
context:
space:
mode:
Diffstat (limited to 'ortho/mcode/coffdump.adb')
-rw-r--r--ortho/mcode/coffdump.adb274
1 files changed, 0 insertions, 274 deletions
diff --git a/ortho/mcode/coffdump.adb b/ortho/mcode/coffdump.adb
deleted file mode 100644
index 6384b6c..0000000
--- a/ortho/mcode/coffdump.adb
+++ /dev/null
@@ -1,274 +0,0 @@
--- 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;
-
generated by cgit (git 2.34.1) at 2024-12-21 18:05:36 +0000