1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S Y S T E M . O B J E C T _ R E A D E R -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2009-2019, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Unchecked_Conversion; 33 34with Interfaces.C; 35 36with System.CRTL; 37 38package body System.Object_Reader is 39 use Interfaces; 40 use Interfaces.C; 41 use System.Mmap; 42 43 SSU : constant := System.Storage_Unit; 44 45 function To_int32 is new Ada.Unchecked_Conversion (uint32, int32); 46 47 function Trim_Trailing_Nuls (Str : String) return String; 48 -- Return a copy of a string with any trailing NUL characters truncated 49 50 procedure Check_Read_Offset (S : in out Mapped_Stream; Size : uint32); 51 -- Check that the SIZE bytes at the current offset are still in the stream 52 53 ------------------------------------- 54 -- ELF object file format handling -- 55 ------------------------------------- 56 57 generic 58 type uword is mod <>; 59 60 package ELF_Ops is 61 62 -- ELF version codes 63 64 ELFCLASS32 : constant := 1; -- 32 bit ELF 65 ELFCLASS64 : constant := 2; -- 64 bit ELF 66 67 -- ELF machine codes 68 69 EM_NONE : constant := 0; -- No machine 70 EM_SPARC : constant := 2; -- SUN SPARC 71 EM_386 : constant := 3; -- Intel 80386 72 EM_MIPS : constant := 8; -- MIPS RS3000 Big-Endian 73 EM_MIPS_RS3_LE : constant := 10; -- MIPS RS3000 Little-Endian 74 EM_SPARC32PLUS : constant := 18; -- Sun SPARC 32+ 75 EM_PPC : constant := 20; -- PowerPC 76 EM_PPC64 : constant := 21; -- PowerPC 64-bit 77 EM_ARM : constant := 40; -- ARM 78 EM_SPARCV9 : constant := 43; -- SPARC v9 64-bit 79 EM_IA_64 : constant := 50; -- Intel Merced 80 EM_X86_64 : constant := 62; -- AMD x86-64 architecture 81 82 EN_NIDENT : constant := 16; 83 84 type E_Ident_Type is array (0 .. EN_NIDENT - 1) of uint8; 85 86 type Header is record 87 E_Ident : E_Ident_Type; -- Magic number and other info 88 E_Type : uint16; -- Object file type 89 E_Machine : uint16; -- Architecture 90 E_Version : uint32; -- Object file version 91 E_Entry : uword; -- Entry point virtual address 92 E_Phoff : uword; -- Program header table file offset 93 E_Shoff : uword; -- Section header table file offset 94 E_Flags : uint32; -- Processor-specific flags 95 E_Ehsize : uint16; -- ELF header size in bytes 96 E_Phentsize : uint16; -- Program header table entry size 97 E_Phnum : uint16; -- Program header table entry count 98 E_Shentsize : uint16; -- Section header table entry size 99 E_Shnum : uint16; -- Section header table entry count 100 E_Shstrndx : uint16; -- Section header string table index 101 end record; 102 103 type Section_Header is record 104 Sh_Name : uint32; -- Section name string table index 105 Sh_Type : uint32; -- Section type 106 Sh_Flags : uword; -- Section flags 107 Sh_Addr : uword; -- Section virtual addr at execution 108 Sh_Offset : uword; -- Section file offset 109 Sh_Size : uword; -- Section size in bytes 110 Sh_Link : uint32; -- Link to another section 111 Sh_Info : uint32; -- Additional section information 112 Sh_Addralign : uword; -- Section alignment 113 Sh_Entsize : uword; -- Entry size if section holds table 114 end record; 115 116 SHF_ALLOC : constant := 2; 117 SHF_EXECINSTR : constant := 4; 118 119 type Symtab_Entry32 is record 120 St_Name : uint32; -- Name (string table index) 121 St_Value : uint32; -- Value 122 St_Size : uint32; -- Size in bytes 123 St_Info : uint8; -- Type and binding attributes 124 St_Other : uint8; -- Undefined 125 St_Shndx : uint16; -- Defining section 126 end record; 127 128 type Symtab_Entry64 is record 129 St_Name : uint32; -- Name (string table index) 130 St_Info : uint8; -- Type and binding attributes 131 St_Other : uint8; -- Undefined 132 St_Shndx : uint16; -- Defining section 133 St_Value : uint64; -- Value 134 St_Size : uint64; -- Size in bytes 135 end record; 136 137 function Read_Header (F : in out Mapped_Stream) return Header; 138 -- Read a header from an ELF format object 139 140 function First_Symbol 141 (Obj : in out ELF_Object_File) return Object_Symbol; 142 -- Return the first element in the symbol table, or Null_Symbol if the 143 -- symbol table is empty. 144 145 function Read_Symbol 146 (Obj : in out ELF_Object_File; 147 Off : Offset) return Object_Symbol; 148 -- Read a symbol at offset Off 149 150 function Name 151 (Obj : in out ELF_Object_File; 152 Sym : Object_Symbol) return String_Ptr_Len; 153 -- Return the name of the symbol 154 155 function Name 156 (Obj : in out ELF_Object_File; 157 Sec : Object_Section) return String; 158 -- Return the name of a section 159 160 function Get_Section 161 (Obj : in out ELF_Object_File; 162 Shnum : uint32) return Object_Section; 163 -- Fetch a section by index from zero 164 165 function Initialize 166 (F : Mapped_File; 167 Hdr : Header; 168 In_Exception : Boolean) return ELF_Object_File; 169 -- Initialize an object file 170 171 end ELF_Ops; 172 173 ----------------------------------- 174 -- PECOFF object format handling -- 175 ----------------------------------- 176 177 package PECOFF_Ops is 178 179 -- Constants and data layout are taken from the document "Microsoft 180 -- Portable Executable and Common Object File Format Specification" 181 -- Revision 8.1. 182 183 Signature_Loc_Offset : constant := 16#3C#; 184 -- Offset of pointer to the file signature 185 186 Size_Of_Standard_Header_Fields : constant := 16#18#; 187 -- Length in bytes of the standard header record 188 189 Function_Symbol_Type : constant := 16#20#; 190 -- Type field value indicating a symbol refers to a function 191 192 Not_Function_Symbol_Type : constant := 16#00#; 193 -- Type field value indicating a symbol does not refer to a function 194 195 type Magic_Array is array (0 .. 3) of uint8; 196 -- Array of magic numbers from the header 197 198 -- Magic numbers for PECOFF variants 199 200 VARIANT_PE32 : constant := 16#010B#; 201 VARIANT_PE32_PLUS : constant := 16#020B#; 202 203 -- PECOFF machine codes 204 205 IMAGE_FILE_MACHINE_I386 : constant := 16#014C#; 206 IMAGE_FILE_MACHINE_IA64 : constant := 16#0200#; 207 IMAGE_FILE_MACHINE_AMD64 : constant := 16#8664#; 208 209 -- PECOFF Data layout 210 211 type Header is record 212 Magics : Magic_Array; 213 Machine : uint16; 214 NumberOfSections : uint16; 215 TimeDateStamp : uint32; 216 PointerToSymbolTable : uint32; 217 NumberOfSymbols : uint32; 218 SizeOfOptionalHeader : uint16; 219 Characteristics : uint16; 220 Variant : uint16; 221 end record; 222 223 pragma Pack (Header); 224 225 type Optional_Header_PE32 is record 226 Magic : uint16; 227 MajorLinkerVersion : uint8; 228 MinorLinkerVersion : uint8; 229 SizeOfCode : uint32; 230 SizeOfInitializedData : uint32; 231 SizeOfUninitializedData : uint32; 232 AddressOfEntryPoint : uint32; 233 BaseOfCode : uint32; 234 BaseOfData : uint32; -- Note: not in PE32+ 235 ImageBase : uint32; 236 SectionAlignment : uint32; 237 FileAlignment : uint32; 238 MajorOperatingSystemVersion : uint16; 239 MinorOperationSystemVersion : uint16; 240 MajorImageVersion : uint16; 241 MinorImageVersion : uint16; 242 MajorSubsystemVersion : uint16; 243 MinorSubsystemVersion : uint16; 244 Win32VersionValue : uint32; 245 SizeOfImage : uint32; 246 SizeOfHeaders : uint32; 247 Checksum : uint32; 248 Subsystem : uint16; 249 DllCharacteristics : uint16; 250 SizeOfStackReserve : uint32; 251 SizeOfStackCommit : uint32; 252 SizeOfHeapReserve : uint32; 253 SizeOfHeapCommit : uint32; 254 LoaderFlags : uint32; 255 NumberOfRvaAndSizes : uint32; 256 end record; 257 pragma Pack (Optional_Header_PE32); 258 pragma Assert (Optional_Header_PE32'Size = 96 * SSU); 259 260 type Optional_Header_PE64 is record 261 Magic : uint16; 262 MajorLinkerVersion : uint8; 263 MinorLinkerVersion : uint8; 264 SizeOfCode : uint32; 265 SizeOfInitializedData : uint32; 266 SizeOfUninitializedData : uint32; 267 AddressOfEntryPoint : uint32; 268 BaseOfCode : uint32; 269 ImageBase : uint64; 270 SectionAlignment : uint32; 271 FileAlignment : uint32; 272 MajorOperatingSystemVersion : uint16; 273 MinorOperationSystemVersion : uint16; 274 MajorImageVersion : uint16; 275 MinorImageVersion : uint16; 276 MajorSubsystemVersion : uint16; 277 MinorSubsystemVersion : uint16; 278 Win32VersionValue : uint32; 279 SizeOfImage : uint32; 280 SizeOfHeaders : uint32; 281 Checksum : uint32; 282 Subsystem : uint16; 283 DllCharacteristics : uint16; 284 SizeOfStackReserve : uint64; 285 SizeOfStackCommit : uint64; 286 SizeOfHeapReserve : uint64; 287 SizeOfHeapCommit : uint64; 288 LoaderFlags : uint32; 289 NumberOfRvaAndSizes : uint32; 290 end record; 291 pragma Pack (Optional_Header_PE64); 292 pragma Assert (Optional_Header_PE64'Size = 112 * SSU); 293 294 subtype Name_Str is String (1 .. 8); 295 296 type Section_Header is record 297 Name : Name_Str; 298 VirtualSize : uint32; 299 VirtualAddress : uint32; 300 SizeOfRawData : uint32; 301 PointerToRawData : uint32; 302 PointerToRelocations : uint32; 303 PointerToLinenumbers : uint32; 304 NumberOfRelocations : uint16; 305 NumberOfLinenumbers : uint16; 306 Characteristics : uint32; 307 end record; 308 309 pragma Pack (Section_Header); 310 311 IMAGE_SCN_CNT_CODE : constant := 16#0020#; 312 313 type Symtab_Entry is record 314 Name : Name_Str; 315 Value : uint32; 316 SectionNumber : int16; 317 TypeField : uint16; 318 StorageClass : uint8; 319 NumberOfAuxSymbols : uint8; 320 end record; 321 322 pragma Pack (Symtab_Entry); 323 324 type Auxent_Section is record 325 Length : uint32; 326 NumberOfRelocations : uint16; 327 NumberOfLinenumbers : uint16; 328 CheckSum : uint32; 329 Number : uint16; 330 Selection : uint8; 331 Unused1 : uint8; 332 Unused2 : uint8; 333 Unused3 : uint8; 334 end record; 335 336 for Auxent_Section'Size use 18 * 8; 337 338 function Read_Header (F : in out Mapped_Stream) return Header; 339 -- Read the object file header 340 341 function First_Symbol 342 (Obj : in out PECOFF_Object_File) return Object_Symbol; 343 -- Return the first element in the symbol table, or Null_Symbol if the 344 -- symbol table is empty. 345 346 function Read_Symbol 347 (Obj : in out PECOFF_Object_File; 348 Off : Offset) return Object_Symbol; 349 -- Read a symbol at offset Off 350 351 function Name 352 (Obj : in out PECOFF_Object_File; 353 Sym : Object_Symbol) return String_Ptr_Len; 354 -- Return the name of the symbol 355 356 function Name 357 (Obj : in out PECOFF_Object_File; 358 Sec : Object_Section) return String; 359 -- Return the name of a section 360 361 function Get_Section 362 (Obj : in out PECOFF_Object_File; 363 Index : uint32) return Object_Section; 364 -- Fetch a section by index from zero 365 366 function Initialize 367 (F : Mapped_File; 368 Hdr : Header; 369 In_Exception : Boolean) return PECOFF_Object_File; 370 -- Initialize an object file 371 372 end PECOFF_Ops; 373 374 ------------------------------------- 375 -- XCOFF-32 object format handling -- 376 ------------------------------------- 377 378 package XCOFF32_Ops is 379 380 -- XCOFF Data layout 381 382 type Header is record 383 f_magic : uint16; 384 f_nscns : uint16; 385 f_timdat : uint32; 386 f_symptr : uint32; 387 f_nsyms : uint32; 388 f_opthdr : uint16; 389 f_flags : uint16; 390 end record; 391 392 type Auxiliary_Header is record 393 o_mflag : uint16; 394 o_vstamp : uint16; 395 o_tsize : uint32; 396 o_dsize : uint32; 397 o_bsize : uint32; 398 o_entry : uint32; 399 o_text_start : uint32; 400 o_data_start : uint32; 401 o_toc : uint32; 402 o_snentry : uint16; 403 o_sntext : uint16; 404 o_sndata : uint16; 405 o_sntoc : uint16; 406 o_snloader : uint16; 407 o_snbss : uint16; 408 o_algntext : uint16; 409 o_algndata : uint16; 410 o_modtype : uint16; 411 o_cpuflag : uint8; 412 o_cputype : uint8; 413 o_maxstack : uint32; 414 o_maxdata : uint32; 415 o_debugger : uint32; 416 o_flags : uint8; 417 o_sntdata : uint16; 418 o_sntbss : uint16; 419 end record; 420 pragma Unreferenced (Auxiliary_Header); 421 -- Not used, but not removed (just in case) 422 423 subtype Name_Str is String (1 .. 8); 424 425 type Section_Header is record 426 s_name : Name_Str; 427 s_paddr : uint32; 428 s_vaddr : uint32; 429 s_size : uint32; 430 s_scnptr : uint32; 431 s_relptr : uint32; 432 s_lnnoptr : uint32; 433 s_nreloc : uint16; 434 s_nlnno : uint16; 435 s_flags : uint32; 436 end record; 437 438 pragma Pack (Section_Header); 439 440 STYP_TEXT : constant := 16#0020#; 441 442 type Symbol_Entry is record 443 n_name : Name_Str; 444 n_value : uint32; 445 n_scnum : uint16; 446 n_type : uint16; 447 n_sclass : uint8; 448 n_numaux : uint8; 449 end record; 450 for Symbol_Entry'Size use 18 * 8; 451 452 type Aux_Entry is record 453 x_scnlen : uint32; 454 x_parmhash : uint32; 455 x_snhash : uint16; 456 x_smtyp : uint8; 457 x_smclass : uint8; 458 x_stab : uint32; 459 x_snstab : uint16; 460 end record; 461 for Aux_Entry'Size use 18 * 8; 462 463 pragma Pack (Aux_Entry); 464 465 C_EXT : constant := 2; 466 C_HIDEXT : constant := 107; 467 C_WEAKEXT : constant := 111; 468 469 XTY_LD : constant := 2; 470 -- Magic constant should be documented, especially since it's changed??? 471 472 function Read_Header (F : in out Mapped_Stream) return Header; 473 -- Read the object file header 474 475 function First_Symbol 476 (Obj : in out XCOFF32_Object_File) return Object_Symbol; 477 -- Return the first element in the symbol table, or Null_Symbol if the 478 -- symbol table is empty. 479 480 function Read_Symbol 481 (Obj : in out XCOFF32_Object_File; 482 Off : Offset) return Object_Symbol; 483 -- Read a symbol at offset Off 484 485 function Name 486 (Obj : in out XCOFF32_Object_File; 487 Sym : Object_Symbol) return String_Ptr_Len; 488 -- Return the name of the symbol 489 490 function Name 491 (Obj : in out XCOFF32_Object_File; 492 Sec : Object_Section) return String; 493 -- Return the name of a section 494 495 function Initialize 496 (F : Mapped_File; 497 Hdr : Header; 498 In_Exception : Boolean) return XCOFF32_Object_File; 499 -- Initialize an object file 500 501 function Get_Section 502 (Obj : in out XCOFF32_Object_File; 503 Index : uint32) return Object_Section; 504 -- Fetch a section by index from zero 505 506 end XCOFF32_Ops; 507 508 ------------- 509 -- ELF_Ops -- 510 ------------- 511 512 package body ELF_Ops is 513 514 function Get_String_Table (Obj : in out ELF_Object_File) 515 return Object_Section; 516 -- Fetch the section containing the string table 517 518 function Get_Symbol_Table (Obj : in out ELF_Object_File) 519 return Object_Section; 520 -- Fetch the section containing the symbol table 521 522 function Read_Section_Header 523 (Obj : in out ELF_Object_File; 524 Shnum : uint32) return Section_Header; 525 -- Read the header for an ELF format object section indexed from zero 526 527 ------------------ 528 -- First_Symbol -- 529 ------------------ 530 531 function First_Symbol 532 (Obj : in out ELF_Object_File) return Object_Symbol 533 is 534 begin 535 if Obj.Symtab_Last = 0 then 536 return Null_Symbol; 537 else 538 return Read_Symbol (Obj, 0); 539 end if; 540 end First_Symbol; 541 542 ----------------- 543 -- Get_Section -- 544 ----------------- 545 546 function Get_Section 547 (Obj : in out ELF_Object_File; 548 Shnum : uint32) return Object_Section 549 is 550 SHdr : constant Section_Header := Read_Section_Header (Obj, Shnum); 551 begin 552 return (Shnum, 553 Offset (SHdr.Sh_Offset), 554 uint64 (SHdr.Sh_Addr), 555 uint64 (SHdr.Sh_Size), 556 (SHdr.Sh_Flags and SHF_EXECINSTR) /= 0); 557 end Get_Section; 558 559 ------------------------ 560 -- Get_String_Table -- 561 ------------------------ 562 563 function Get_String_Table 564 (Obj : in out ELF_Object_File) return Object_Section 565 is 566 begin 567 -- All cases except MIPS IRIX, string table located in .strtab 568 569 if Obj.Arch /= MIPS then 570 return Get_Section (Obj, ".strtab"); 571 572 -- On IRIX only .dynstr is available 573 574 else 575 return Get_Section (Obj, ".dynstr"); 576 end if; 577 end Get_String_Table; 578 579 ------------------------ 580 -- Get_Symbol_Table -- 581 ------------------------ 582 583 function Get_Symbol_Table 584 (Obj : in out ELF_Object_File) return Object_Section 585 is 586 begin 587 -- All cases except MIPS IRIX, symbol table located in .symtab 588 589 if Obj.Arch /= MIPS then 590 return Get_Section (Obj, ".symtab"); 591 592 -- On IRIX, symbol table located somewhere other than .symtab 593 594 else 595 return Get_Section (Obj, ".dynsym"); 596 end if; 597 end Get_Symbol_Table; 598 599 ---------------- 600 -- Initialize -- 601 ---------------- 602 603 function Initialize 604 (F : Mapped_File; 605 Hdr : Header; 606 In_Exception : Boolean) return ELF_Object_File 607 is 608 Res : ELF_Object_File 609 (Format => (case uword'Size is 610 when 64 => ELF64, 611 when 32 => ELF32, 612 when others => raise Program_Error)); 613 Sec : Object_Section; 614 begin 615 Res.MF := F; 616 Res.In_Exception := In_Exception; 617 Res.Num_Sections := uint32 (Hdr.E_Shnum); 618 619 case Hdr.E_Machine is 620 when EM_SPARC 621 | EM_SPARC32PLUS 622 => 623 Res.Arch := SPARC; 624 625 when EM_386 => 626 Res.Arch := i386; 627 628 when EM_MIPS 629 | EM_MIPS_RS3_LE 630 => 631 Res.Arch := MIPS; 632 633 when EM_PPC => 634 Res.Arch := PPC; 635 636 when EM_PPC64 => 637 Res.Arch := PPC64; 638 639 when EM_SPARCV9 => 640 Res.Arch := SPARC64; 641 642 when EM_IA_64 => 643 Res.Arch := IA64; 644 645 when EM_X86_64 => 646 Res.Arch := x86_64; 647 648 when others => 649 raise Format_Error with "unrecognized architecture"; 650 end case; 651 652 -- Map section table and section string table 653 Res.Sectab_Stream := Create_Stream 654 (F, File_Size (Hdr.E_Shoff), 655 File_Size (Hdr.E_Shnum) * File_Size (Hdr.E_Shentsize)); 656 Sec := Get_Section (Res, uint32 (Hdr.E_Shstrndx)); 657 Res.Secstr_Stream := Create_Stream (Res, Sec); 658 659 -- Map symbol and string table 660 Sec := Get_Symbol_Table (Res); 661 Res.Symtab_Stream := Create_Stream (Res, Sec); 662 Res.Symtab_Last := Offset (Sec.Size); 663 664 Sec := Get_String_Table (Res); 665 Res.Symstr_Stream := Create_Stream (Res, Sec); 666 667 return Res; 668 end Initialize; 669 670 ----------------- 671 -- Read_Header -- 672 ----------------- 673 674 function Read_Header (F : in out Mapped_Stream) return Header is 675 Hdr : Header; 676 begin 677 Seek (F, 0); 678 Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU)); 679 return Hdr; 680 end Read_Header; 681 682 ------------------------- 683 -- Read_Section_Header -- 684 ------------------------- 685 686 function Read_Section_Header 687 (Obj : in out ELF_Object_File; 688 Shnum : uint32) return Section_Header 689 is 690 Shdr : Section_Header; 691 begin 692 Seek (Obj.Sectab_Stream, Offset (Shnum * Section_Header'Size / SSU)); 693 Read_Raw (Obj.Sectab_Stream, Shdr'Address, Section_Header'Size / SSU); 694 return Shdr; 695 end Read_Section_Header; 696 697 ----------------- 698 -- Read_Symbol -- 699 ----------------- 700 701 function Read_Symbol 702 (Obj : in out ELF_Object_File; 703 Off : Offset) return Object_Symbol 704 is 705 ST_Entry32 : Symtab_Entry32; 706 ST_Entry64 : Symtab_Entry64; 707 Res : Object_Symbol; 708 709 begin 710 Seek (Obj.Symtab_Stream, Off); 711 712 case uword'Size is 713 when 32 => 714 Read_Raw (Obj.Symtab_Stream, ST_Entry32'Address, 715 uint32 (ST_Entry32'Size / SSU)); 716 Res := (Off, 717 Off + ST_Entry32'Size / SSU, 718 uint64 (ST_Entry32.St_Value), 719 uint64 (ST_Entry32.St_Size)); 720 721 when 64 => 722 Read_Raw (Obj.Symtab_Stream, ST_Entry64'Address, 723 uint32 (ST_Entry64'Size / SSU)); 724 Res := (Off, 725 Off + ST_Entry64'Size / SSU, 726 ST_Entry64.St_Value, 727 ST_Entry64.St_Size); 728 729 when others => 730 raise Program_Error; 731 end case; 732 733 return Res; 734 end Read_Symbol; 735 736 ---------- 737 -- Name -- 738 ---------- 739 740 function Name 741 (Obj : in out ELF_Object_File; 742 Sec : Object_Section) return String 743 is 744 SHdr : Section_Header; 745 begin 746 SHdr := Read_Section_Header (Obj, Sec.Num); 747 return Offset_To_String (Obj.Secstr_Stream, Offset (SHdr.Sh_Name)); 748 end Name; 749 750 function Name 751 (Obj : in out ELF_Object_File; 752 Sym : Object_Symbol) return String_Ptr_Len 753 is 754 ST_Entry32 : Symtab_Entry32; 755 ST_Entry64 : Symtab_Entry64; 756 Name_Off : Offset; 757 758 begin 759 -- Test that this symbol is not null 760 761 if Sym = Null_Symbol then 762 return (null, 0); 763 end if; 764 765 -- Read the symbol table entry 766 767 Seek (Obj.Symtab_Stream, Sym.Off); 768 769 case uword'Size is 770 when 32 => 771 Read_Raw (Obj.Symtab_Stream, ST_Entry32'Address, 772 uint32 (ST_Entry32'Size / SSU)); 773 Name_Off := Offset (ST_Entry32.St_Name); 774 775 when 64 => 776 Read_Raw (Obj.Symtab_Stream, ST_Entry64'Address, 777 uint32 (ST_Entry64'Size / SSU)); 778 Name_Off := Offset (ST_Entry64.St_Name); 779 780 when others => 781 raise Program_Error; 782 end case; 783 784 -- Fetch the name from the string table 785 786 Seek (Obj.Symstr_Stream, Name_Off); 787 return Read (Obj.Symstr_Stream); 788 end Name; 789 790 end ELF_Ops; 791 792 package ELF32_Ops is new ELF_Ops (uint32); 793 package ELF64_Ops is new ELF_Ops (uint64); 794 795 ---------------- 796 -- PECOFF_Ops -- 797 ---------------- 798 799 package body PECOFF_Ops is 800 801 function Decode_Name 802 (Obj : in out PECOFF_Object_File; 803 Raw_Name : String) return String; 804 -- A section name is an 8 byte field padded on the right with null 805 -- characters, or a '\' followed by an ASCII decimal string indicating 806 -- an offset in to the string table. This routine decodes this 807 808 function Get_Section_Virtual_Address 809 (Obj : in out PECOFF_Object_File; 810 Index : uint32) return uint64; 811 -- Fetch the address at which a section is loaded 812 813 function Read_Section_Header 814 (Obj : in out PECOFF_Object_File; 815 Index : uint32) return Section_Header; 816 -- Read a header from section table 817 818 function String_Table 819 (Obj : in out PECOFF_Object_File; 820 Index : Offset) return String; 821 -- Return an entry from the string table 822 823 ----------------- 824 -- Decode_Name -- 825 ----------------- 826 827 function Decode_Name 828 (Obj : in out PECOFF_Object_File; 829 Raw_Name : String) return String 830 is 831 Name_Or_Ref : constant String := Trim_Trailing_Nuls (Raw_Name); 832 Off : Offset; 833 834 begin 835 -- We should never find a symbol with a zero length name. If we do it 836 -- probably means we are not parsing the symbol table correctly. If 837 -- this happens we raise a fatal error. 838 839 if Name_Or_Ref'Length = 0 then 840 raise Format_Error with 841 "found zero length symbol in symbol table"; 842 end if; 843 844 if Name_Or_Ref (1) /= '/' then 845 return Name_Or_Ref; 846 else 847 Off := Offset'Value (Name_Or_Ref (2 .. Name_Or_Ref'Last)); 848 return String_Table (Obj, Off); 849 end if; 850 end Decode_Name; 851 852 ------------------ 853 -- First_Symbol -- 854 ------------------ 855 856 function First_Symbol 857 (Obj : in out PECOFF_Object_File) return Object_Symbol is 858 begin 859 -- Return Null_Symbol in the case that the symbol table is empty 860 861 if Obj.Symtab_Last = 0 then 862 return Null_Symbol; 863 end if; 864 865 return Read_Symbol (Obj, 0); 866 end First_Symbol; 867 868 ----------------- 869 -- Get_Section -- 870 ----------------- 871 872 function Get_Section 873 (Obj : in out PECOFF_Object_File; 874 Index : uint32) return Object_Section 875 is 876 Sec : constant Section_Header := Read_Section_Header (Obj, Index); 877 begin 878 -- Use VirtualSize instead of SizeOfRawData. The latter is rounded to 879 -- the page size, so it may add garbage to the content. On the other 880 -- side, the former may be larger than the latter in case of 0 881 -- padding. 882 883 return (Index, 884 Offset (Sec.PointerToRawData), 885 uint64 (Sec.VirtualAddress) + Obj.ImageBase, 886 uint64 (Sec.VirtualSize), 887 (Sec.Characteristics and IMAGE_SCN_CNT_CODE) /= 0); 888 end Get_Section; 889 890 --------------------------------- 891 -- Get_Section_Virtual_Address -- 892 --------------------------------- 893 894 function Get_Section_Virtual_Address 895 (Obj : in out PECOFF_Object_File; 896 Index : uint32) return uint64 897 is 898 Sec : Section_Header; 899 900 begin 901 -- Try cache 902 903 if Index = Obj.GSVA_Sec then 904 return Obj.GSVA_Addr; 905 end if; 906 907 Obj.GSVA_Sec := Index; 908 Sec := Read_Section_Header (Obj, Index); 909 Obj.GSVA_Addr := Obj.ImageBase + uint64 (Sec.VirtualAddress); 910 return Obj.GSVA_Addr; 911 end Get_Section_Virtual_Address; 912 913 ---------------- 914 -- Initialize -- 915 ---------------- 916 917 function Initialize 918 (F : Mapped_File; 919 Hdr : Header; 920 In_Exception : Boolean) return PECOFF_Object_File 921 is 922 Res : PECOFF_Object_File 923 (Format => (case Hdr.Variant is 924 when PECOFF_Ops.VARIANT_PE32 => PECOFF, 925 when PECOFF_Ops.VARIANT_PE32_PLUS => PECOFF_PLUS, 926 when others => raise Program_Error 927 with "unrecognized PECOFF variant")); 928 Symtab_Size : constant Offset := 929 Offset (Hdr.NumberOfSymbols) * (Symtab_Entry'Size / SSU); 930 Strtab_Size : uint32; 931 Hdr_Offset : Offset; 932 Opt_Offset : File_Size; 933 Opt_Stream : Mapped_Stream; 934 begin 935 Res.MF := F; 936 Res.In_Exception := In_Exception; 937 938 case Hdr.Machine is 939 when PECOFF_Ops.IMAGE_FILE_MACHINE_I386 => 940 Res.Arch := i386; 941 when PECOFF_Ops.IMAGE_FILE_MACHINE_IA64 => 942 Res.Arch := IA64; 943 when PECOFF_Ops.IMAGE_FILE_MACHINE_AMD64 => 944 Res.Arch := x86_64; 945 when others => 946 raise Format_Error with "unrecognized architecture"; 947 end case; 948 949 Res.Num_Sections := uint32 (Hdr.NumberOfSections); 950 951 -- Map symbol table and the first following word (which is the length 952 -- of the string table). 953 954 Res.Symtab_Last := Symtab_Size; 955 Res.Symtab_Stream := Create_Stream 956 (F, 957 File_Size (Hdr.PointerToSymbolTable), 958 File_Size (Symtab_Size + 4)); 959 960 -- Map string table. The first 4 bytes are the length of the string 961 -- table and are part of it. 962 963 Seek (Res.Symtab_Stream, Symtab_Size); 964 Strtab_Size := Read (Res.Symtab_Stream); 965 Res.Symstr_Stream := Create_Stream 966 (F, 967 File_Size (Hdr.PointerToSymbolTable) + File_Size (Symtab_Size), 968 File_Size (Strtab_Size)); 969 970 -- Map section table 971 972 Opt_Stream := Create_Stream (Res.Mf, Signature_Loc_Offset, 4); 973 Hdr_Offset := Offset (uint32'(Read (Opt_Stream))); 974 Close (Opt_Stream); 975 Res.Sectab_Stream := Create_Stream 976 (F, 977 File_Size (Hdr_Offset + 978 Size_Of_Standard_Header_Fields + 979 Offset (Hdr.SizeOfOptionalHeader)), 980 File_Size (Res.Num_Sections) 981 * File_Size (Section_Header'Size / SSU)); 982 983 -- Read optional header and extract image base 984 985 Opt_Offset := File_Size (Hdr_Offset + Size_Of_Standard_Header_Fields); 986 987 if Res.Format = PECOFF then 988 declare 989 Opt_32 : Optional_Header_PE32; 990 begin 991 Opt_Stream := Create_Stream 992 (Res.Mf, Opt_Offset, Opt_32'Size / SSU); 993 Read_Raw 994 (Opt_Stream, Opt_32'Address, uint32 (Opt_32'Size / SSU)); 995 Res.ImageBase := uint64 (Opt_32.ImageBase); 996 Close (Opt_Stream); 997 end; 998 999 else 1000 declare 1001 Opt_64 : Optional_Header_PE64; 1002 begin 1003 Opt_Stream := Create_Stream 1004 (Res.Mf, Opt_Offset, Opt_64'Size / SSU); 1005 Read_Raw 1006 (Opt_Stream, Opt_64'Address, uint32 (Opt_64'Size / SSU)); 1007 Res.ImageBase := Opt_64.ImageBase; 1008 Close (Opt_Stream); 1009 end; 1010 end if; 1011 1012 return Res; 1013 end Initialize; 1014 1015 ----------------- 1016 -- Read_Symbol -- 1017 ----------------- 1018 1019 function Read_Symbol 1020 (Obj : in out PECOFF_Object_File; 1021 Off : Offset) return Object_Symbol 1022 is 1023 ST_Entry : Symtab_Entry; 1024 ST_Last : Symtab_Entry; 1025 Aux_Entry : Auxent_Section; 1026 Sz : constant Offset := ST_Entry'Size / SSU; 1027 Result : Object_Symbol; 1028 Noff : Offset; 1029 Sym_Off : Offset; 1030 1031 begin 1032 -- Seek to the successor of Prev 1033 1034 Noff := Off; 1035 1036 loop 1037 Sym_Off := Noff; 1038 1039 Seek (Obj.Symtab_Stream, Sym_Off); 1040 Read_Raw (Obj.Symtab_Stream, ST_Entry'Address, uint32 (Sz)); 1041 1042 -- Skip AUX entries 1043 1044 Noff := Noff + Offset (1 + ST_Entry.NumberOfAuxSymbols) * Sz; 1045 1046 exit when ST_Entry.TypeField = Function_Symbol_Type 1047 and then ST_Entry.SectionNumber > 0; 1048 1049 if Noff >= Obj.Symtab_Last then 1050 return Null_Symbol; 1051 end if; 1052 end loop; 1053 1054 -- Construct the symbol 1055 1056 Result := 1057 (Off => Sym_Off, 1058 Next => Noff, 1059 Value => uint64 (ST_Entry.Value), 1060 Size => 0); 1061 1062 -- Set the size as accurately as possible 1063 1064 -- The size of a symbol is not directly available so we try scanning 1065 -- to the next function and assuming the code ends there. 1066 1067 loop 1068 -- Read symbol and AUX entries 1069 1070 Sym_Off := Noff; 1071 Seek (Obj.Symtab_Stream, Sym_Off); 1072 Read_Raw (Obj.Symtab_Stream, ST_Last'Address, uint32 (Sz)); 1073 1074 for I in 1 .. ST_Last.NumberOfAuxSymbols loop 1075 Read_Raw (Obj.Symtab_Stream, Aux_Entry'Address, uint32 (Sz)); 1076 end loop; 1077 1078 Noff := Noff + Offset (1 + ST_Last.NumberOfAuxSymbols) * Sz; 1079 1080 if ST_Last.TypeField = Function_Symbol_Type then 1081 if ST_Last.SectionNumber = ST_Entry.SectionNumber 1082 and then ST_Last.Value >= ST_Entry.Value 1083 then 1084 -- Symbol is a function past ST_Entry 1085 1086 Result.Size := uint64 (ST_Last.Value - ST_Entry.Value); 1087 1088 else 1089 -- Not correlated function 1090 1091 Result.Next := Sym_Off; 1092 end if; 1093 1094 exit; 1095 1096 elsif ST_Last.SectionNumber = ST_Entry.SectionNumber 1097 and then ST_Last.TypeField = Not_Function_Symbol_Type 1098 and then ST_Last.StorageClass = 3 1099 and then ST_Last.NumberOfAuxSymbols = 1 1100 then 1101 -- Symbol is a section 1102 1103 Result.Size := uint64 (ST_Last.Value + Aux_Entry.Length 1104 - ST_Entry.Value); 1105 Result.Next := Noff; 1106 exit; 1107 end if; 1108 1109 exit when Noff >= Obj.Symtab_Last; 1110 end loop; 1111 1112 -- Relocate the address 1113 1114 Result.Value := 1115 Result.Value + Get_Section_Virtual_Address 1116 (Obj, uint32 (ST_Entry.SectionNumber - 1)); 1117 1118 return Result; 1119 end Read_Symbol; 1120 1121 ------------------ 1122 -- Read_Header -- 1123 ------------------ 1124 1125 function Read_Header (F : in out Mapped_Stream) return Header is 1126 Hdr : Header; 1127 Off : int32; 1128 1129 begin 1130 -- Skip the MSDOS stub, and seek directly to the file offset 1131 1132 Seek (F, Signature_Loc_Offset); 1133 Off := Read (F); 1134 1135 -- Read the COFF file header 1136 1137 Seek (F, Offset (Off)); 1138 Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU)); 1139 return Hdr; 1140 end Read_Header; 1141 1142 ------------------------- 1143 -- Read_Section_Header -- 1144 ------------------------- 1145 1146 function Read_Section_Header 1147 (Obj : in out PECOFF_Object_File; 1148 Index : uint32) return Section_Header 1149 is 1150 Sec : Section_Header; 1151 begin 1152 Seek (Obj.Sectab_Stream, Offset (Index * Section_Header'Size / SSU)); 1153 Read_Raw (Obj.Sectab_Stream, Sec'Address, Section_Header'Size / SSU); 1154 return Sec; 1155 end Read_Section_Header; 1156 1157 ---------- 1158 -- Name -- 1159 ---------- 1160 1161 function Name 1162 (Obj : in out PECOFF_Object_File; 1163 Sec : Object_Section) return String 1164 is 1165 Shdr : constant Section_Header := Read_Section_Header (Obj, Sec.Num); 1166 begin 1167 return Decode_Name (Obj, Shdr.Name); 1168 end Name; 1169 1170 ------------------- 1171 -- String_Table -- 1172 ------------------- 1173 1174 function String_Table 1175 (Obj : in out PECOFF_Object_File; 1176 Index : Offset) return String is 1177 begin 1178 -- An index of zero is used to represent an empty string, as the 1179 -- first word of the string table is specified to contain the length 1180 -- of the table rather than its contents. 1181 1182 if Index = 0 then 1183 return ""; 1184 1185 else 1186 return Offset_To_String (Obj.Symstr_Stream, Index); 1187 end if; 1188 end String_Table; 1189 1190 ---------- 1191 -- Name -- 1192 ---------- 1193 1194 function Name 1195 (Obj : in out PECOFF_Object_File; 1196 Sym : Object_Symbol) return String_Ptr_Len 1197 is 1198 ST_Entry : Symtab_Entry; 1199 1200 begin 1201 Seek (Obj.Symtab_Stream, Sym.Off); 1202 Read_Raw (Obj.Symtab_Stream, ST_Entry'Address, ST_Entry'Size / SSU); 1203 1204 declare 1205 -- Symbol table entries are packed and Table_Entry.Name may not be 1206 -- sufficiently aligned to interpret as a 32 bit word, so it is 1207 -- copied to a temporary 1208 1209 Aligned_Name : Name_Str := ST_Entry.Name; 1210 for Aligned_Name'Alignment use 4; 1211 1212 First_Word : uint32; 1213 pragma Import (Ada, First_Word); 1214 -- Suppress initialization in Normalized_Scalars mode 1215 for First_Word'Address use Aligned_Name (1)'Address; 1216 1217 Second_Word : uint32; 1218 pragma Import (Ada, Second_Word); 1219 -- Suppress initialization in Normalized_Scalars mode 1220 for Second_Word'Address use Aligned_Name (5)'Address; 1221 1222 begin 1223 if First_Word = 0 then 1224 -- Second word is an offset in the symbol table 1225 if Second_Word = 0 then 1226 return (null, 0); 1227 else 1228 Seek (Obj.Symstr_Stream, int64 (Second_Word)); 1229 return Read (Obj.Symstr_Stream); 1230 end if; 1231 else 1232 -- Inlined symbol name 1233 Seek (Obj.Symtab_Stream, Sym.Off); 1234 return To_String_Ptr_Len (Read (Obj.Symtab_Stream), 8); 1235 end if; 1236 end; 1237 end Name; 1238 1239 end PECOFF_Ops; 1240 1241 ----------------- 1242 -- XCOFF32_Ops -- 1243 ----------------- 1244 1245 package body XCOFF32_Ops is 1246 1247 function Read_Section_Header 1248 (Obj : in out XCOFF32_Object_File; 1249 Index : uint32) return Section_Header; 1250 -- Read a header from section table 1251 1252 ----------------- 1253 -- Read_Symbol -- 1254 ----------------- 1255 1256 function Read_Symbol 1257 (Obj : in out XCOFF32_Object_File; 1258 Off : Offset) return Object_Symbol 1259 is 1260 Sym : Symbol_Entry; 1261 Sz : constant Offset := Symbol_Entry'Size / SSU; 1262 Aux : Aux_Entry; 1263 Result : Object_Symbol; 1264 Noff : Offset; 1265 Sym_Off : Offset; 1266 1267 procedure Read_LD_Symbol; 1268 -- Read the next LD symbol 1269 1270 -------------------- 1271 -- Read_LD_Symbol -- 1272 -------------------- 1273 1274 procedure Read_LD_Symbol is 1275 begin 1276 loop 1277 Sym_Off := Noff; 1278 1279 Read_Raw (Obj.Symtab_Stream, Sym'Address, uint32 (Sz)); 1280 1281 Noff := Noff + Offset (1 + Sym.n_numaux) * Sz; 1282 1283 for J in 1 .. Sym.n_numaux loop 1284 Read_Raw (Obj.Symtab_Stream, Aux'Address, uint32 (Sz)); 1285 end loop; 1286 1287 exit when Noff >= Obj.Symtab_Last; 1288 1289 exit when Sym.n_numaux = 1 1290 and then Sym.n_scnum /= 0 1291 and then (Sym.n_sclass = C_EXT 1292 or else Sym.n_sclass = C_HIDEXT 1293 or else Sym.n_sclass = C_WEAKEXT) 1294 and then Aux.x_smtyp = XTY_LD; 1295 end loop; 1296 end Read_LD_Symbol; 1297 1298 -- Start of processing for Read_Symbol 1299 1300 begin 1301 Seek (Obj.Symtab_Stream, Off); 1302 Noff := Off; 1303 Read_LD_Symbol; 1304 1305 if Noff >= Obj.Symtab_Last then 1306 return Null_Symbol; 1307 end if; 1308 1309 -- Construct the symbol 1310 1311 Result := (Off => Sym_Off, 1312 Next => Noff, 1313 Value => uint64 (Sym.n_value), 1314 Size => 0); 1315 1316 -- Look for the next symbol to compute the size 1317 1318 Read_LD_Symbol; 1319 1320 if Noff >= Obj.Symtab_Last then 1321 return Null_Symbol; 1322 end if; 1323 1324 Result.Size := uint64 (Sym.n_value) - Result.Value; 1325 Result.Next := Sym_Off; 1326 return Result; 1327 end Read_Symbol; 1328 1329 ------------------ 1330 -- First_Symbol -- 1331 ------------------ 1332 1333 function First_Symbol 1334 (Obj : in out XCOFF32_Object_File) return Object_Symbol 1335 is 1336 begin 1337 -- Return Null_Symbol in the case that the symbol table is empty 1338 1339 if Obj.Symtab_Last = 0 then 1340 return Null_Symbol; 1341 end if; 1342 1343 return Read_Symbol (Obj, 0); 1344 end First_Symbol; 1345 1346 ---------------- 1347 -- Initialize -- 1348 ---------------- 1349 1350 function Initialize 1351 (F : Mapped_File; 1352 Hdr : Header; 1353 In_Exception : Boolean) return XCOFF32_Object_File 1354 is 1355 Res : XCOFF32_Object_File (Format => XCOFF32); 1356 Strtab_Sz : uint32; 1357 begin 1358 Res.Mf := F; 1359 Res.In_Exception := In_Exception; 1360 1361 Res.Arch := PPC; 1362 1363 -- Map sections table 1364 Res.Num_Sections := uint32 (Hdr.f_nscns); 1365 Res.Sectab_Stream := Create_Stream 1366 (F, 1367 File_Size (Header'Size / SSU) + File_Size (Hdr.f_opthdr), 1368 File_Size (Hdr.f_nscns) * (Section_Header'Size / SSU)); 1369 1370 -- Map symbols table 1371 Res.Symtab_Last := Offset (Hdr.f_nscns) * (Symbol_Entry'Size / SSU); 1372 Res.Symtab_Stream := Create_Stream 1373 (F, 1374 File_Size (Hdr.f_symptr), 1375 File_Size (Res.Symtab_Last) + 4); 1376 1377 -- Map string table 1378 Seek (Res.Symtab_Stream, Res.Symtab_Last); 1379 Strtab_Sz := Read (Res.Symtab_Stream); 1380 Res.Symstr_Stream := Create_Stream 1381 (F, 1382 File_Size (Res.Symtab_Last) + 4, 1383 File_Size (Strtab_Sz) - 4); 1384 1385 return Res; 1386 end Initialize; 1387 1388 ----------------- 1389 -- Get_Section -- 1390 ----------------- 1391 1392 function Get_Section 1393 (Obj : in out XCOFF32_Object_File; 1394 Index : uint32) return Object_Section 1395 is 1396 Sec : constant Section_Header := Read_Section_Header (Obj, Index); 1397 begin 1398 return (Index, Offset (Sec.s_scnptr), 1399 uint64 (Sec.s_vaddr), 1400 uint64 (Sec.s_size), 1401 (Sec.s_flags and STYP_TEXT) /= 0); 1402 end Get_Section; 1403 1404 ----------------- 1405 -- Read_Header -- 1406 ----------------- 1407 1408 function Read_Header (F : in out Mapped_Stream) return Header is 1409 Hdr : Header; 1410 begin 1411 Seek (F, 0); 1412 Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU)); 1413 return Hdr; 1414 end Read_Header; 1415 1416 ------------------------- 1417 -- Read_Section_Header -- 1418 ------------------------- 1419 1420 function Read_Section_Header 1421 (Obj : in out XCOFF32_Object_File; 1422 Index : uint32) return Section_Header 1423 is 1424 Sec : Section_Header; 1425 1426 begin 1427 -- Seek to the end of the object header 1428 1429 Seek (Obj.Sectab_Stream, Offset (Index * Section_Header'Size / SSU)); 1430 1431 -- Read the section 1432 1433 Read_Raw (Obj.Sectab_Stream, Sec'Address, Section_Header'Size / SSU); 1434 1435 return Sec; 1436 end Read_Section_Header; 1437 1438 ---------- 1439 -- Name -- 1440 ---------- 1441 1442 function Name 1443 (Obj : in out XCOFF32_Object_File; 1444 Sec : Object_Section) return String 1445 is 1446 Hdr : Section_Header; 1447 begin 1448 Hdr := Read_Section_Header (Obj, Sec.Num); 1449 return Trim_Trailing_Nuls (Hdr.s_name); 1450 end Name; 1451 1452 ---------- 1453 -- Name -- 1454 ---------- 1455 1456 function Name 1457 (Obj : in out XCOFF32_Object_File; 1458 Sym : Object_Symbol) return String_Ptr_Len 1459 is 1460 Symbol : Symbol_Entry; 1461 1462 begin 1463 Seek (Obj.Symtab_Stream, Sym.Off); 1464 Read_Raw (Obj.Symtab_Stream, Symbol'Address, Symbol'Size / SSU); 1465 1466 declare 1467 First_Word : uint32; 1468 pragma Import (Ada, First_Word); 1469 -- Suppress initialization in Normalized_Scalars mode 1470 for First_Word'Address use Symbol.n_name (1)'Address; 1471 1472 Second_Word : uint32; 1473 pragma Import (Ada, Second_Word); 1474 -- Suppress initialization in Normalized_Scalars mode 1475 for Second_Word'Address use Symbol.n_name (5)'Address; 1476 1477 begin 1478 if First_Word = 0 then 1479 if Second_Word = 0 then 1480 return (null, 0); 1481 else 1482 Seek (Obj.Symstr_Stream, int64 (Second_Word)); 1483 return Read (Obj.Symstr_Stream); 1484 end if; 1485 else 1486 Seek (Obj.Symtab_Stream, Sym.Off); 1487 return To_String_Ptr_Len (Read (Obj.Symstr_Stream), 8); 1488 end if; 1489 end; 1490 end Name; 1491 end XCOFF32_Ops; 1492 1493 ---------- 1494 -- Arch -- 1495 ---------- 1496 1497 function Arch (Obj : Object_File) return Object_Arch is 1498 begin 1499 return Obj.Arch; 1500 end Arch; 1501 1502 function Create_Stream 1503 (Mf : Mapped_File; 1504 File_Offset : File_Size; 1505 File_Length : File_Size) 1506 return Mapped_Stream 1507 is 1508 Region : Mapped_Region; 1509 begin 1510 Read (Mf, Region, File_Offset, File_Length, False); 1511 return (Region, 0, Offset (File_Length)); 1512 end Create_Stream; 1513 1514 function Create_Stream 1515 (Obj : Object_File; 1516 Sec : Object_Section) return Mapped_Stream is 1517 begin 1518 return Create_Stream (Obj.Mf, File_Size (Sec.Off), File_Size (Sec.Size)); 1519 end Create_Stream; 1520 1521 procedure Tell (Obj : in out Mapped_Stream; Off : out Offset) is 1522 begin 1523 Off := Obj.Off; 1524 end Tell; 1525 1526 function Tell (Obj : Mapped_Stream) return Offset is 1527 begin 1528 return Obj.Off; 1529 end Tell; 1530 1531 function Length (Obj : Mapped_Stream) return Offset is 1532 begin 1533 return Obj.Len; 1534 end Length; 1535 1536 ----------- 1537 -- Close -- 1538 ----------- 1539 1540 procedure Close (S : in out Mapped_Stream) is 1541 begin 1542 Free (S.Region); 1543 end Close; 1544 1545 procedure Close (Obj : in out Object_File) is 1546 begin 1547 Close (Obj.Symtab_Stream); 1548 Close (Obj.Symstr_Stream); 1549 Close (Obj.Sectab_Stream); 1550 1551 case Obj.Format is 1552 when ELF => 1553 Close (Obj.Secstr_Stream); 1554 when Any_PECOFF => 1555 null; 1556 when XCOFF32 => 1557 null; 1558 end case; 1559 1560 Close (Obj.Mf); 1561 end Close; 1562 1563 ------------------------ 1564 -- Strip_Leading_Char -- 1565 ------------------------ 1566 1567 function Strip_Leading_Char 1568 (Obj : in out Object_File; 1569 Sym : String_Ptr_Len) return Positive is 1570 begin 1571 if (Obj.Format = PECOFF and then Sym.Ptr (1) = '_') 1572 or else 1573 (Obj.Format = XCOFF32 and then Sym.Ptr (1) = '.') 1574 then 1575 return 2; 1576 else 1577 return 1; 1578 end if; 1579 end Strip_Leading_Char; 1580 1581 ---------------------- 1582 -- Decoded_Ada_Name -- 1583 ---------------------- 1584 1585 function Decoded_Ada_Name 1586 (Obj : in out Object_File; 1587 Sym : String_Ptr_Len) return String 1588 is 1589 procedure gnat_decode 1590 (Coded_Name_Addr : Address; 1591 Ada_Name_Addr : Address; 1592 Verbose : int); 1593 pragma Import (C, gnat_decode, "__gnat_decode"); 1594 1595 subtype size_t is Interfaces.C.size_t; 1596 1597 Sym_Name : constant String := 1598 String (Sym.Ptr (1 .. Sym.Len)) & ASCII.NUL; 1599 Decoded : char_array (0 .. size_t (Sym.Len) * 2 + 60); 1600 Off : Natural; 1601 begin 1602 -- In the PECOFF case most but not all symbol table entries have an 1603 -- extra leading underscore. In this case we trim it. 1604 1605 Off := Strip_Leading_Char (Obj, Sym); 1606 1607 gnat_decode (Sym_Name (Off)'Address, Decoded'Address, 0); 1608 1609 return To_Ada (Decoded); 1610 end Decoded_Ada_Name; 1611 1612 ------------------ 1613 -- First_Symbol -- 1614 ------------------ 1615 1616 function First_Symbol (Obj : in out Object_File) return Object_Symbol is 1617 begin 1618 case Obj.Format is 1619 when ELF32 => return ELF32_Ops.First_Symbol (Obj); 1620 when ELF64 => return ELF64_Ops.First_Symbol (Obj); 1621 when Any_PECOFF => return PECOFF_Ops.First_Symbol (Obj); 1622 when XCOFF32 => return XCOFF32_Ops.First_Symbol (Obj); 1623 end case; 1624 end First_Symbol; 1625 1626 ------------ 1627 -- Format -- 1628 ------------ 1629 1630 function Format (Obj : Object_File) return Object_Format is 1631 begin 1632 return Obj.Format; 1633 end Format; 1634 1635 ---------------------- 1636 -- Get_Load_Address -- 1637 ---------------------- 1638 1639 function Get_Load_Address (Obj : Object_File) return uint64 is 1640 begin 1641 raise Format_Error with "Get_Load_Address not implemented"; 1642 return 0; 1643 end Get_Load_Address; 1644 1645 ----------------- 1646 -- Get_Section -- 1647 ----------------- 1648 1649 function Get_Section 1650 (Obj : in out Object_File; 1651 Shnum : uint32) return Object_Section is 1652 begin 1653 case Obj.Format is 1654 when ELF32 => return ELF32_Ops.Get_Section (Obj, Shnum); 1655 when ELF64 => return ELF64_Ops.Get_Section (Obj, Shnum); 1656 when Any_PECOFF => return PECOFF_Ops.Get_Section (Obj, Shnum); 1657 when XCOFF32 => return XCOFF32_Ops.Get_Section (Obj, Shnum); 1658 end case; 1659 end Get_Section; 1660 1661 function Get_Section 1662 (Obj : in out Object_File; 1663 Sec_Name : String) return Object_Section 1664 is 1665 Sec : Object_Section; 1666 1667 begin 1668 for J in 0 .. Obj.Num_Sections - 1 loop 1669 Sec := Get_Section (Obj, J); 1670 1671 if Name (Obj, Sec) = Sec_Name then 1672 return Sec; 1673 end if; 1674 end loop; 1675 1676 if Obj.In_Exception then 1677 return Null_Section; 1678 else 1679 raise Format_Error with "could not find section in object file"; 1680 end if; 1681 end Get_Section; 1682 1683 ---------------------- 1684 -- Get_Xcode_Bounds -- 1685 ---------------------- 1686 1687 procedure Get_Xcode_Bounds 1688 (Obj : in out Object_File; 1689 Low, High : out uint64) is 1690 Sec : Object_Section; 1691 begin 1692 -- First set as an empty range 1693 Low := uint64'Last; 1694 High := uint64'First; 1695 1696 -- Now find the lowest and highest offsets 1697 -- attached to executable code sections 1698 for Idx in 1 .. Num_Sections (Obj) loop 1699 Sec := Get_Section (Obj, Idx - 1); 1700 if Sec.Flag_Xcode then 1701 if Sec.Addr < Low then 1702 Low := Sec.Addr; 1703 end if; 1704 if Sec.Addr + Sec.Size > High then 1705 High := Sec.Addr + Sec.Size; 1706 end if; 1707 end if; 1708 end loop; 1709 end Get_Xcode_Bounds; 1710 1711 ---------- 1712 -- Name -- 1713 ---------- 1714 1715 function Name 1716 (Obj : in out Object_File; 1717 Sec : Object_Section) return String is 1718 begin 1719 case Obj.Format is 1720 when ELF32 => return ELF32_Ops.Name (Obj, Sec); 1721 when ELF64 => return ELF64_Ops.Name (Obj, Sec); 1722 when Any_PECOFF => return PECOFF_Ops.Name (Obj, Sec); 1723 when XCOFF32 => return XCOFF32_Ops.Name (Obj, Sec); 1724 end case; 1725 end Name; 1726 1727 function Name 1728 (Obj : in out Object_File; 1729 Sym : Object_Symbol) return String_Ptr_Len is 1730 begin 1731 case Obj.Format is 1732 when ELF32 => return ELF32_Ops.Name (Obj, Sym); 1733 when ELF64 => return ELF64_Ops.Name (Obj, Sym); 1734 when Any_PECOFF => return PECOFF_Ops.Name (Obj, Sym); 1735 when XCOFF32 => return XCOFF32_Ops.Name (Obj, Sym); 1736 end case; 1737 end Name; 1738 1739 ----------------- 1740 -- Next_Symbol -- 1741 ----------------- 1742 1743 function Next_Symbol 1744 (Obj : in out Object_File; 1745 Prev : Object_Symbol) return Object_Symbol is 1746 begin 1747 -- Test whether we've reached the end of the symbol table 1748 1749 if Prev.Next >= Obj.Symtab_Last then 1750 return Null_Symbol; 1751 end if; 1752 1753 return Read_Symbol (Obj, Prev.Next); 1754 end Next_Symbol; 1755 1756 --------- 1757 -- Num -- 1758 --------- 1759 1760 function Num (Sec : Object_Section) return uint32 is 1761 begin 1762 return Sec.Num; 1763 end Num; 1764 1765 ------------------ 1766 -- Num_Sections -- 1767 ------------------ 1768 1769 function Num_Sections (Obj : Object_File) return uint32 is 1770 begin 1771 return Obj.Num_Sections; 1772 end Num_Sections; 1773 1774 --------- 1775 -- Off -- 1776 --------- 1777 1778 function Off (Sec : Object_Section) return Offset is 1779 begin 1780 return Sec.Off; 1781 end Off; 1782 1783 function Off (Sym : Object_Symbol) return Offset is 1784 begin 1785 return Sym.Off; 1786 end Off; 1787 1788 ---------------------- 1789 -- Offset_To_String -- 1790 ---------------------- 1791 1792 function Offset_To_String 1793 (S : in out Mapped_Stream; 1794 Off : Offset) return String 1795 is 1796 Buf : Buffer; 1797 begin 1798 Seek (S, Off); 1799 Read_C_String (S, Buf); 1800 return To_String (Buf); 1801 end Offset_To_String; 1802 1803 ---------- 1804 -- Open -- 1805 ---------- 1806 1807 function Open 1808 (File_Name : String; 1809 In_Exception : Boolean := False) return Object_File_Access 1810 is 1811 F : Mapped_File; 1812 Hdr_Stream : Mapped_Stream; 1813 1814 begin 1815 -- Open the file 1816 1817 F := Open_Read_No_Exception (File_Name); 1818 1819 if F = Invalid_Mapped_File then 1820 if In_Exception then 1821 return null; 1822 else 1823 raise IO_Error with "could not open object file"; 1824 end if; 1825 end if; 1826 1827 Hdr_Stream := Create_Stream (F, 0, 4096); 1828 1829 declare 1830 Hdr : constant ELF32_Ops.Header := ELF32_Ops.Read_Header (Hdr_Stream); 1831 1832 begin 1833 -- Look for the magic numbers for the ELF case 1834 1835 if Hdr.E_Ident (0) = 16#7F# and then 1836 Hdr.E_Ident (1) = Character'Pos ('E') and then 1837 Hdr.E_Ident (2) = Character'Pos ('L') and then 1838 Hdr.E_Ident (3) = Character'Pos ('F') and then 1839 Hdr.E_Ident (4) = ELF32_Ops.ELFCLASS32 1840 then 1841 Close (Hdr_Stream); 1842 return new Object_File' 1843 (ELF32_Ops.Initialize (F, Hdr, In_Exception)); 1844 end if; 1845 end; 1846 1847 declare 1848 Hdr : constant ELF64_Ops.Header := 1849 ELF64_Ops.Read_Header (Hdr_Stream); 1850 1851 begin 1852 -- Look for the magic numbers for the ELF case 1853 1854 if Hdr.E_Ident (0) = 16#7F# and then 1855 Hdr.E_Ident (1) = Character'Pos ('E') and then 1856 Hdr.E_Ident (2) = Character'Pos ('L') and then 1857 Hdr.E_Ident (3) = Character'Pos ('F') and then 1858 Hdr.E_Ident (4) = ELF32_Ops.ELFCLASS64 1859 then 1860 Close (Hdr_Stream); 1861 return new Object_File' 1862 (ELF64_Ops.Initialize (F, Hdr, In_Exception)); 1863 end if; 1864 end; 1865 1866 declare 1867 Hdr : constant PECOFF_Ops.Header := 1868 PECOFF_Ops.Read_Header (Hdr_Stream); 1869 1870 begin 1871 -- Test the magic numbers 1872 1873 if Hdr.Magics (0) = Character'Pos ('P') and then 1874 Hdr.Magics (1) = Character'Pos ('E') and then 1875 Hdr.Magics (2) = 0 and then 1876 Hdr.Magics (3) = 0 1877 then 1878 Close (Hdr_Stream); 1879 return new Object_File' 1880 (PECOFF_Ops.Initialize (F, Hdr, In_Exception)); 1881 end if; 1882 1883 exception 1884 -- If this is not a PECOFF file then we've done a seek and read to a 1885 -- random address, possibly raising IO_Error 1886 1887 when IO_Error => 1888 null; 1889 end; 1890 1891 declare 1892 Hdr : constant XCOFF32_Ops.Header := 1893 XCOFF32_Ops.Read_Header (Hdr_Stream); 1894 1895 begin 1896 -- Test the magic numbers 1897 1898 if Hdr.f_magic = 8#0737# then 1899 Close (Hdr_Stream); 1900 return new Object_File' 1901 (XCOFF32_Ops.Initialize (F, Hdr, In_Exception)); 1902 end if; 1903 end; 1904 1905 Close (Hdr_Stream); 1906 1907 if In_Exception then 1908 return null; 1909 else 1910 raise Format_Error with "unrecognized object format"; 1911 end if; 1912 end Open; 1913 1914 ---------- 1915 -- Read -- 1916 ---------- 1917 1918 function Read (S : in out Mapped_Stream) return Mmap.Str_Access 1919 is 1920 function To_Str_Access is 1921 new Ada.Unchecked_Conversion (Address, Str_Access); 1922 begin 1923 return To_Str_Access (Data (S.Region) (Natural (S.Off + 1))'Address); 1924 end Read; 1925 1926 function Read (S : in out Mapped_Stream) return String_Ptr_Len is 1927 begin 1928 return To_String_Ptr_Len (Read (S)); 1929 end Read; 1930 1931 procedure Check_Read_Offset (S : in out Mapped_Stream; Size : uint32) is 1932 begin 1933 if S.Off + Offset (Size) > Offset (Last (S.Region)) then 1934 raise IO_Error with "could not read from object file"; 1935 end if; 1936 end Check_Read_Offset; 1937 1938 procedure Read_Raw 1939 (S : in out Mapped_Stream; 1940 Addr : Address; 1941 Size : uint32) 1942 is 1943 function To_Str_Access is 1944 new Ada.Unchecked_Conversion (Address, Str_Access); 1945 1946 Sz : constant Offset := Offset (Size); 1947 begin 1948 -- Check size 1949 1950 pragma Debug (Check_Read_Offset (S, Size)); 1951 1952 -- Copy data 1953 1954 To_Str_Access (Addr) (1 .. Positive (Sz)) := 1955 Data (S.Region) (Positive (S.Off + 1) .. Positive (S.Off + Sz)); 1956 1957 -- Update offset 1958 1959 S.Off := S.Off + Sz; 1960 end Read_Raw; 1961 1962 function Read (S : in out Mapped_Stream) return uint8 is 1963 Data : uint8; 1964 begin 1965 Read_Raw (S, Data'Address, Data'Size / SSU); 1966 return Data; 1967 end Read; 1968 1969 function Read (S : in out Mapped_Stream) return uint16 is 1970 Data : uint16; 1971 begin 1972 Read_Raw (S, Data'Address, Data'Size / SSU); 1973 return Data; 1974 end Read; 1975 1976 function Read (S : in out Mapped_Stream) return uint32 is 1977 Data : uint32; 1978 begin 1979 Read_Raw (S, Data'Address, Data'Size / SSU); 1980 return Data; 1981 end Read; 1982 1983 function Read (S : in out Mapped_Stream) return uint64 is 1984 Data : uint64; 1985 begin 1986 Read_Raw (S, Data'Address, Data'Size / SSU); 1987 return Data; 1988 end Read; 1989 1990 function Read (S : in out Mapped_Stream) return int8 is 1991 Data : int8; 1992 begin 1993 Read_Raw (S, Data'Address, Data'Size / SSU); 1994 return Data; 1995 end Read; 1996 1997 function Read (S : in out Mapped_Stream) return int16 is 1998 Data : int16; 1999 begin 2000 Read_Raw (S, Data'Address, Data'Size / SSU); 2001 return Data; 2002 end Read; 2003 2004 function Read (S : in out Mapped_Stream) return int32 is 2005 Data : int32; 2006 begin 2007 Read_Raw (S, Data'Address, Data'Size / SSU); 2008 return Data; 2009 end Read; 2010 2011 function Read (S : in out Mapped_Stream) return int64 is 2012 Data : int64; 2013 begin 2014 Read_Raw (S, Data'Address, Data'Size / SSU); 2015 return Data; 2016 end Read; 2017 2018 ------------------ 2019 -- Read_Address -- 2020 ------------------ 2021 2022 function Read_Address 2023 (Obj : Object_File; S : in out Mapped_Stream) return uint64 is 2024 Address_32 : uint32; 2025 Address_64 : uint64; 2026 2027 begin 2028 case Obj.Arch is 2029 when i386 2030 | MIPS 2031 | PPC 2032 | SPARC 2033 => 2034 Address_32 := Read (S); 2035 return uint64 (Address_32); 2036 2037 when IA64 2038 | PPC64 2039 | SPARC64 2040 | x86_64 2041 => 2042 Address_64 := Read (S); 2043 return Address_64; 2044 2045 when Unknown => 2046 raise Format_Error with "unrecognized machine architecture"; 2047 end case; 2048 end Read_Address; 2049 2050 ------------------- 2051 -- Read_C_String -- 2052 ------------------- 2053 2054 procedure Read_C_String (S : in out Mapped_Stream; B : out Buffer) is 2055 J : Integer := 0; 2056 2057 begin 2058 loop 2059 -- Handle overflow case 2060 2061 if J = B'Last then 2062 B (J) := 0; 2063 exit; 2064 end if; 2065 2066 B (J) := Read (S); 2067 exit when B (J) = 0; 2068 J := J + 1; 2069 end loop; 2070 end Read_C_String; 2071 2072 ------------------- 2073 -- Read_C_String -- 2074 ------------------- 2075 2076 function Read_C_String (S : in out Mapped_Stream) return Str_Access is 2077 Res : constant Str_Access := Read (S); 2078 2079 begin 2080 for J in Res'Range loop 2081 if S.Off + Offset (J - 1) > Offset (Last (S.Region)) then 2082 raise IO_Error with "could not read from object file"; 2083 end if; 2084 2085 if Res (J) = ASCII.NUL then 2086 S.Off := S.Off + Offset (J); 2087 return Res; 2088 end if; 2089 end loop; 2090 2091 -- Overflow case 2092 raise Constraint_Error; 2093 end Read_C_String; 2094 2095 ----------------- 2096 -- Read_LEB128 -- 2097 ----------------- 2098 2099 function Read_LEB128 (S : in out Mapped_Stream) return uint32 is 2100 B : uint8; 2101 Shift : Integer := 0; 2102 Res : uint32 := 0; 2103 2104 begin 2105 loop 2106 B := Read (S); 2107 Res := Res or Shift_Left (uint32 (B and 16#7f#), Shift); 2108 exit when (B and 16#80#) = 0; 2109 Shift := Shift + 7; 2110 end loop; 2111 2112 return Res; 2113 end Read_LEB128; 2114 2115 function Read_LEB128 (S : in out Mapped_Stream) return int32 is 2116 B : uint8; 2117 Shift : Integer := 0; 2118 Res : uint32 := 0; 2119 2120 begin 2121 loop 2122 B := Read (S); 2123 Res := Res or Shift_Left (uint32 (B and 16#7f#), Shift); 2124 Shift := Shift + 7; 2125 exit when (B and 16#80#) = 0; 2126 end loop; 2127 2128 if Shift < 32 and then (Res and Shift_Left (1, Shift - 1)) /= 0 then 2129 Res := Res or Shift_Left (-1, Shift); 2130 end if; 2131 2132 return To_int32 (Res); 2133 end Read_LEB128; 2134 2135 ----------------- 2136 -- Read_Symbol -- 2137 ----------------- 2138 2139 function Read_Symbol 2140 (Obj : in out Object_File; 2141 Off : Offset) return Object_Symbol is 2142 begin 2143 case Obj.Format is 2144 when ELF32 => return ELF32_Ops.Read_Symbol (Obj, Off); 2145 when ELF64 => return ELF64_Ops.Read_Symbol (Obj, Off); 2146 when Any_PECOFF => return PECOFF_Ops.Read_Symbol (Obj, Off); 2147 when XCOFF32 => return XCOFF32_Ops.Read_Symbol (Obj, Off); 2148 end case; 2149 end Read_Symbol; 2150 2151 ---------- 2152 -- Seek -- 2153 ---------- 2154 2155 procedure Seek (S : in out Mapped_Stream; Off : Offset) is 2156 begin 2157 if Off < 0 or else Off > Offset (Last (S.Region)) then 2158 raise IO_Error with "could not seek to offset in object file"; 2159 end if; 2160 2161 S.Off := Off; 2162 end Seek; 2163 2164 ---------- 2165 -- Size -- 2166 ---------- 2167 2168 function Size (Sec : Object_Section) return uint64 is 2169 begin 2170 return Sec.Size; 2171 end Size; 2172 2173 function Size (Sym : Object_Symbol) return uint64 is 2174 begin 2175 return Sym.Size; 2176 end Size; 2177 2178 ------------ 2179 -- Strlen -- 2180 ------------ 2181 2182 function Strlen (Buf : Buffer) return int32 is 2183 begin 2184 return int32 (CRTL.strlen (Buf'Address)); 2185 end Strlen; 2186 2187 ----------- 2188 -- Spans -- 2189 ----------- 2190 2191 function Spans (Sym : Object_Symbol; Addr : uint64) return Boolean is 2192 begin 2193 return Addr >= Sym.Value and then Addr < Sym.Value + Sym.Size; 2194 end Spans; 2195 2196 --------------- 2197 -- To_String -- 2198 --------------- 2199 2200 function To_String (Buf : Buffer) return String is 2201 Result : String (1 .. Integer (CRTL.strlen (Buf'Address))); 2202 for Result'Address use Buf'Address; 2203 pragma Import (Ada, Result); 2204 2205 begin 2206 return Result; 2207 end To_String; 2208 2209 ----------------------- 2210 -- To_String_Ptr_Len -- 2211 ----------------------- 2212 2213 function To_String_Ptr_Len 2214 (Ptr : Mmap.Str_Access; 2215 Max_Len : Natural := Natural'Last) return String_Ptr_Len is 2216 begin 2217 for I in 1 .. Max_Len loop 2218 if Ptr (I) = ASCII.NUL then 2219 return (Ptr, I - 1); 2220 end if; 2221 end loop; 2222 return (Ptr, Max_Len); 2223 end To_String_Ptr_Len; 2224 2225 ------------------------ 2226 -- Trim_Trailing_Nuls -- 2227 ------------------------ 2228 2229 function Trim_Trailing_Nuls (Str : String) return String is 2230 begin 2231 for J in Str'Range loop 2232 if Str (J) = ASCII.NUL then 2233 return Str (Str'First .. J - 1); 2234 end if; 2235 end loop; 2236 2237 return Str; 2238 end Trim_Trailing_Nuls; 2239 2240 ----------- 2241 -- Value -- 2242 ----------- 2243 2244 function Value (Sym : Object_Symbol) return uint64 is 2245 begin 2246 return Sym.Value; 2247 end Value; 2248 2249end System.Object_Reader; 2250