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