1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y M B O L S . P R O C E S S I N G --
9 -- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- This is the VMS/IA64 version of this package
28 with Ada.IO_Exceptions;
30 with Ada.Unchecked_Deallocation;
33 package body Processing is
35 type String_Array is array (Positive range <>) of String_Access;
36 type Strings_Ptr is access String_Array;
39 new Ada.Unchecked_Deallocation (String_Array, Strings_Ptr);
41 type Section_Header is record
49 type Section_Header_Array is array (Natural range <>) of Section_Header;
50 type Section_Header_Ptr is access Section_Header_Array;
53 new Ada.Unchecked_Deallocation (Section_Header_Array, Section_Header_Ptr);
60 (Object_File : String;
61 Success : out Boolean)
66 Str : String (1 .. 1000) := (others => ' ');
69 Strings : Strings_Ptr;
81 Symtab_Index : Natural := 0;
82 String_Table_Index : Natural := 0;
94 STV_Internal : constant := 1;
95 STV_Hidden : constant := 2;
97 Section_Headers : Section_Header_Ptr;
99 Offset : Natural := 0;
100 OK : Boolean := True;
102 procedure Get_Byte (B : out Byte);
103 -- Read one byte from the object file
105 procedure Get_Half (H : out Integer);
106 -- Read one half work from the object file
108 procedure Get_Word (W : out Integer);
109 -- Read one full word from the object file
112 -- Restart reading the object file
115 -- Read and disregard one half word from the object file
121 procedure Get_Byte (B : out Byte) is
123 Byte_IO.Read (File, B);
124 Offset := Offset + 1;
131 procedure Get_Half (H : out Integer) is
134 Get_Byte (C1); Get_Byte (C2);
136 Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1));
143 procedure Get_Word (W : out Integer) is
146 Get_Half (H1); Get_Half (H2);
147 W := H2 * 256 * 256 + H1;
157 Byte_IO.Reset (File);
164 procedure Skip_Half is
166 pragma Unreferenced (B);
168 Byte_IO.Read (File, B);
169 Byte_IO.Read (File, B);
170 Offset := Offset + 2;
173 -- Start of processing for Process
176 -- Open the object file with Byte_IO. Return with Success = False if
180 Open (File, In_File, Object_File);
184 ("*** Unable to open object file """ & Object_File & """");
189 -- Assume that the object file has a correct format
193 -- Skip ELF identification
195 while Offset < 16 loop
225 -- Skip upper half of Shoff
247 Get_Half (Shentsize);
251 Section_Headers := new Section_Header_Array (0 .. Shnum - 1);
253 -- Go to Section Headers
255 while Offset < Shoff loop
259 -- Reset Symtab_Index
263 for J in Section_Headers'Range loop
265 -- Get the data for each Section Header
270 for K in 1 .. 16 loop
282 while (Offset - Shoff) mod Shentsize /= 0 loop
286 -- If this is the Symbol Table Section Header, record its index
292 Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink);
295 if Symtab_Index = 0 then
301 Section_Headers (Symtab_Index).Shoffset +
302 Section_Headers (Symtab_Index).Shsize;
304 String_Table_Index := Section_Headers (Symtab_Index).Shlink;
306 new String_Array (1 .. Section_Headers (String_Table_Index).Shsize);
308 -- Go get the String Table section for the Symbol Table
312 while Offset < Section_Headers (String_Table_Index).Shoffset loop
318 Get_Byte (B); -- zero
320 while Offset < Section_Headers (String_Table_Index).Shsize loop
325 if B /= ASCII.NUL then
326 Str_Last := Str_Last + 1;
330 Strings (Offset - Str_Last - 1) :=
331 new String'(Str (1 .. Str_Last));
337 -- Go get the Symbol Table
341 while Offset < Section_Headers (Symtab_Index).Shoffset loop
345 while Offset < End_Symtab loop
354 Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
355 Stbind := Integer'(Character'Pos (Stinfo)) / 16;
356 Stvis := Integer'(Character'Pos (Stother)) mod 4;
358 if (Sttype = 1 or else Sttype = 2)
360 and then Stshndx /= 0
361 and then Stvis /= STV_Internal
362 and then Stvis /= STV_Hidden
364 -- Check if this is a symbol from a generic body
368 for J in Strings (Stname)'First .. Strings (Stname)'Last - 2 loop
369 if Strings (Stname) (J) = 'G'
370 and then Strings (Stname) (J + 1) = 'P'
371 and then Strings (Stname) (J + 2) in '0' .. '9'
380 S_Data : Symbol_Data;
382 S_Data.Name := new String'(Strings (Stname).all);
391 -- Put the new symbol in the table
393 Symbol_Table.Append (Complete_Symbols, S_Data);
399 -- The object file has been processed, close it
403 -- Free the allocated memory
405 Free (Section_Headers);
407 for J in Strings'Range loop
408 if Strings (J) /= null then
416 -- For any exception, output an error message, close the object file
417 -- and return with Success = False.
419 when Ada.IO_Exceptions.End_Error =>
423 Put_Line ("unexpected exception raised while processing """
424 & Object_File & """");
425 Put_Line (Exception_Information (X));