1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                    S Y M B O L S . P R O C E S S I N G                   --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 2004-2009, 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.  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.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26--  This is the VMS/IA64 version of this package
27
28with Ada.IO_Exceptions;
29
30with Ada.Unchecked_Deallocation;
31
32separate (Symbols)
33package body Processing is
34
35   type String_Array is array (Positive range <>) of String_Access;
36   type Strings_Ptr is access String_Array;
37
38   procedure Free is
39     new Ada.Unchecked_Deallocation (String_Array, Strings_Ptr);
40
41   type Section_Header is record
42      Shname   : Integer;
43      Shtype   : Integer;
44      Shoffset : Integer;
45      Shsize   : Integer;
46      Shlink   : Integer;
47   end record;
48
49   type Section_Header_Array is array (Natural range <>) of Section_Header;
50   type Section_Header_Ptr is access Section_Header_Array;
51
52   procedure Free is
53     new Ada.Unchecked_Deallocation (Section_Header_Array, Section_Header_Ptr);
54
55   -------------
56   -- Process --
57   -------------
58
59   procedure Process
60     (Object_File : String;
61      Success     : out Boolean)
62   is
63      B : Byte;
64      W : Integer;
65
66      Str : String (1 .. 1000) := (others => ' ');
67      Str_Last : Natural;
68
69      Strings : Strings_Ptr;
70
71      Shoff : Integer;
72      Shnum : Integer;
73      Shentsize : Integer;
74
75      Shname   : Integer;
76      Shtype   : Integer;
77      Shoffset : Integer;
78      Shsize   : Integer;
79      Shlink   : Integer;
80
81      Symtab_Index       : Natural := 0;
82      String_Table_Index : Natural := 0;
83
84      End_Symtab : Integer;
85
86      Stname  : Integer;
87      Stinfo  : Character;
88      Stother : Character;
89      Sttype  : Integer;
90      Stbind  : Integer;
91      Stshndx : Integer;
92      Stvis   : Integer;
93
94      STV_Internal : constant := 1;
95      STV_Hidden   : constant := 2;
96
97      Section_Headers : Section_Header_Ptr;
98
99      Offset : Natural := 0;
100      OK     : Boolean := True;
101
102      procedure Get_Byte (B : out Byte);
103      --  Read one byte from the object file
104
105      procedure Get_Half (H : out Integer);
106      --  Read one half work from the object file
107
108      procedure Get_Word (W : out Integer);
109      --  Read one full word from the object file
110
111      procedure Reset;
112      --  Restart reading the object file
113
114      procedure Skip_Half;
115      --  Read and disregard one half word from the object file
116
117      --------------
118      -- Get_Byte --
119      --------------
120
121      procedure Get_Byte (B : out Byte) is
122      begin
123         Byte_IO.Read (File, B);
124         Offset := Offset + 1;
125      end Get_Byte;
126
127      --------------
128      -- Get_Half --
129      --------------
130
131      procedure Get_Half (H : out Integer) is
132         C1, C2 : Character;
133      begin
134         Get_Byte (C1); Get_Byte (C2);
135         H :=
136           Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1));
137      end Get_Half;
138
139      --------------
140      -- Get_Word --
141      --------------
142
143      procedure Get_Word (W : out Integer) is
144         H1, H2 : Integer;
145      begin
146         Get_Half (H1); Get_Half (H2);
147         W := H2 * 256 * 256 + H1;
148      end Get_Word;
149
150      -----------
151      -- Reset --
152      -----------
153
154      procedure Reset is
155      begin
156         Offset := 0;
157         Byte_IO.Reset (File);
158      end Reset;
159
160      ---------------
161      -- Skip_Half --
162      ---------------
163
164      procedure Skip_Half is
165         B : Byte;
166         pragma Unreferenced (B);
167      begin
168         Byte_IO.Read (File, B);
169         Byte_IO.Read (File, B);
170         Offset := Offset + 2;
171      end Skip_Half;
172
173   --  Start of processing for Process
174
175   begin
176      --  Open the object file with Byte_IO. Return with Success = False if
177      --  this fails.
178
179      begin
180         Open (File, In_File, Object_File);
181      exception
182         when others =>
183            Put_Line
184              ("*** Unable to open object file """ & Object_File & """");
185            Success := False;
186            return;
187      end;
188
189      --  Assume that the object file has a correct format
190
191      Success := True;
192
193      --  Skip ELF identification
194
195      while Offset < 16 loop
196         Get_Byte (B);
197      end loop;
198
199      --  Skip e_type
200
201      Skip_Half;
202
203      --  Skip e_machine
204
205      Skip_Half;
206
207      --  Skip e_version
208
209      Get_Word (W);
210
211      --  Skip e_entry
212
213      for J in 1 .. 8 loop
214         Get_Byte (B);
215      end loop;
216
217      --  Skip e_phoff
218
219      for J in 1 .. 8 loop
220         Get_Byte (B);
221      end loop;
222
223      Get_Word (Shoff);
224
225      --  Skip upper half of Shoff
226
227      for J in 1 .. 4 loop
228         Get_Byte (B);
229      end loop;
230
231      --  Skip e_flags
232
233      Get_Word (W);
234
235      --  Skip e_ehsize
236
237      Skip_Half;
238
239      --  Skip e_phentsize
240
241      Skip_Half;
242
243      --  Skip e_phnum
244
245      Skip_Half;
246
247      Get_Half (Shentsize);
248
249      Get_Half (Shnum);
250
251      Section_Headers := new Section_Header_Array (0 .. Shnum - 1);
252
253      --  Go to Section Headers
254
255      while Offset < Shoff loop
256         Get_Byte (B);
257      end loop;
258
259      --  Reset Symtab_Index
260
261      Symtab_Index := 0;
262
263      for J in Section_Headers'Range loop
264
265         --  Get the data for each Section Header
266
267         Get_Word (Shname);
268         Get_Word (Shtype);
269
270         for K in 1 .. 16 loop
271            Get_Byte (B);
272         end loop;
273
274         Get_Word (Shoffset);
275         Get_Word (W);
276
277         Get_Word (Shsize);
278         Get_Word (W);
279
280         Get_Word (Shlink);
281
282         while (Offset - Shoff) mod Shentsize /= 0 loop
283            Get_Byte (B);
284         end loop;
285
286         --  If this is the Symbol Table Section Header, record its index
287
288         if Shtype = 2 then
289            Symtab_Index := J;
290         end if;
291
292         Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink);
293      end loop;
294
295      if Symtab_Index = 0 then
296         Success := False;
297         return;
298      end if;
299
300      End_Symtab :=
301        Section_Headers (Symtab_Index).Shoffset +
302        Section_Headers (Symtab_Index).Shsize;
303
304      String_Table_Index := Section_Headers (Symtab_Index).Shlink;
305      Strings :=
306        new String_Array (1 .. Section_Headers (String_Table_Index).Shsize);
307
308      --  Go get the String Table section for the Symbol Table
309
310      Reset;
311
312      while Offset < Section_Headers (String_Table_Index).Shoffset loop
313         Get_Byte (B);
314      end loop;
315
316      Offset := 0;
317
318      Get_Byte (B);  --  zero
319
320      while Offset < Section_Headers (String_Table_Index).Shsize loop
321         Str_Last := 0;
322
323         loop
324            Get_Byte (B);
325            if B /= ASCII.NUL then
326               Str_Last := Str_Last + 1;
327               Str (Str_Last) := B;
328
329            else
330               Strings (Offset - Str_Last - 1) :=
331                 new String'(Str (1 .. Str_Last));
332               exit;
333            end if;
334         end loop;
335      end loop;
336
337      --  Go get the Symbol Table
338
339      Reset;
340
341      while Offset < Section_Headers (Symtab_Index).Shoffset loop
342         Get_Byte (B);
343      end loop;
344
345      while Offset < End_Symtab loop
346         Get_Word (Stname);
347         Get_Byte (Stinfo);
348         Get_Byte (Stother);
349         Get_Half (Stshndx);
350         for J in 1 .. 4 loop
351            Get_Word (W);
352         end loop;
353
354         Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
355         Stbind := Integer'(Character'Pos (Stinfo)) / 16;
356         Stvis  := Integer'(Character'Pos (Stother)) mod 4;
357
358         if (Sttype = 1 or else Sttype = 2)
359              and then Stbind /= 0
360              and then Stshndx /= 0
361              and then Stvis /= STV_Internal
362              and then Stvis /= STV_Hidden
363         then
364            --  Check if this is a symbol from a generic body
365
366            OK := True;
367
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'
372               then
373                  OK := False;
374                  exit;
375               end if;
376            end loop;
377
378            if OK then
379               declare
380                  S_Data : Symbol_Data;
381               begin
382                  S_Data.Name := new String'(Strings (Stname).all);
383
384                  if Sttype = 1 then
385                     S_Data.Kind := Data;
386
387                  else
388                     S_Data.Kind := Proc;
389                  end if;
390
391                  --  Put the new symbol in the table
392
393                  Symbol_Table.Append (Complete_Symbols, S_Data);
394               end;
395            end if;
396         end if;
397      end loop;
398
399      --  The object file has been processed, close it
400
401      Close (File);
402
403      --  Free the allocated memory
404
405      Free (Section_Headers);
406
407      for J in Strings'Range loop
408         if Strings (J) /= null then
409            Free (Strings (J));
410         end if;
411      end loop;
412
413      Free (Strings);
414
415   exception
416      --  For any exception, output an error message, close the object file
417      --  and return with Success = False.
418
419      when Ada.IO_Exceptions.End_Error =>
420         Close (File);
421
422      when X : others =>
423         Put_Line ("unexpected exception raised while processing """
424                   & Object_File & """");
425         Put_Line (Exception_Information (X));
426         Close (File);
427         Success := False;
428   end Process;
429
430end Processing;
431