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