summaryrefslogtreecommitdiff
path: root/gcc/ada/symbols-processing-vms-ia64.adb
blob: beb099e40b098926fb575af9016c75fe5c7d04c7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                    S Y M B O L S . P R O C E S S I N G                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2004-2009, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

--  This is the VMS/IA64 version of this package

with Ada.IO_Exceptions;

with Ada.Unchecked_Deallocation;

separate (Symbols)
package body Processing is

   type String_Array is array (Positive range <>) of String_Access;
   type Strings_Ptr is access String_Array;

   procedure Free is
     new Ada.Unchecked_Deallocation (String_Array, Strings_Ptr);

   type Section_Header is record
      Shname   : Integer;
      Shtype   : Integer;
      Shoffset : Integer;
      Shsize   : Integer;
      Shlink   : Integer;
   end record;

   type Section_Header_Array is array (Natural range <>) of Section_Header;
   type Section_Header_Ptr is access Section_Header_Array;

   procedure Free is
     new Ada.Unchecked_Deallocation (Section_Header_Array, Section_Header_Ptr);

   -------------
   -- Process --
   -------------

   procedure Process
     (Object_File : String;
      Success     : out Boolean)
   is
      B : Byte;
      W : Integer;

      Str : String (1 .. 1000) := (others => ' ');
      Str_Last : Natural;

      Strings : Strings_Ptr;

      Shoff : Integer;
      Shnum : Integer;
      Shentsize : Integer;

      Shname   : Integer;
      Shtype   : Integer;
      Shoffset : Integer;
      Shsize   : Integer;
      Shlink   : Integer;

      Symtab_Index       : Natural := 0;
      String_Table_Index : Natural := 0;

      End_Symtab : Integer;

      Stname  : Integer;
      Stinfo  : Character;
      Stother : Character;
      Sttype  : Integer;
      Stbind  : Integer;
      Stshndx : Integer;
      Stvis   : Integer;

      STV_Internal : constant := 1;
      STV_Hidden   : constant := 2;

      Section_Headers : Section_Header_Ptr;

      Offset : Natural := 0;
      OK     : Boolean := True;

      procedure Get_Byte (B : out Byte);
      --  Read one byte from the object file

      procedure Get_Half (H : out Integer);
      --  Read one half work from the object file

      procedure Get_Word (W : out Integer);
      --  Read one full word from the object file

      procedure Reset;
      --  Restart reading the object file

      procedure Skip_Half;
      --  Read and disregard one half word from the object file

      --------------
      -- Get_Byte --
      --------------

      procedure Get_Byte (B : out Byte) is
      begin
         Byte_IO.Read (File, B);
         Offset := Offset + 1;
      end Get_Byte;

      --------------
      -- Get_Half --
      --------------

      procedure Get_Half (H : out Integer) is
         C1, C2 : Character;
      begin
         Get_Byte (C1); Get_Byte (C2);
         H :=
           Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1));
      end Get_Half;

      --------------
      -- Get_Word --
      --------------

      procedure Get_Word (W : out Integer) is
         H1, H2 : Integer;
      begin
         Get_Half (H1); Get_Half (H2);
         W := H2 * 256 * 256 + H1;
      end Get_Word;

      -----------
      -- Reset --
      -----------

      procedure Reset is
      begin
         Offset := 0;
         Byte_IO.Reset (File);
      end Reset;

      ---------------
      -- Skip_Half --
      ---------------

      procedure Skip_Half is
         B : Byte;
         pragma Unreferenced (B);
      begin
         Byte_IO.Read (File, B);
         Byte_IO.Read (File, B);
         Offset := Offset + 2;
      end Skip_Half;

   --  Start of processing for Process

   begin
      --  Open the object file with Byte_IO. Return with Success = False if
      --  this fails.

      begin
         Open (File, In_File, Object_File);
      exception
         when others =>
            Put_Line
              ("*** Unable to open object file """ & Object_File & """");
            Success := False;
            return;
      end;

      --  Assume that the object file has a correct format

      Success := True;

      --  Skip ELF identification

      while Offset < 16 loop
         Get_Byte (B);
      end loop;

      --  Skip e_type

      Skip_Half;

      --  Skip e_machine

      Skip_Half;

      --  Skip e_version

      Get_Word (W);

      --  Skip e_entry

      for J in 1 .. 8 loop
         Get_Byte (B);
      end loop;

      --  Skip e_phoff

      for J in 1 .. 8 loop
         Get_Byte (B);
      end loop;

      Get_Word (Shoff);

      --  Skip upper half of Shoff

      for J in 1 .. 4 loop
         Get_Byte (B);
      end loop;

      --  Skip e_flags

      Get_Word (W);

      --  Skip e_ehsize

      Skip_Half;

      --  Skip e_phentsize

      Skip_Half;

      --  Skip e_phnum

      Skip_Half;

      Get_Half (Shentsize);

      Get_Half (Shnum);

      Section_Headers := new Section_Header_Array (0 .. Shnum - 1);

      --  Go to Section Headers

      while Offset < Shoff loop
         Get_Byte (B);
      end loop;

      --  Reset Symtab_Index

      Symtab_Index := 0;

      for J in Section_Headers'Range loop

         --  Get the data for each Section Header

         Get_Word (Shname);
         Get_Word (Shtype);

         for K in 1 .. 16 loop
            Get_Byte (B);
         end loop;

         Get_Word (Shoffset);
         Get_Word (W);

         Get_Word (Shsize);
         Get_Word (W);

         Get_Word (Shlink);

         while (Offset - Shoff) mod Shentsize /= 0 loop
            Get_Byte (B);
         end loop;

         --  If this is the Symbol Table Section Header, record its index

         if Shtype = 2 then
            Symtab_Index := J;
         end if;

         Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink);
      end loop;

      if Symtab_Index = 0 then
         Success := False;
         return;
      end if;

      End_Symtab :=
        Section_Headers (Symtab_Index).Shoffset +
        Section_Headers (Symtab_Index).Shsize;

      String_Table_Index := Section_Headers (Symtab_Index).Shlink;
      Strings :=
        new String_Array (1 .. Section_Headers (String_Table_Index).Shsize);

      --  Go get the String Table section for the Symbol Table

      Reset;

      while Offset < Section_Headers (String_Table_Index).Shoffset loop
         Get_Byte (B);
      end loop;

      Offset := 0;

      Get_Byte (B);  --  zero

      while Offset < Section_Headers (String_Table_Index).Shsize loop
         Str_Last := 0;

         loop
            Get_Byte (B);
            if B /= ASCII.NUL then
               Str_Last := Str_Last + 1;
               Str (Str_Last) := B;

            else
               Strings (Offset - Str_Last - 1) :=
                 new String'(Str (1 .. Str_Last));
               exit;
            end if;
         end loop;
      end loop;

      --  Go get the Symbol Table

      Reset;

      while Offset < Section_Headers (Symtab_Index).Shoffset loop
         Get_Byte (B);
      end loop;

      while Offset < End_Symtab loop
         Get_Word (Stname);
         Get_Byte (Stinfo);
         Get_Byte (Stother);
         Get_Half (Stshndx);
         for J in 1 .. 4 loop
            Get_Word (W);
         end loop;

         Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
         Stbind := Integer'(Character'Pos (Stinfo)) / 16;
         Stvis  := Integer'(Character'Pos (Stother)) mod 4;

         if (Sttype = 1 or else Sttype = 2)
              and then Stbind /= 0
              and then Stshndx /= 0
              and then Stvis /= STV_Internal
              and then Stvis /= STV_Hidden
         then
            --  Check if this is a symbol from a generic body

            OK := True;

            for J in Strings (Stname)'First .. Strings (Stname)'Last - 2 loop
               if Strings (Stname) (J) = 'G'
                 and then Strings (Stname) (J + 1) = 'P'
                 and then Strings (Stname) (J + 2) in '0' .. '9'
               then
                  OK := False;
                  exit;
               end if;
            end loop;

            if OK then
               declare
                  S_Data : Symbol_Data;
               begin
                  S_Data.Name := new String'(Strings (Stname).all);

                  if Sttype = 1 then
                     S_Data.Kind := Data;

                  else
                     S_Data.Kind := Proc;
                  end if;

                  --  Put the new symbol in the table

                  Symbol_Table.Append (Complete_Symbols, S_Data);
               end;
            end if;
         end if;
      end loop;

      --  The object file has been processed, close it

      Close (File);

      --  Free the allocated memory

      Free (Section_Headers);

      for J in Strings'Range loop
         if Strings (J) /= null then
            Free (Strings (J));
         end if;
      end loop;

      Free (Strings);

   exception
      --  For any exception, output an error message, close the object file
      --  and return with Success = False.

      when Ada.IO_Exceptions.End_Error =>
         Close (File);

      when X : others =>
         Put_Line ("unexpected exception raised while processing """
                   & Object_File & """");
         Put_Line (Exception_Information (X));
         Close (File);
         Success := False;
   end Process;

end Processing;