?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
[testsuite]
[official-gcc.git] / gcc / ada / libgnat / s-objrea.adb
blob4c949654dbcc45bcdf7fae133848529c17848104
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
32 with Ada.Unchecked_Conversion;
33
34 with Interfaces.C;
35
36 with System.CRTL;
37
38 package 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
2246 end System.Object_Reader;
Mirror of the offical gcc git repository hosted at gcc.gnu.org