| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- S Y S T E M . O B J E C T _ R E A D E R -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2009-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Unchecked_Conversion; |
| |
| with Interfaces.C; |
| |
| with System.CRTL; |
| |
| package body System.Object_Reader is |
| |
| use Interfaces; |
| use Interfaces.C; |
| use System.Mmap; |
| |
| SSU : constant := System.Storage_Unit; |
| |
| function To_int32 is new Ada.Unchecked_Conversion (uint32, int32); |
| |
| function Trim_Trailing_Nuls (Str : String) return String; |
| -- Return a copy of a string with any trailing NUL characters truncated |
| |
| procedure Check_Read_Offset (S : Mapped_Stream; Size : uint32); |
| -- Check that the SIZE bytes at the current offset are still in the stream |
| |
| ------------------------------------- |
| -- ELF object file format handling -- |
| ------------------------------------- |
| |
| generic |
| type uword is mod <>; |
| |
| package ELF_Ops is |
| |
| -- ELF version codes |
| |
| ELFCLASS32 : constant := 1; -- 32 bit ELF |
| ELFCLASS64 : constant := 2; -- 64 bit ELF |
| |
| -- ELF machine codes |
| |
| EM_NONE : constant := 0; -- No machine |
| EM_SPARC : constant := 2; -- SUN SPARC |
| EM_386 : constant := 3; -- Intel 80386 |
| EM_MIPS : constant := 8; -- MIPS RS3000 Big-Endian |
| EM_MIPS_RS3_LE : constant := 10; -- MIPS RS3000 Little-Endian |
| EM_SPARC32PLUS : constant := 18; -- Sun SPARC 32+ |
| EM_PPC : constant := 20; -- PowerPC |
| EM_PPC64 : constant := 21; -- PowerPC 64-bit |
| EM_ARM : constant := 40; -- ARM |
| EM_SPARCV9 : constant := 43; -- SPARC v9 64-bit |
| EM_IA_64 : constant := 50; -- Intel Merced |
| EM_X86_64 : constant := 62; -- AMD x86-64 architecture |
| EM_AARCH64 : constant := 183; -- Aarch64 |
| |
| EN_NIDENT : constant := 16; |
| |
| type E_Ident_Type is array (0 .. EN_NIDENT - 1) of uint8; |
| |
| type Header is record |
| E_Ident : E_Ident_Type; -- Magic number and other info |
| E_Type : uint16; -- Object file type |
| E_Machine : uint16; -- Architecture |
| E_Version : uint32; -- Object file version |
| E_Entry : uword; -- Entry point virtual address |
| E_Phoff : uword; -- Program header table file offset |
| E_Shoff : uword; -- Section header table file offset |
| E_Flags : uint32; -- Processor-specific flags |
| E_Ehsize : uint16; -- ELF header size in bytes |
| E_Phentsize : uint16; -- Program header table entry size |
| E_Phnum : uint16; -- Program header table entry count |
| E_Shentsize : uint16; -- Section header table entry size |
| E_Shnum : uint16; -- Section header table entry count |
| E_Shstrndx : uint16; -- Section header string table index |
| end record; |
| |
| type Section_Header is record |
| Sh_Name : uint32; -- Section name string table index |
| Sh_Type : uint32; -- Section type |
| Sh_Flags : uword; -- Section flags |
| Sh_Addr : uword; -- Section virtual addr at execution |
| Sh_Offset : uword; -- Section file offset |
| Sh_Size : uword; -- Section size in bytes |
| Sh_Link : uint32; -- Link to another section |
| Sh_Info : uint32; -- Additional section information |
| Sh_Addralign : uword; -- Section alignment |
| Sh_Entsize : uword; -- Entry size if section holds table |
| end record; |
| |
| SHF_ALLOC : constant := 2; |
| SHF_EXECINSTR : constant := 4; |
| |
| type Symtab_Entry32 is record |
| St_Name : uint32; -- Name (string table index) |
| St_Value : uint32; -- Value |
| St_Size : uint32; -- Size in bytes |
| St_Info : uint8; -- Type and binding attributes |
| St_Other : uint8; -- Undefined |
| St_Shndx : uint16; -- Defining section |
| end record; |
| |
| type Symtab_Entry64 is record |
| St_Name : uint32; -- Name (string table index) |
| St_Info : uint8; -- Type and binding attributes |
| St_Other : uint8; -- Undefined |
| St_Shndx : uint16; -- Defining section |
| St_Value : uint64; -- Value |
| St_Size : uint64; -- Size in bytes |
| end record; |
| |
| function Read_Header (F : in out Mapped_Stream) return Header; |
| -- Read a header from an ELF format object |
| |
| function First_Symbol |
| (Obj : in out ELF_Object_File) return Object_Symbol; |
| -- Return the first element in the symbol table, or Null_Symbol if the |
| -- symbol table is empty. |
| |
| function Read_Symbol |
| (Obj : in out ELF_Object_File; |
| Off : Offset) return Object_Symbol; |
| -- Read a symbol at offset Off |
| |
| function Name |
| (Obj : in out ELF_Object_File; |
| Sym : Object_Symbol) return String_Ptr_Len; |
| -- Return the name of the symbol |
| |
| function Name |
| (Obj : in out ELF_Object_File; |
| Sec : Object_Section) return String; |
| -- Return the name of a section |
| |
| function Get_Section |
| (Obj : in out ELF_Object_File; |
| Shnum : uint32) return Object_Section; |
| -- Fetch a section by index from zero |
| |
| function Initialize |
| (F : Mapped_File; |
| Hdr : Header; |
| In_Exception : Boolean) return ELF_Object_File; |
| -- Initialize an object file |
| |
| end ELF_Ops; |
| |
| ----------------------------------- |
| -- PECOFF object format handling -- |
| ----------------------------------- |
| |
| package PECOFF_Ops is |
| |
| -- Constants and data layout are taken from the document "Microsoft |
| -- Portable Executable and Common Object File Format Specification" |
| -- Revision 8.1. |
| |
| Signature_Loc_Offset : constant := 16#3C#; |
| -- Offset of pointer to the file signature |
| |
| Size_Of_Standard_Header_Fields : constant := 16#18#; |
| -- Length in bytes of the standard header record |
| |
| Function_Symbol_Type : constant := 16#20#; |
| -- Type field value indicating a symbol refers to a function |
| |
| Not_Function_Symbol_Type : constant := 16#00#; |
| -- Type field value indicating a symbol does not refer to a function |
| |
| type Magic_Array is array (0 .. 3) of uint8; |
| -- Array of magic numbers from the header |
| |
| -- Magic numbers for PECOFF variants |
| |
| VARIANT_PE32 : constant := 16#010B#; |
| VARIANT_PE32_PLUS : constant := 16#020B#; |
| |
| -- PECOFF machine codes |
| |
| IMAGE_FILE_MACHINE_I386 : constant := 16#014C#; |
| IMAGE_FILE_MACHINE_IA64 : constant := 16#0200#; |
| IMAGE_FILE_MACHINE_AMD64 : constant := 16#8664#; |
| |
| -- PECOFF Data layout |
| |
| type Header is record |
| Magics : Magic_Array; |
| Machine : uint16; |
| NumberOfSections : uint16; |
| TimeDateStamp : uint32; |
| PointerToSymbolTable : uint32; |
| NumberOfSymbols : uint32; |
| SizeOfOptionalHeader : uint16; |
| Characteristics : uint16; |
| Variant : uint16; |
| end record; |
| pragma Pack (Header); |
| |
| type Optional_Header_PE32 is record |
| Magic : uint16; |
| MajorLinkerVersion : uint8; |
| MinorLinkerVersion : uint8; |
| SizeOfCode : uint32; |
| SizeOfInitializedData : uint32; |
| SizeOfUninitializedData : uint32; |
| AddressOfEntryPoint : uint32; |
| BaseOfCode : uint32; |
| BaseOfData : uint32; -- Note: not in PE32+ |
| ImageBase : uint32; |
| SectionAlignment : uint32; |
| FileAlignment : uint32; |
| MajorOperatingSystemVersion : uint16; |
| MinorOperationSystemVersion : uint16; |
| MajorImageVersion : uint16; |
| MinorImageVersion : uint16; |
| MajorSubsystemVersion : uint16; |
| MinorSubsystemVersion : uint16; |
| Win32VersionValue : uint32; |
| SizeOfImage : uint32; |
| SizeOfHeaders : uint32; |
| Checksum : uint32; |
| Subsystem : uint16; |
| DllCharacteristics : uint16; |
| SizeOfStackReserve : uint32; |
| SizeOfStackCommit : uint32; |
| SizeOfHeapReserve : uint32; |
| SizeOfHeapCommit : uint32; |
| LoaderFlags : uint32; |
| NumberOfRvaAndSizes : uint32; |
| end record; |
| pragma Pack (Optional_Header_PE32); |
| pragma Assert (Optional_Header_PE32'Size = 96 * SSU); |
| |
| type Optional_Header_PE64 is record |
| Magic : uint16; |
| MajorLinkerVersion : uint8; |
| MinorLinkerVersion : uint8; |
| SizeOfCode : uint32; |
| SizeOfInitializedData : uint32; |
| SizeOfUninitializedData : uint32; |
| AddressOfEntryPoint : uint32; |
| BaseOfCode : uint32; |
| ImageBase : uint64; |
| SectionAlignment : uint32; |
| FileAlignment : uint32; |
| MajorOperatingSystemVersion : uint16; |
| MinorOperationSystemVersion : uint16; |
| MajorImageVersion : uint16; |
| MinorImageVersion : uint16; |
| MajorSubsystemVersion : uint16; |
| MinorSubsystemVersion : uint16; |
| Win32VersionValue : uint32; |
| SizeOfImage : uint32; |
| SizeOfHeaders : uint32; |
| Checksum : uint32; |
| Subsystem : uint16; |
| DllCharacteristics : uint16; |
| SizeOfStackReserve : uint64; |
| SizeOfStackCommit : uint64; |
| SizeOfHeapReserve : uint64; |
| SizeOfHeapCommit : uint64; |
| LoaderFlags : uint32; |
| NumberOfRvaAndSizes : uint32; |
| end record; |
| pragma Pack (Optional_Header_PE64); |
| pragma Assert (Optional_Header_PE64'Size = 112 * SSU); |
| |
| subtype Name_Str is String (1 .. 8); |
| |
| type Section_Header is record |
| Name : Name_Str; |
| VirtualSize : uint32; |
| VirtualAddress : uint32; |
| SizeOfRawData : uint32; |
| PointerToRawData : uint32; |
| PointerToRelocations : uint32; |
| PointerToLinenumbers : uint32; |
| NumberOfRelocations : uint16; |
| NumberOfLinenumbers : uint16; |
| Characteristics : uint32; |
| end record; |
| pragma Pack (Section_Header); |
| |
| IMAGE_SCN_CNT_CODE : constant := 16#0020#; |
| |
| type Symtab_Entry is record |
| Name : Name_Str; |
| Value : uint32; |
| SectionNumber : int16; |
| TypeField : uint16; |
| StorageClass : uint8; |
| NumberOfAuxSymbols : uint8; |
| end record; |
| pragma Pack (Symtab_Entry); |
| |
| type Auxent_Section is record |
| Length : uint32; |
| NumberOfRelocations : uint16; |
| NumberOfLinenumbers : uint16; |
| CheckSum : uint32; |
| Number : uint16; |
| Selection : uint8; |
| Unused1 : uint8; |
| Unused2 : uint8; |
| Unused3 : uint8; |
| end record; |
| |
| for Auxent_Section'Size use 18 * 8; |
| |
| function Read_Header (F : in out Mapped_Stream) return Header; |
| -- Read the object file header |
| |
| function First_Symbol |
| (Obj : in out PECOFF_Object_File) return Object_Symbol; |
| -- Return the first element in the symbol table, or Null_Symbol if the |
| -- symbol table is empty. |
| |
| function Read_Symbol |
| (Obj : in out PECOFF_Object_File; |
| Off : Offset) return Object_Symbol; |
| -- Read a symbol at offset Off |
| |
| function Name |
| (Obj : in out PECOFF_Object_File; |
| Sym : Object_Symbol) return String_Ptr_Len; |
| -- Return the name of the symbol |
| |
| function Name |
| (Obj : in out PECOFF_Object_File; |
| Sec : Object_Section) return String; |
| -- Return the name of a section |
| |
| function Get_Section |
| (Obj : in out PECOFF_Object_File; |
| Index : uint32) return Object_Section; |
| -- Fetch a section by index from zero |
| |
| function Initialize |
| (F : Mapped_File; |
| Hdr : Header; |
| In_Exception : Boolean) return PECOFF_Object_File; |
| -- Initialize an object file |
| |
| end PECOFF_Ops; |
| |
| ------------------------------------- |
| -- XCOFF-32 object format handling -- |
| ------------------------------------- |
| |
| package XCOFF32_Ops is |
| |
| -- XCOFF Data layout |
| |
| type Header is record |
| f_magic : uint16; |
| f_nscns : uint16; |
| f_timdat : uint32; |
| f_symptr : uint32; |
| f_nsyms : uint32; |
| f_opthdr : uint16; |
| f_flags : uint16; |
| end record; |
| |
| type Auxiliary_Header is record |
| o_mflag : uint16; |
| o_vstamp : uint16; |
| o_tsize : uint32; |
| o_dsize : uint32; |
| o_bsize : uint32; |
| o_entry : uint32; |
| o_text_start : uint32; |
| o_data_start : uint32; |
| o_toc : uint32; |
| o_snentry : uint16; |
| o_sntext : uint16; |
| o_sndata : uint16; |
| o_sntoc : uint16; |
| o_snloader : uint16; |
| o_snbss : uint16; |
| o_algntext : uint16; |
| o_algndata : uint16; |
| o_modtype : uint16; |
| o_cpuflag : uint8; |
| o_cputype : uint8; |
| o_maxstack : uint32; |
| o_maxdata : uint32; |
| o_debugger : uint32; |
| o_flags : uint8; |
| o_sntdata : uint16; |
| o_sntbss : uint16; |
| end record; |
| pragma Unreferenced (Auxiliary_Header); |
| -- Not used, but not removed (just in case) |
| |
| subtype Name_Str is String (1 .. 8); |
| |
| type Section_Header is record |
| s_name : Name_Str; |
| s_paddr : uint32; |
| s_vaddr : uint32; |
| s_size : uint32; |
| s_scnptr : uint32; |
| s_relptr : uint32; |
| s_lnnoptr : uint32; |
| s_nreloc : uint16; |
| s_nlnno : uint16; |
| s_flags : uint32; |
| end record; |
| pragma Pack (Section_Header); |
| |
| STYP_TEXT : constant := 16#0020#; |
| |
| type Symbol_Entry is record |
| n_name : Name_Str; |
| n_value : uint32; |
| n_scnum : uint16; |
| n_type : uint16; |
| n_sclass : uint8; |
| n_numaux : uint8; |
| end record; |
| for Symbol_Entry'Size use 18 * 8; |
| |
| type Aux_Entry is record |
| x_scnlen : uint32; |
| x_parmhash : uint32; |
| x_snhash : uint16; |
| x_smtyp : uint8; |
| x_smclass : uint8; |
| x_stab : uint32; |
| x_snstab : uint16; |
| end record; |
| for Aux_Entry'Size use 18 * 8; |
| pragma Pack (Aux_Entry); |
| |
| C_EXT : constant := 2; |
| C_HIDEXT : constant := 107; |
| C_WEAKEXT : constant := 111; |
| |
| XTY_LD : constant := 2; |
| -- Magic constant should be documented, especially since it's changed??? |
| |
| function Read_Header (F : in out Mapped_Stream) return Header; |
| -- Read the object file header |
| |
| function First_Symbol |
| (Obj : in out XCOFF32_Object_File) return Object_Symbol; |
| -- Return the first element in the symbol table, or Null_Symbol if the |
| -- symbol table is empty. |
| |
| function Read_Symbol |
| (Obj : in out XCOFF32_Object_File; |
| Off : Offset) return Object_Symbol; |
| -- Read a symbol at offset Off |
| |
| function Name |
| (Obj : in out XCOFF32_Object_File; |
| Sym : Object_Symbol) return String_Ptr_Len; |
| -- Return the name of the symbol |
| |
| function Name |
| (Obj : in out XCOFF32_Object_File; |
| Sec : Object_Section) return String; |
| -- Return the name of a section |
| |
| function Initialize |
| (F : Mapped_File; |
| Hdr : Header; |
| In_Exception : Boolean) return XCOFF32_Object_File; |
| -- Initialize an object file |
| |
| function Get_Section |
| (Obj : in out XCOFF32_Object_File; |
| Index : uint32) return Object_Section; |
| -- Fetch a section by index from zero |
| |
| end XCOFF32_Ops; |
| |
| ------------- |
| -- ELF_Ops -- |
| ------------- |
| |
| package body ELF_Ops is |
| |
| function Get_String_Table (Obj : in out ELF_Object_File) |
| return Object_Section; |
| -- Fetch the section containing the string table |
| |
| function Get_Symbol_Table (Obj : in out ELF_Object_File) |
| return Object_Section; |
| -- Fetch the section containing the symbol table |
| |
| function Read_Section_Header |
| (Obj : in out ELF_Object_File; |
| Shnum : uint32) return Section_Header; |
| -- Read the header for an ELF format object section indexed from zero |
| |
| ------------------ |
| -- First_Symbol -- |
| ------------------ |
| |
| function First_Symbol |
| (Obj : in out ELF_Object_File) return Object_Symbol |
| is |
| begin |
| if Obj.Symtab_Last = 0 then |
| return Null_Symbol; |
| else |
| return Read_Symbol (Obj, 0); |
| end if; |
| end First_Symbol; |
| |
| ----------------- |
| -- Get_Section -- |
| ----------------- |
| |
| function Get_Section |
| (Obj : in out ELF_Object_File; |
| Shnum : uint32) return Object_Section |
| is |
| SHdr : constant Section_Header := Read_Section_Header (Obj, Shnum); |
| |
| begin |
| return (Shnum, |
| Offset (SHdr.Sh_Offset), |
| uint64 (SHdr.Sh_Addr), |
| uint64 (SHdr.Sh_Size), |
| (SHdr.Sh_Flags and SHF_EXECINSTR) /= 0); |
| end Get_Section; |
| |
| ------------------------ |
| -- Get_String_Table -- |
| ------------------------ |
| |
| function Get_String_Table |
| (Obj : in out ELF_Object_File) return Object_Section |
| is |
| begin |
| -- All cases except MIPS IRIX, string table located in .strtab |
| |
| if Obj.Arch /= MIPS then |
| return Get_Section (Obj, ".strtab"); |
| |
| -- On IRIX only .dynstr is available |
| |
| else |
| return Get_Section (Obj, ".dynstr"); |
| end if; |
| end Get_String_Table; |
| |
| ------------------------ |
| -- Get_Symbol_Table -- |
| ------------------------ |
| |
| function Get_Symbol_Table |
| (Obj : in out ELF_Object_File) return Object_Section |
| is |
| begin |
| -- All cases except MIPS IRIX, symbol table located in .symtab |
| |
| if Obj.Arch /= MIPS then |
| return Get_Section (Obj, ".symtab"); |
| |
| -- On IRIX, symbol table located somewhere other than .symtab |
| |
| else |
| return Get_Section (Obj, ".dynsym"); |
| end if; |
| end Get_Symbol_Table; |
| |
| ---------------- |
| -- Initialize -- |
| ---------------- |
| |
| function Initialize |
| (F : Mapped_File; |
| Hdr : Header; |
| In_Exception : Boolean) return ELF_Object_File |
| is |
| Res : ELF_Object_File |
| (Format => (case uword'Size is |
| when 64 => ELF64, |
| when 32 => ELF32, |
| when others => raise Program_Error)); |
| Sec : Object_Section; |
| begin |
| Res.MF := F; |
| Res.In_Exception := In_Exception; |
| Res.Num_Sections := uint32 (Hdr.E_Shnum); |
| |
| case Hdr.E_Machine is |
| when EM_SPARC |
| | EM_SPARC32PLUS |
| => |
| Res.Arch := SPARC; |
| |
| when EM_386 => |
| Res.Arch := i386; |
| |
| when EM_MIPS |
| | EM_MIPS_RS3_LE |
| => |
| Res.Arch := MIPS; |
| |
| when EM_PPC => |
| Res.Arch := PPC; |
| |
| when EM_PPC64 => |
| Res.Arch := PPC64; |
| |
| when EM_SPARCV9 => |
| Res.Arch := SPARC64; |
| |
| when EM_IA_64 => |
| Res.Arch := IA64; |
| |
| when EM_X86_64 => |
| Res.Arch := x86_64; |
| |
| when EM_ARM => |
| Res.Arch := ARM; |
| |
| when EM_AARCH64 => |
| Res.Arch := AARCH64; |
| |
| when others => |
| raise Format_Error with "unrecognized architecture"; |
| end case; |
| |
| -- Map section table and section string table |
| Res.Sectab_Stream := Create_Stream |
| (F, File_Size (Hdr.E_Shoff), |
| File_Size (Hdr.E_Shnum) * File_Size (Hdr.E_Shentsize)); |
| Sec := Get_Section (Res, uint32 (Hdr.E_Shstrndx)); |
| Res.Secstr_Stream := Create_Stream (Res, Sec); |
| |
| -- Map symbol and string table |
| Sec := Get_Symbol_Table (Res); |
| Res.Symtab_Stream := Create_Stream (Res, Sec); |
| Res.Symtab_Last := Offset (Sec.Size); |
| |
| Sec := Get_String_Table (Res); |
| Res.Symstr_Stream := Create_Stream (Res, Sec); |
| |
| return Res; |
| end Initialize; |
| |
| ----------------- |
| -- Read_Header -- |
| ----------------- |
| |
| function Read_Header (F : in out Mapped_Stream) return Header is |
| Hdr : Header; |
| |
| begin |
| Seek (F, 0); |
| Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU)); |
| return Hdr; |
| end Read_Header; |
| |
| ------------------------- |
| -- Read_Section_Header -- |
| ------------------------- |
| |
| function Read_Section_Header |
| (Obj : in out ELF_Object_File; |
| Shnum : uint32) return Section_Header |
| is |
| Shdr : Section_Header; |
| |
| begin |
| Seek (Obj.Sectab_Stream, Offset (Shnum * Section_Header'Size / SSU)); |
| Read_Raw (Obj.Sectab_Stream, Shdr'Address, Section_Header'Size / SSU); |
| return Shdr; |
| end Read_Section_Header; |
| |
| ----------------- |
| -- Read_Symbol -- |
| ----------------- |
| |
| function Read_Symbol |
| (Obj : in out ELF_Object_File; |
| Off : Offset) return Object_Symbol |
| is |
| ST_Entry32 : Symtab_Entry32; |
| ST_Entry64 : Symtab_Entry64; |
| Res : Object_Symbol; |
| |
| begin |
| Seek (Obj.Symtab_Stream, Off); |
| |
| case uword'Size is |
| when 32 => |
| Read_Raw (Obj.Symtab_Stream, ST_Entry32'Address, |
| uint32 (ST_Entry32'Size / SSU)); |
| Res := (Off, |
| Off + ST_Entry32'Size / SSU, |
| uint64 (ST_Entry32.St_Value), |
| uint64 (ST_Entry32.St_Size)); |
| |
| when 64 => |
| Read_Raw (Obj.Symtab_Stream, ST_Entry64'Address, |
| uint32 (ST_Entry64'Size / SSU)); |
| Res := (Off, |
| Off + ST_Entry64'Size / SSU, |
| ST_Entry64.St_Value, |
| ST_Entry64.St_Size); |
| |
| when others => |
| raise Program_Error; |
| end case; |
| |
| return Res; |
| end Read_Symbol; |
| |
| ---------- |
| -- Name -- |
| ---------- |
| |
| function Name |
| (Obj : in out ELF_Object_File; |
| Sec : Object_Section) return String |
| is |
| SHdr : Section_Header; |
| |
| begin |
| SHdr := Read_Section_Header (Obj, Sec.Num); |
| return Offset_To_String (Obj.Secstr_Stream, Offset (SHdr.Sh_Name)); |
| end Name; |
| |
| function Name |
| (Obj : in out ELF_Object_File; |
| Sym : Object_Symbol) return String_Ptr_Len |
| is |
| ST_Entry32 : Symtab_Entry32; |
| ST_Entry64 : Symtab_Entry64; |
| Name_Off : Offset; |
| |
| begin |
| -- Test that this symbol is not null |
| |
| if Sym = Null_Symbol then |
| return (null, 0); |
| end if; |
| |
| -- Read the symbol table entry |
| |
| Seek (Obj.Symtab_Stream, Sym.Off); |
| |
| case uword'Size is |
| when 32 => |
| Read_Raw (Obj.Symtab_Stream, ST_Entry32'Address, |
| uint32 (ST_Entry32'Size / SSU)); |
| Name_Off := Offset (ST_Entry32.St_Name); |
| |
| when 64 => |
| Read_Raw (Obj.Symtab_Stream, ST_Entry64'Address, |
| uint32 (ST_Entry64'Size / SSU)); |
| Name_Off := Offset (ST_Entry64.St_Name); |
| |
| when others => |
| raise Program_Error; |
| end case; |
| |
| -- Fetch the name from the string table |
| |
| Seek (Obj.Symstr_Stream, Name_Off); |
| return Read (Obj.Symstr_Stream); |
| end Name; |
| |
| end ELF_Ops; |
| |
| package ELF32_Ops is new ELF_Ops (uint32); |
| package ELF64_Ops is new ELF_Ops (uint64); |
| |
| ---------------- |
| -- PECOFF_Ops -- |
| ---------------- |
| |
| package body PECOFF_Ops is |
| |
| function Decode_Name |
| (Obj : in out PECOFF_Object_File; |
| Raw_Name : String) return String; |
| -- A section name is an 8 byte field padded on the right with null |
| -- characters, or a '\' followed by an ASCII decimal string indicating |
| -- an offset in to the string table. This routine decodes this |
| |
| function Get_Section_Virtual_Address |
| (Obj : in out PECOFF_Object_File; |
| Index : uint32) return uint64; |
| -- Fetch the address at which a section is loaded |
| |
| function Read_Section_Header |
| (Obj : in out PECOFF_Object_File; |
| Index : uint32) return Section_Header; |
| -- Read a header from section table |
| |
| function String_Table |
| (Obj : in out PECOFF_Object_File; |
| Index : Offset) return String; |
| -- Return an entry from the string table |
| |
| ----------------- |
| -- Decode_Name -- |
| ----------------- |
| |
| function Decode_Name |
| (Obj : in out PECOFF_Object_File; |
| Raw_Name : String) return String |
| is |
| Name_Or_Ref : constant String := Trim_Trailing_Nuls (Raw_Name); |
| Off : Offset; |
| |
| begin |
| -- We should never find a symbol with a zero length name. If we do it |
| -- probably means we are not parsing the symbol table correctly. If |
| -- this happens we raise a fatal error. |
| |
| if Name_Or_Ref'Length = 0 then |
| raise Format_Error with |
| "found zero length symbol in symbol table"; |
| end if; |
| |
| if Name_Or_Ref (1) /= '/' then |
| return Name_Or_Ref; |
| else |
| Off := Offset'Value (Name_Or_Ref (2 .. Name_Or_Ref'Last)); |
| return String_Table (Obj, Off); |
| end if; |
| end Decode_Name; |
| |
| ------------------ |
| -- First_Symbol -- |
| ------------------ |
| |
| function First_Symbol |
| (Obj : in out PECOFF_Object_File) return Object_Symbol |
| is |
| begin |
| -- Return Null_Symbol in the case that the symbol table is empty |
| |
| if Obj.Symtab_Last = 0 then |
| return Null_Symbol; |
| end if; |
| |
| return Read_Symbol (Obj, 0); |
| end First_Symbol; |
| |
| ----------------- |
| -- Get_Section -- |
| ----------------- |
| |
| function Get_Section |
| (Obj : in out PECOFF_Object_File; |
| Index : uint32) return Object_Section |
| is |
| Sec : constant Section_Header := Read_Section_Header (Obj, Index); |
| |
| begin |
| -- Use VirtualSize instead of SizeOfRawData. The latter is rounded to |
| -- the page size, so it may add garbage to the content. On the other |
| -- side, the former may be larger than the latter in case of 0 |
| -- padding. |
| |
| return (Index, |
| Offset (Sec.PointerToRawData), |
| uint64 (Sec.VirtualAddress) + Obj.ImageBase, |
| uint64 (Sec.VirtualSize), |
| (Sec.Characteristics and IMAGE_SCN_CNT_CODE) /= 0); |
| end Get_Section; |
| |
| --------------------------------- |
| -- Get_Section_Virtual_Address -- |
| --------------------------------- |
| |
| function Get_Section_Virtual_Address |
| (Obj : in out PECOFF_Object_File; |
| Index : uint32) return uint64 |
| is |
| Sec : Section_Header; |
| |
| begin |
| -- Try cache |
| |
| if Index = Obj.GSVA_Sec then |
| return Obj.GSVA_Addr; |
| end if; |
| |
| Obj.GSVA_Sec := Index; |
| Sec := Read_Section_Header (Obj, Index); |
| Obj.GSVA_Addr := Obj.ImageBase + uint64 (Sec.VirtualAddress); |
| return Obj.GSVA_Addr; |
| end Get_Section_Virtual_Address; |
| |
| ---------------- |
| -- Initialize -- |
| ---------------- |
| |
| function Initialize |
| (F : Mapped_File; |
| Hdr : Header; |
| In_Exception : Boolean) return PECOFF_Object_File |
| is |
| Res : PECOFF_Object_File |
| (Format => (case Hdr.Variant is |
| when PECOFF_Ops.VARIANT_PE32 => PECOFF, |
| when PECOFF_Ops.VARIANT_PE32_PLUS => PECOFF_PLUS, |
| when others => raise Program_Error |
| with "unrecognized PECOFF variant")); |
| Symtab_Size : constant Offset := |
| Offset (Hdr.NumberOfSymbols) * (Symtab_Entry'Size / SSU); |
| Strtab_Size : uint32; |
| Hdr_Offset : Offset; |
| Opt_Offset : File_Size; |
| Opt_Stream : Mapped_Stream; |
| |
| begin |
| Res.MF := F; |
| Res.In_Exception := In_Exception; |
| |
| case Hdr.Machine is |
| when PECOFF_Ops.IMAGE_FILE_MACHINE_I386 => |
| Res.Arch := i386; |
| when PECOFF_Ops.IMAGE_FILE_MACHINE_IA64 => |
| Res.Arch := IA64; |
| when PECOFF_Ops.IMAGE_FILE_MACHINE_AMD64 => |
| Res.Arch := x86_64; |
| when others => |
| raise Format_Error with "unrecognized architecture"; |
| end case; |
| |
| Res.Num_Sections := uint32 (Hdr.NumberOfSections); |
| |
| -- Map symbol table and the first following word (which is the length |
| -- of the string table). |
| |
| Res.Symtab_Last := Symtab_Size; |
| Res.Symtab_Stream := Create_Stream |
| (F, |
| File_Size (Hdr.PointerToSymbolTable), |
| File_Size (Symtab_Size + 4)); |
| |
| -- Map string table. The first 4 bytes are the length of the string |
| -- table and are part of it. |
| |
| Seek (Res.Symtab_Stream, Symtab_Size); |
| Strtab_Size := Read (Res.Symtab_Stream); |
| Res.Symstr_Stream := Create_Stream |
| (F, |
| File_Size (Hdr.PointerToSymbolTable) + File_Size (Symtab_Size), |
| File_Size (Strtab_Size)); |
| |
| -- Map section table |
| |
| Opt_Stream := Create_Stream (Res.Mf, Signature_Loc_Offset, 4); |
| Hdr_Offset := Offset (uint32'(Read (Opt_Stream))); |
| Close (Opt_Stream); |
| Res.Sectab_Stream := Create_Stream |
| (F, |
| File_Size (Hdr_Offset + |
| Size_Of_Standard_Header_Fields + |
| Offset (Hdr.SizeOfOptionalHeader)), |
| File_Size (Res.Num_Sections) |
| * File_Size (Section_Header'Size / SSU)); |
| |
| -- Read optional header and extract image base |
| |
| Opt_Offset := File_Size (Hdr_Offset + Size_Of_Standard_Header_Fields); |
| |
| if Res.Format = PECOFF then |
| declare |
| Opt_32 : Optional_Header_PE32; |
| begin |
| Opt_Stream := Create_Stream |
| (Res.Mf, Opt_Offset, Opt_32'Size / SSU); |
| Read_Raw |
| (Opt_Stream, Opt_32'Address, uint32 (Opt_32'Size / SSU)); |
| Res.ImageBase := uint64 (Opt_32.ImageBase); |
| Close (Opt_Stream); |
| end; |
| |
| else |
| declare |
| Opt_64 : Optional_Header_PE64; |
| begin |
| Opt_Stream := Create_Stream |
| (Res.Mf, Opt_Offset, Opt_64'Size / SSU); |
| Read_Raw |
| (Opt_Stream, Opt_64'Address, uint32 (Opt_64'Size / SSU)); |
| Res.ImageBase := Opt_64.ImageBase; |
| Close (Opt_Stream); |
| end; |
| end if; |
| |
| return Res; |
| end Initialize; |
| |
| ----------------- |
| -- Read_Symbol -- |
| ----------------- |
| |
| function Read_Symbol |
| (Obj : in out PECOFF_Object_File; |
| Off : Offset) return Object_Symbol |
| is |
| ST_Entry : Symtab_Entry; |
| ST_Last : Symtab_Entry; |
| Aux_Entry : Auxent_Section; |
| Sz : constant Offset := ST_Entry'Size / SSU; |
| Result : Object_Symbol; |
| Noff : Offset; |
| Sym_Off : Offset; |
| |
| begin |
| -- Seek to the successor of Prev |
| |
| Noff := Off; |
| |
| loop |
| Sym_Off := Noff; |
| |
| Seek (Obj.Symtab_Stream, Sym_Off); |
| Read_Raw (Obj.Symtab_Stream, ST_Entry'Address, uint32 (Sz)); |
| |
| -- Skip AUX entries |
| |
| Noff := Noff + Offset (1 + ST_Entry.NumberOfAuxSymbols) * Sz; |
| |
| exit when ST_Entry.TypeField = Function_Symbol_Type |
| and then ST_Entry.SectionNumber > 0; |
| |
| if Noff >= Obj.Symtab_Last then |
| return Null_Symbol; |
| end if; |
| end loop; |
| |
| -- Construct the symbol |
| |
| Result := |
| (Off => Sym_Off, |
| Next => Noff, |
| Value => uint64 (ST_Entry.Value), |
| Size => 0); |
| |
| -- Set the size as accurately as possible |
| |
| -- The size of a symbol is not directly available so we try scanning |
| -- to the next function and assuming the code ends there. |
| |
| loop |
| -- Read symbol and AUX entries |
| |
| Sym_Off := Noff; |
| Seek (Obj.Symtab_Stream, Sym_Off); |
| Read_Raw (Obj.Symtab_Stream, ST_Last'Address, uint32 (Sz)); |
| |
| for I in 1 .. ST_Last.NumberOfAuxSymbols loop |
| Read_Raw (Obj.Symtab_Stream, Aux_Entry'Address, uint32 (Sz)); |
| end loop; |
| |
| Noff := Noff + Offset (1 + ST_Last.NumberOfAuxSymbols) * Sz; |
| |
| if ST_Last.TypeField = Function_Symbol_Type then |
| if ST_Last.SectionNumber = ST_Entry.SectionNumber |
| and then ST_Last.Value >= ST_Entry.Value |
| then |
| -- Symbol is a function past ST_Entry |
| |
| Result.Size := uint64 (ST_Last.Value - ST_Entry.Value); |
| |
| else |
| -- Not correlated function |
| |
| Result.Next := Sym_Off; |
| end if; |
| |
| exit; |
| |
| elsif ST_Last.SectionNumber = ST_Entry.SectionNumber |
| and then ST_Last.TypeField = Not_Function_Symbol_Type |
| and then ST_Last.StorageClass = 3 |
| and then ST_Last.NumberOfAuxSymbols = 1 |
| then |
| -- Symbol is a section |
| |
| Result.Size := uint64 (ST_Last.Value + Aux_Entry.Length |
| - ST_Entry.Value); |
| Result.Next := Noff; |
| exit; |
| end if; |
| |
| exit when Noff >= Obj.Symtab_Last; |
| end loop; |
| |
| -- Relocate the address |
| |
| Result.Value := |
| Result.Value + Get_Section_Virtual_Address |
| (Obj, uint32 (ST_Entry.SectionNumber - 1)); |
| |
| return Result; |
| end Read_Symbol; |
| |
| ------------------ |
| -- Read_Header -- |
| ------------------ |
| |
| function Read_Header (F : in out Mapped_Stream) return Header is |
| Hdr : Header; |
| Off : int32; |
| |
| begin |
| -- Skip the MSDOS stub, and seek directly to the file offset |
| |
| Seek (F, Signature_Loc_Offset); |
| Off := Read (F); |
| |
| -- Read the COFF file header |
| |
| Seek (F, Offset (Off)); |
| Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU)); |
| return Hdr; |
| end Read_Header; |
| |
| ------------------------- |
| -- Read_Section_Header -- |
| ------------------------- |
| |
| function Read_Section_Header |
| (Obj : in out PECOFF_Object_File; |
| Index : uint32) return Section_Header |
| is |
| Sec : Section_Header; |
| begin |
| Seek (Obj.Sectab_Stream, Offset (Index * Section_Header'Size / SSU)); |
| Read_Raw (Obj.Sectab_Stream, Sec'Address, Section_Header'Size / SSU); |
| return Sec; |
| end Read_Section_Header; |
| |
| ---------- |
| -- Name -- |
| ---------- |
| |
| function Name |
| (Obj : in out PECOFF_Object_File; |
| Sec : Object_Section) return String |
| is |
| Shdr : constant Section_Header := Read_Section_Header (Obj, Sec.Num); |
| begin |
| return Decode_Name (Obj, Shdr.Name); |
| end Name; |
| |
| ------------------- |
| -- String_Table -- |
| ------------------- |
| |
| function String_Table |
| (Obj : in out PECOFF_Object_File; |
| Index : Offset) return String |
| is |
| begin |
| -- An index of zero is used to represent an empty string, as the |
| -- first word of the string table is specified to contain the length |
| -- of the table rather than its contents. |
| |
| if Index = 0 then |
| return ""; |
| |
| else |
| return Offset_To_String (Obj.Symstr_Stream, Index); |
| end if; |
| end String_Table; |
| |
| ---------- |
| -- Name -- |
| ---------- |
| |
| function Name |
| (Obj : in out PECOFF_Object_File; |
| Sym : Object_Symbol) return String_Ptr_Len |
| is |
| ST_Entry : Symtab_Entry; |
| |
| begin |
| Seek (Obj.Symtab_Stream, Sym.Off); |
| Read_Raw (Obj.Symtab_Stream, ST_Entry'Address, ST_Entry'Size / SSU); |
| |
| declare |
| -- Symbol table entries are packed and Table_Entry.Name may not be |
| -- sufficiently aligned to interpret as a 32 bit word, so it is |
| -- copied to a temporary |
| |
| Aligned_Name : Name_Str := ST_Entry.Name; |
| for Aligned_Name'Alignment use 4; |
| |
| First_Word : uint32; |
| pragma Import (Ada, First_Word); |
| -- Suppress initialization in Normalized_Scalars mode |
| for First_Word'Address use Aligned_Name (1)'Address; |
| |
| Second_Word : uint32; |
| pragma Import (Ada, Second_Word); |
| -- Suppress initialization in Normalized_Scalars mode |
| for Second_Word'Address use Aligned_Name (5)'Address; |
| |
| begin |
| if First_Word = 0 then |
| -- Second word is an offset in the symbol table |
| if Second_Word = 0 then |
| return (null, 0); |
| else |
| Seek (Obj.Symstr_Stream, int64 (Second_Word)); |
| return Read (Obj.Symstr_Stream); |
| end if; |
| else |
| -- Inlined symbol name |
| Seek (Obj.Symtab_Stream, Sym.Off); |
| return To_String_Ptr_Len (Read (Obj.Symtab_Stream), 8); |
| end if; |
| end; |
| end Name; |
| |
| end PECOFF_Ops; |
| |
| ----------------- |
| -- XCOFF32_Ops -- |
| ----------------- |
| |
| package body XCOFF32_Ops is |
| |
| function Read_Section_Header |
| (Obj : in out XCOFF32_Object_File; |
| Index : uint32) return Section_Header; |
| -- Read a header from section table |
| |
| ----------------- |
| -- Read_Symbol -- |
| ----------------- |
| |
| function Read_Symbol |
| (Obj : in out XCOFF32_Object_File; |
| Off : Offset) return Object_Symbol |
| is |
| Sym : Symbol_Entry; |
| Sz : constant Offset := Symbol_Entry'Size / SSU; |
| Aux : Aux_Entry; |
| Result : Object_Symbol; |
| Noff : Offset; |
| Sym_Off : Offset; |
| |
| procedure Read_LD_Symbol; |
| -- Read the next LD symbol |
| |
| -------------------- |
| -- Read_LD_Symbol -- |
| -------------------- |
| |
| procedure Read_LD_Symbol is |
| begin |
| loop |
| Sym_Off := Noff; |
| |
| Read_Raw (Obj.Symtab_Stream, Sym'Address, uint32 (Sz)); |
| |
| Noff := Noff + Offset (1 + Sym.n_numaux) * Sz; |
| |
| for J in 1 .. Sym.n_numaux loop |
| Read_Raw (Obj.Symtab_Stream, Aux'Address, uint32 (Sz)); |
| end loop; |
| |
| exit when Noff >= Obj.Symtab_Last; |
| |
| exit when Sym.n_numaux = 1 |
| and then Sym.n_scnum /= 0 |
| and then (Sym.n_sclass = C_EXT |
| or else Sym.n_sclass = C_HIDEXT |
| or else Sym.n_sclass = C_WEAKEXT) |
| and then Aux.x_smtyp = XTY_LD; |
| end loop; |
| end Read_LD_Symbol; |
| |
| -- Start of processing for Read_Symbol |
| |
| begin |
| Seek (Obj.Symtab_Stream, Off); |
| Noff := Off; |
| Read_LD_Symbol; |
| |
| if Noff >= Obj.Symtab_Last then |
| return Null_Symbol; |
| end if; |
| |
| -- Construct the symbol |
| |
| Result := (Off => Sym_Off, |
| Next => Noff, |
| Value => uint64 (Sym.n_value), |
| Size => 0); |
| |
| -- Look for the next symbol to compute the size |
| |
| Read_LD_Symbol; |
| |
| if Noff >= Obj.Symtab_Last then |
| return Null_Symbol; |
| end if; |
| |
| Result.Size := uint64 (Sym.n_value) - Result.Value; |
| Result.Next := Sym_Off; |
| return Result; |
| end Read_Symbol; |
| |
| ------------------ |
| -- First_Symbol -- |
| ------------------ |
| |
| function First_Symbol |
| (Obj : in out XCOFF32_Object_File) return Object_Symbol |
| is |
| begin |
| -- Return Null_Symbol in the case that the symbol table is empty |
| |
| if Obj.Symtab_Last = 0 then |
| return Null_Symbol; |
| end if; |
| |
| return Read_Symbol (Obj, 0); |
| end First_Symbol; |
| |
| ---------------- |
| -- Initialize -- |
| ---------------- |
| |
| function Initialize |
| (F : Mapped_File; |
| Hdr : Header; |
| In_Exception : Boolean) return XCOFF32_Object_File |
| is |
| Res : XCOFF32_Object_File (Format => XCOFF32); |
| Strtab_Sz : uint32; |
| |
| begin |
| Res.Mf := F; |
| Res.In_Exception := In_Exception; |
| |
| Res.Arch := PPC; |
| |
| -- Map sections table |
| Res.Num_Sections := uint32 (Hdr.f_nscns); |
| Res.Sectab_Stream := Create_Stream |
| (F, |
| File_Size (Header'Size / SSU) + File_Size (Hdr.f_opthdr), |
| File_Size (Hdr.f_nscns) * (Section_Header'Size / SSU)); |
| |
| -- Map symbols table |
| Res.Symtab_Last := Offset (Hdr.f_nscns) * (Symbol_Entry'Size / SSU); |
| Res.Symtab_Stream := Create_Stream |
| (F, |
| File_Size (Hdr.f_symptr), |
| File_Size (Res.Symtab_Last) + 4); |
| |
| -- Map string table |
| Seek (Res.Symtab_Stream, Res.Symtab_Last); |
| Strtab_Sz := Read (Res.Symtab_Stream); |
| Res.Symstr_Stream := Create_Stream |
| (F, |
| File_Size (Res.Symtab_Last) + 4, |
| File_Size (Strtab_Sz) - 4); |
| |
| return Res; |
| end Initialize; |
| |
| ----------------- |
| -- Get_Section -- |
| ----------------- |
| |
| function Get_Section |
| (Obj : in out XCOFF32_Object_File; |
| Index : uint32) return Object_Section |
| is |
| Sec : constant Section_Header := Read_Section_Header (Obj, Index); |
| |
| begin |
| return (Index, Offset (Sec.s_scnptr), |
| uint64 (Sec.s_vaddr), |
| uint64 (Sec.s_size), |
| (Sec.s_flags and STYP_TEXT) /= 0); |
| end Get_Section; |
| |
| ----------------- |
| -- Read_Header -- |
| ----------------- |
| |
| function Read_Header (F : in out Mapped_Stream) return Header is |
| Hdr : Header; |
| |
| begin |
| Seek (F, 0); |
| Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU)); |
| return Hdr; |
| end Read_Header; |
| |
| ------------------------- |
| -- Read_Section_Header -- |
| ------------------------- |
| |
| function Read_Section_Header |
| (Obj : in out XCOFF32_Object_File; |
| Index : uint32) return Section_Header |
| is |
| Sec : Section_Header; |
| |
| begin |
| -- Seek to the end of the object header |
| |
| Seek (Obj.Sectab_Stream, Offset (Index * Section_Header'Size / SSU)); |
| |
| -- Read the section |
| |
| Read_Raw (Obj.Sectab_Stream, Sec'Address, Section_Header'Size / SSU); |
| |
| return Sec; |
| end Read_Section_Header; |
| |
| ---------- |
| -- Name -- |
| ---------- |
| |
| function Name |
| (Obj : in out XCOFF32_Object_File; |
| Sec : Object_Section) return String |
| is |
| Hdr : Section_Header; |
| |
| begin |
| Hdr := Read_Section_Header (Obj, Sec.Num); |
| return Trim_Trailing_Nuls (Hdr.s_name); |
| end Name; |
| |
| ---------- |
| -- Name -- |
| ---------- |
| |
| function Name |
| (Obj : in out XCOFF32_Object_File; |
| Sym : Object_Symbol) return String_Ptr_Len |
| is |
| Symbol : Symbol_Entry; |
| |
| begin |
| Seek (Obj.Symtab_Stream, Sym.Off); |
| Read_Raw (Obj.Symtab_Stream, Symbol'Address, Symbol'Size / SSU); |
| |
| declare |
| First_Word : uint32; |
| pragma Import (Ada, First_Word); |
| -- Suppress initialization in Normalized_Scalars mode |
| for First_Word'Address use Symbol.n_name (1)'Address; |
| |
| Second_Word : uint32; |
| pragma Import (Ada, Second_Word); |
| -- Suppress initialization in Normalized_Scalars mode |
| for Second_Word'Address use Symbol.n_name (5)'Address; |
| |
| begin |
| if First_Word = 0 then |
| if Second_Word = 0 then |
| return (null, 0); |
| else |
| Seek (Obj.Symstr_Stream, int64 (Second_Word)); |
| return Read (Obj.Symstr_Stream); |
| end if; |
| else |
| Seek (Obj.Symtab_Stream, Sym.Off); |
| return To_String_Ptr_Len (Read (Obj.Symstr_Stream), 8); |
| end if; |
| end; |
| end Name; |
| end XCOFF32_Ops; |
| |
| ---------- |
| -- Arch -- |
| ---------- |
| |
| function Arch (Obj : Object_File) return Object_Arch is |
| begin |
| return Obj.Arch; |
| end Arch; |
| |
| function Create_Stream |
| (Mf : Mapped_File; |
| File_Offset : File_Size; |
| File_Length : File_Size) |
| return Mapped_Stream |
| is |
| Region : Mapped_Region; |
| begin |
| Read (Mf, Region, File_Offset, File_Length, False); |
| return (Region, 0, Offset (File_Length)); |
| end Create_Stream; |
| |
| function Create_Stream |
| (Obj : Object_File; |
| Sec : Object_Section) return Mapped_Stream |
| is |
| begin |
| return Create_Stream (Obj.Mf, File_Size (Sec.Off), File_Size (Sec.Size)); |
| end Create_Stream; |
| |
| procedure Tell (Obj : in out Mapped_Stream; Off : out Offset) is |
| begin |
| Off := Obj.Off; |
| end Tell; |
| |
| function Tell (Obj : Mapped_Stream) return Offset is |
| begin |
| return Obj.Off; |
| end Tell; |
| |
| function Length (Obj : Mapped_Stream) return Offset is |
| begin |
| return Obj.Len; |
| end Length; |
| |
| ----------- |
| -- Close -- |
| ----------- |
| |
| procedure Close (S : in out Mapped_Stream) is |
| begin |
| Free (S.Region); |
| end Close; |
| |
| procedure Close (Obj : in out Object_File) is |
| begin |
| Close (Obj.Symtab_Stream); |
| Close (Obj.Symstr_Stream); |
| Close (Obj.Sectab_Stream); |
| |
| case Obj.Format is |
| when ELF => |
| Close (Obj.Secstr_Stream); |
| when Any_PECOFF => |
| null; |
| when XCOFF32 => |
| null; |
| end case; |
| |
| Close (Obj.Mf); |
| end Close; |
| |
| ------------------------ |
| -- Strip_Leading_Char -- |
| ------------------------ |
| |
| function Strip_Leading_Char |
| (Obj : in out Object_File; |
| Sym : String_Ptr_Len) return Positive |
| is |
| begin |
| if (Obj.Format = PECOFF and then Sym.Ptr (1) = '_') |
| or else |
| (Obj.Format = XCOFF32 and then Sym.Ptr (1) = '.') |
| then |
| return 2; |
| else |
| return 1; |
| end if; |
| end Strip_Leading_Char; |
| |
| ---------------------- |
| -- Decoded_Ada_Name -- |
| ---------------------- |
| |
| function Decoded_Ada_Name |
| (Obj : in out Object_File; |
| Sym : String_Ptr_Len) return String |
| is |
| procedure gnat_decode |
| (Coded_Name_Addr : Address; |
| Ada_Name_Addr : Address; |
| Verbose : int); |
| pragma Import (C, gnat_decode, "__gnat_decode"); |
| |
| subtype size_t is Interfaces.C.size_t; |
| |
| Sym_Name : constant String := |
| String (Sym.Ptr (1 .. Sym.Len)) & ASCII.NUL; |
| Decoded : char_array (0 .. size_t (Sym.Len) * 2 + 60); |
| Off : Natural; |
| |
| begin |
| -- In the PECOFF case most but not all symbol table entries have an |
| -- extra leading underscore. In this case we trim it. |
| |
| Off := Strip_Leading_Char (Obj, Sym); |
| |
| gnat_decode (Sym_Name (Off)'Address, Decoded'Address, 0); |
| |
| return To_Ada (Decoded); |
| end Decoded_Ada_Name; |
| |
| ------------------ |
| -- First_Symbol -- |
| ------------------ |
| |
| function First_Symbol (Obj : in out Object_File) return Object_Symbol is |
| begin |
| case Obj.Format is |
| when ELF32 => return ELF32_Ops.First_Symbol (Obj); |
| when ELF64 => return ELF64_Ops.First_Symbol (Obj); |
| when Any_PECOFF => return PECOFF_Ops.First_Symbol (Obj); |
| when XCOFF32 => return XCOFF32_Ops.First_Symbol (Obj); |
| end case; |
| end First_Symbol; |
| |
| ------------ |
| -- Format -- |
| ------------ |
| |
| function Format (Obj : Object_File) return Object_Format is |
| begin |
| return Obj.Format; |
| end Format; |
| |
| ---------------------- |
| -- Get_Load_Address -- |
| ---------------------- |
| |
| function Get_Load_Address (Obj : Object_File) return uint64 is |
| begin |
| case Obj.Format is |
| when ELF => return 0; |
| when Any_PECOFF => return Obj.ImageBase; |
| when XCOFF32 => raise Format_Error; |
| end case; |
| end Get_Load_Address; |
| |
| ----------------- |
| -- Get_Section -- |
| ----------------- |
| |
| function Get_Section |
| (Obj : in out Object_File; |
| Shnum : uint32) return Object_Section |
| is |
| begin |
| case Obj.Format is |
| when ELF32 => return ELF32_Ops.Get_Section (Obj, Shnum); |
| when ELF64 => return ELF64_Ops.Get_Section (Obj, Shnum); |
| when Any_PECOFF => return PECOFF_Ops.Get_Section (Obj, Shnum); |
| when XCOFF32 => return XCOFF32_Ops.Get_Section (Obj, Shnum); |
| end case; |
| end Get_Section; |
| |
| function Get_Section |
| (Obj : in out Object_File; |
| Sec_Name : String) return Object_Section |
| is |
| Sec : Object_Section; |
| |
| begin |
| for J in 0 .. Obj.Num_Sections - 1 loop |
| Sec := Get_Section (Obj, J); |
| |
| if Name (Obj, Sec) = Sec_Name then |
| return Sec; |
| end if; |
| end loop; |
| |
| if Obj.In_Exception then |
| return Null_Section; |
| else |
| raise Format_Error with "could not find section in object file"; |
| end if; |
| end Get_Section; |
| |
| ---------------------- |
| -- Get_Xcode_Bounds -- |
| ---------------------- |
| |
| procedure Get_Xcode_Bounds |
| (Obj : in out Object_File; |
| Low, High : out uint64) |
| is |
| Sec : Object_Section; |
| |
| begin |
| -- First set as an empty range |
| Low := uint64'Last; |
| High := uint64'First; |
| |
| -- Now find the lowest and highest offsets |
| -- attached to executable code sections |
| for Idx in 1 .. Num_Sections (Obj) loop |
| Sec := Get_Section (Obj, Idx - 1); |
| if Sec.Flag_Xcode then |
| if Sec.Addr < Low then |
| Low := Sec.Addr; |
| end if; |
| if Sec.Addr + Sec.Size > High then |
| High := Sec.Addr + Sec.Size; |
| end if; |
| end if; |
| end loop; |
| end Get_Xcode_Bounds; |
| |
| ---------- |
| -- Name -- |
| ---------- |
| |
| function Name |
| (Obj : in out Object_File; |
| Sec : Object_Section) return String |
| is |
| begin |
| case Obj.Format is |
| when ELF32 => return ELF32_Ops.Name (Obj, Sec); |
| when ELF64 => return ELF64_Ops.Name (Obj, Sec); |
| when Any_PECOFF => return PECOFF_Ops.Name (Obj, Sec); |
| when XCOFF32 => return XCOFF32_Ops.Name (Obj, Sec); |
| end case; |
| end Name; |
| |
| function Name |
| (Obj : in out Object_File; |
| Sym : Object_Symbol) return String_Ptr_Len |
| is |
| begin |
| case Obj.Format is |
| when ELF32 => return ELF32_Ops.Name (Obj, Sym); |
| when ELF64 => return ELF64_Ops.Name (Obj, Sym); |
| when Any_PECOFF => return PECOFF_Ops.Name (Obj, Sym); |
| when XCOFF32 => return XCOFF32_Ops.Name (Obj, Sym); |
| end case; |
| end Name; |
| |
| ----------------- |
| -- Next_Symbol -- |
| ----------------- |
| |
| function Next_Symbol |
| (Obj : in out Object_File; |
| Prev : Object_Symbol) return Object_Symbol |
| is |
| begin |
| -- Test whether we've reached the end of the symbol table |
| |
| if Prev.Next >= Obj.Symtab_Last then |
| return Null_Symbol; |
| end if; |
| |
| return Read_Symbol (Obj, Prev.Next); |
| end Next_Symbol; |
| |
| --------- |
| -- Num -- |
| --------- |
| |
| function Num (Sec : Object_Section) return uint32 is |
| begin |
| return Sec.Num; |
| end Num; |
| |
| ------------------ |
| -- Num_Sections -- |
| ------------------ |
| |
| function Num_Sections (Obj : Object_File) return uint32 is |
| begin |
| return Obj.Num_Sections; |
| end Num_Sections; |
| |
| --------- |
| -- Off -- |
| --------- |
| |
| function Off (Sec : Object_Section) return Offset is |
| begin |
| return Sec.Off; |
| end Off; |
| |
| function Off (Sym : Object_Symbol) return Offset is |
| begin |
| return Sym.Off; |
| end Off; |
| |
| ---------------------- |
| -- Offset_To_String -- |
| ---------------------- |
| |
| function Offset_To_String |
| (S : in out Mapped_Stream; |
| Off : Offset) return String |
| is |
| Buf : Buffer; |
| |
| begin |
| Seek (S, Off); |
| Read_C_String (S, Buf); |
| return To_String (Buf); |
| end Offset_To_String; |
| |
| ---------- |
| -- Open -- |
| ---------- |
| |
| function Open |
| (File_Name : String; |
| In_Exception : Boolean := False) return Object_File_Access |
| is |
| F : Mapped_File; |
| Hdr_Stream : Mapped_Stream; |
| |
| begin |
| -- Open the file |
| |
| F := Open_Read_No_Exception (File_Name); |
| |
| if F = Invalid_Mapped_File then |
| if In_Exception then |
| return null; |
| else |
| raise IO_Error with "could not open object file"; |
| end if; |
| end if; |
| |
| Hdr_Stream := Create_Stream (F, 0, 4096); |
| |
| declare |
| Hdr : constant ELF32_Ops.Header := ELF32_Ops.Read_Header (Hdr_Stream); |
| |
| begin |
| -- Look for the magic numbers for the ELF case |
| |
| if Hdr.E_Ident (0) = 16#7F# and then |
| Hdr.E_Ident (1) = Character'Pos ('E') and then |
| Hdr.E_Ident (2) = Character'Pos ('L') and then |
| Hdr.E_Ident (3) = Character'Pos ('F') and then |
| Hdr.E_Ident (4) = ELF32_Ops.ELFCLASS32 |
| then |
| Close (Hdr_Stream); |
| return new Object_File' |
| (ELF32_Ops.Initialize (F, Hdr, In_Exception)); |
| end if; |
| end; |
| |
| declare |
| Hdr : constant ELF64_Ops.Header := |
| ELF64_Ops.Read_Header (Hdr_Stream); |
| |
| begin |
| -- Look for the magic numbers for the ELF case |
| |
| if Hdr.E_Ident (0) = 16#7F# and then |
| Hdr.E_Ident (1) = Character'Pos ('E') and then |
| Hdr.E_Ident (2) = Character'Pos ('L') and then |
| Hdr.E_Ident (3) = Character'Pos ('F') and then |
| Hdr.E_Ident (4) = ELF32_Ops.ELFCLASS64 |
| then |
| Close (Hdr_Stream); |
| return new Object_File' |
| (ELF64_Ops.Initialize (F, Hdr, In_Exception)); |
| end if; |
| end; |
| |
| declare |
| Hdr : constant PECOFF_Ops.Header := |
| PECOFF_Ops.Read_Header (Hdr_Stream); |
| |
| begin |
| -- Test the magic numbers |
| |
| if Hdr.Magics (0) = Character'Pos ('P') and then |
| Hdr.Magics (1) = Character'Pos ('E') and then |
| Hdr.Magics (2) = 0 and then |
| Hdr.Magics (3) = 0 |
| then |
| Close (Hdr_Stream); |
| return new Object_File' |
| (PECOFF_Ops.Initialize (F, Hdr, In_Exception)); |
| end if; |
| |
| exception |
| -- If this is not a PECOFF file then we've done a seek and read to a |
| -- random address, possibly raising IO_Error |
| |
| when IO_Error => |
| null; |
| end; |
| |
| declare |
| Hdr : constant XCOFF32_Ops.Header := |
| XCOFF32_Ops.Read_Header (Hdr_Stream); |
| |
| begin |
| -- Test the magic numbers |
| |
| if Hdr.f_magic = 8#0737# then |
| Close (Hdr_Stream); |
| return new Object_File' |
| (XCOFF32_Ops.Initialize (F, Hdr, In_Exception)); |
| end if; |
| end; |
| |
| Close (Hdr_Stream); |
| |
| if In_Exception then |
| return null; |
| else |
| raise Format_Error with "unrecognized object format"; |
| end if; |
| end Open; |
| |
| ---------- |
| -- Read -- |
| ---------- |
| |
| function Read (S : in out Mapped_Stream) return Mmap.Str_Access is |
| function To_Str_Access is |
| new Ada.Unchecked_Conversion (Address, Str_Access); |
| |
| begin |
| return To_Str_Access (Data (S.Region) (Natural (S.Off + 1))'Address); |
| end Read; |
| |
| function Read (S : in out Mapped_Stream) return String_Ptr_Len is |
| begin |
| return To_String_Ptr_Len (Read (S)); |
| end Read; |
| |
| procedure Check_Read_Offset (S : Mapped_Stream; Size : uint32) is |
| begin |
| if S.Off + Offset (Size) > Offset (Last (S.Region)) then |
| raise IO_Error with "could not read from object file"; |
| end if; |
| end Check_Read_Offset; |
| |
| procedure Read_Raw |
| (S : in out Mapped_Stream; |
| Addr : Address; |
| Size : uint32) |
| is |
| function To_Str_Access is |
| new Ada.Unchecked_Conversion (Address, Str_Access); |
| Sz : constant Offset := Offset (Size); |
| |
| begin |
| -- Check size |
| |
| pragma Debug (Check_Read_Offset (S, Size)); |
| |
| -- Copy data |
| |
| To_Str_Access (Addr) (1 .. Positive (Sz)) := |
| Data (S.Region) (Positive (S.Off + 1) .. Positive (S.Off + Sz)); |
| |
| -- Update offset |
| |
| S.Off := S.Off + Sz; |
| end Read_Raw; |
| |
| function Read (S : in out Mapped_Stream) return uint8 is |
| Data : uint8; |
| begin |
| Read_Raw (S, Data'Address, Data'Size / SSU); |
| return Data; |
| end Read; |
| |
| function Read (S : in out Mapped_Stream) return uint16 is |
| Data : uint16; |
| begin |
| Read_Raw (S, Data'Address, Data'Size / SSU); |
| return Data; |
| end Read; |
| |
| function Read (S : in out Mapped_Stream) return uint32 is |
| Data : uint32; |
| begin |
| Read_Raw (S, Data'Address, Data'Size / SSU); |
| return Data; |
| end Read; |
| |
| function Read (S : in out Mapped_Stream) return uint64 is |
| Data : uint64; |
| begin |
| Read_Raw (S, Data'Address, Data'Size / SSU); |
| return Data; |
| end Read; |
| |
| function Read (S : in out Mapped_Stream) return int8 is |
| Data : int8; |
| begin |
| Read_Raw (S, Data'Address, Data'Size / SSU); |
| return Data; |
| end Read; |
| |
| function Read (S : in out Mapped_Stream) return int16 is |
| Data : int16; |
| begin |
| Read_Raw (S, Data'Address, Data'Size / SSU); |
| return Data; |
| end Read; |
| |
| function Read (S : in out Mapped_Stream) return int32 is |
| Data : int32; |
| begin |
| Read_Raw (S, Data'Address, Data'Size / SSU); |
| return Data; |
| end Read; |
| |
| function Read (S : in out Mapped_Stream) return int64 is |
| Data : int64; |
| begin |
| Read_Raw (S, Data'Address, Data'Size / SSU); |
| return Data; |
| end Read; |
| |
| ------------------ |
| -- Read_Address -- |
| ------------------ |
| |
| function Read_Address |
| (Obj : Object_File; S : in out Mapped_Stream) return uint64 |
| is |
| Address_32 : uint32; |
| Address_64 : uint64; |
| |
| begin |
| case Obj.Arch is |
| when i386 |
| | MIPS |
| | PPC |
| | SPARC |
| | ARM |
| => |
| Address_32 := Read (S); |
| return uint64 (Address_32); |
| |
| when AARCH64 |
| | IA64 |
| | PPC64 |
| | SPARC64 |
| | x86_64 |
| => |
| Address_64 := Read (S); |
| return Address_64; |
| |
| when Unknown => |
| raise Format_Error with "unrecognized machine architecture"; |
| end case; |
| end Read_Address; |
| |
| ------------------- |
| -- Read_C_String -- |
| ------------------- |
| |
| procedure Read_C_String (S : in out Mapped_Stream; B : out Buffer) is |
| J : Integer := 0; |
| |
| begin |
| loop |
| -- Handle overflow case |
| |
| if J = B'Last then |
| B (J) := 0; |
| exit; |
| end if; |
| |
| B (J) := Read (S); |
| exit when B (J) = 0; |
| J := J + 1; |
| end loop; |
| end Read_C_String; |
| |
| ------------------- |
| -- Read_C_String -- |
| ------------------- |
| |
| function Read_C_String (S : in out Mapped_Stream) return Str_Access is |
| Res : constant Str_Access := Read (S); |
| |
| begin |
| for J in Res'Range loop |
| if S.Off + Offset (J - 1) > Offset (Last (S.Region)) then |
| raise IO_Error with "could not read from object file"; |
| end if; |
| |
| if Res (J) = ASCII.NUL then |
| S.Off := S.Off + Offset (J); |
| return Res; |
| end if; |
| end loop; |
| |
| -- Overflow case |
| raise Constraint_Error; |
| end Read_C_String; |
| |
| ----------------- |
| -- Read_LEB128 -- |
| ----------------- |
| |
| function Read_LEB128 (S : in out Mapped_Stream) return uint32 is |
| B : uint8; |
| Shift : Integer := 0; |
| Res : uint32 := 0; |
| |
| begin |
| loop |
| B := Read (S); |
| Res := Res or Shift_Left (uint32 (B and 16#7f#), Shift); |
| exit when (B and 16#80#) = 0; |
| Shift := Shift + 7; |
| end loop; |
| |
| return Res; |
| end Read_LEB128; |
| |
| function Read_LEB128 (S : in out Mapped_Stream) return int32 is |
| B : uint8; |
| Shift : Integer := 0; |
| Res : uint32 := 0; |
| |
| begin |
| loop |
| B := Read (S); |
| Res := Res or Shift_Left (uint32 (B and 16#7f#), Shift); |
| Shift := Shift + 7; |
| exit when (B and 16#80#) = 0; |
| end loop; |
| |
| if Shift < 32 and then (Res and Shift_Left (1, Shift - 1)) /= 0 then |
| Res := Res or Shift_Left (-1, Shift); |
| end if; |
| |
| return To_int32 (Res); |
| end Read_LEB128; |
| |
| ----------------- |
| -- Read_Symbol -- |
| ----------------- |
| |
| function Read_Symbol |
| (Obj : in out Object_File; |
| Off : Offset) return Object_Symbol |
| is |
| begin |
| case Obj.Format is |
| when ELF32 => return ELF32_Ops.Read_Symbol (Obj, Off); |
| when ELF64 => return ELF64_Ops.Read_Symbol (Obj, Off); |
| when Any_PECOFF => return PECOFF_Ops.Read_Symbol (Obj, Off); |
| when XCOFF32 => return XCOFF32_Ops.Read_Symbol (Obj, Off); |
| end case; |
| end Read_Symbol; |
| |
| ---------- |
| -- Seek -- |
| ---------- |
| |
| procedure Seek (S : in out Mapped_Stream; Off : Offset) is |
| begin |
| if Off < 0 or else Off > Offset (Last (S.Region)) then |
| raise IO_Error with "could not seek to offset in object file"; |
| end if; |
| |
| S.Off := Off; |
| end Seek; |
| |
| ---------- |
| -- Size -- |
| ---------- |
| |
| function Size (Sec : Object_Section) return uint64 is |
| begin |
| return Sec.Size; |
| end Size; |
| |
| function Size (Sym : Object_Symbol) return uint64 is |
| begin |
| return Sym.Size; |
| end Size; |
| |
| ------------ |
| -- Strlen -- |
| ------------ |
| |
| function Strlen (Buf : Buffer) return int32 is |
| begin |
| return int32 (CRTL.strlen (Buf'Address)); |
| end Strlen; |
| |
| ----------- |
| -- Spans -- |
| ----------- |
| |
| function Spans (Sym : Object_Symbol; Addr : uint64) return Boolean is |
| begin |
| return Addr >= Sym.Value and then Addr < Sym.Value + Sym.Size; |
| end Spans; |
| |
| --------------- |
| -- To_String -- |
| --------------- |
| |
| function To_String (Buf : Buffer) return String is |
| Result : String (1 .. Integer (CRTL.strlen (Buf'Address))); |
| for Result'Address use Buf'Address; |
| pragma Import (Ada, Result); |
| |
| begin |
| return Result; |
| end To_String; |
| |
| ----------------------- |
| -- To_String_Ptr_Len -- |
| ----------------------- |
| |
| function To_String_Ptr_Len |
| (Ptr : Mmap.Str_Access; |
| Max_Len : Natural := Natural'Last) return String_Ptr_Len |
| is |
| begin |
| for I in 1 .. Max_Len loop |
| if Ptr (I) = ASCII.NUL then |
| return (Ptr, I - 1); |
| end if; |
| end loop; |
| return (Ptr, Max_Len); |
| end To_String_Ptr_Len; |
| |
| ------------------------ |
| -- Trim_Trailing_Nuls -- |
| ------------------------ |
| |
| function Trim_Trailing_Nuls (Str : String) return String is |
| begin |
| for J in Str'Range loop |
| if Str (J) = ASCII.NUL then |
| return Str (Str'First .. J - 1); |
| end if; |
| end loop; |
| |
| return Str; |
| end Trim_Trailing_Nuls; |
| |
| ----------- |
| -- Value -- |
| ----------- |
| |
| function Value (Sym : Object_Symbol) return uint64 is |
| begin |
| return Sym.Value; |
| end Value; |
| |
| end System.Object_Reader; |
