?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
c++: wrong error due to std::initializer_list opt [PR116476]
[official-gcc.git] / gcc / ada / libgnat / s-objrea.adb
blobc4d69ab1ceffacf9f0ff7e0b66db65a31f4512c6
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-2024, 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
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
2282 end System.Object_Reader;
Mirror of the offical gcc git repository hosted at gcc.gnu.org