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