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) 2003-2010, 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 Alpha version of this package
27
28separate (Symbols)
29package body Processing is
30
31   type Number is mod 2**16;
32   --  16 bits unsigned number for number of characters
33
34   EMH : constant Number := 8;
35   --  Code for the Module Header section
36
37   GSD : constant Number := 10;
38   --  Code for the Global Symbol Definition section
39
40   C_SYM : constant Number := 1;
41   --  Code for a Symbol subsection
42
43   V_DEF_Mask  : constant Number := 2 ** 1;
44   V_NORM_Mask : constant Number := 2 ** 6;
45   --  Comments ???
46
47   B : Byte;
48
49   Number_Of_Characters : Natural := 0;
50   --  The number of characters of each section
51
52   Native_Format : Boolean;
53   --  True if records are decoded by the system (like on VMS)
54
55   Has_Pad : Boolean;
56   --  If true, a pad byte must be skipped before reading the next record
57
58   --  The following variables are used by procedure Process when reading an
59   --  object file.
60
61   Code   : Number := 0;
62   Length : Natural := 0;
63
64   Dummy : Number;
65
66   Nchars : Natural := 0;
67   Flags  : Number  := 0;
68
69   Symbol : String (1 .. 255);
70   LSymb  : Natural;
71
72   procedure Get (N : out Number);
73   --  Read two bytes from the object file LSB first as unsigned 16 bit number
74
75   procedure Get (N : out Natural);
76   --  Read two bytes from the object file, LSByte first, as a Natural
77
78   ---------
79   -- Get --
80   ---------
81
82   procedure Get (N : out Number) is
83      C : Byte;
84      LSByte : Number;
85   begin
86      Read (File, C);
87      LSByte := Byte'Pos (C);
88      Read (File, C);
89      N := LSByte + (256 * Byte'Pos (C));
90   end Get;
91
92   procedure Get (N : out Natural) is
93      Result : Number;
94   begin
95      Get (Result);
96      N := Natural (Result);
97   end Get;
98
99   -------------
100   -- Process --
101   -------------
102
103   procedure Process
104     (Object_File : String;
105      Success     : out Boolean)
106   is
107      OK : Boolean := True;
108
109   begin
110      --  Open the object file with Byte_IO. Return with Success = False if
111      --  this fails.
112
113      begin
114         Open (File, In_File, Object_File);
115      exception
116         when others =>
117            Put_Line
118              ("*** Unable to open object file """ & Object_File & """");
119            Success := False;
120            return;
121      end;
122
123      --  Assume that the object file has a correct format
124
125      Success := True;
126
127      --  Check the file format in case of cross-tool
128
129      Get (Code);
130      Get (Number_Of_Characters);
131      Get (Dummy);
132
133      if Code = Dummy and then Number_Of_Characters = Natural (EMH) then
134
135         --  Looks like a cross tool
136
137         Native_Format := False;
138         Number_Of_Characters := Natural (Dummy) - 4;
139         Has_Pad := (Number_Of_Characters mod 2) = 1;
140
141      elsif Code = EMH then
142         Native_Format := True;
143         Number_Of_Characters := Number_Of_Characters - 6;
144         Has_Pad := False;
145
146      else
147         Put_Line ("file """ & Object_File & """ is not an object file");
148         Close (File);
149         Success := False;
150         return;
151      end if;
152
153      --  Skip the EMH section
154
155      for J in 1 .. Number_Of_Characters loop
156         Read (File, B);
157      end loop;
158
159      --  Get the different sections one by one from the object file
160
161      while not End_Of_File (File) loop
162
163         if not Native_Format then
164
165            --  Skip pad byte if present
166
167            if Has_Pad then
168               Get (B);
169            end if;
170
171            --  Skip record length
172
173            Get (Dummy);
174         end if;
175
176         Get (Code);
177         Get (Number_Of_Characters);
178
179         if not Native_Format then
180            if Natural (Dummy) /= Number_Of_Characters then
181
182               --  Format error
183
184               raise Constraint_Error;
185            end if;
186
187            Has_Pad := (Number_Of_Characters mod 2) = 1;
188         end if;
189
190         --  The header is 4 bytes length
191
192         Number_Of_Characters := Number_Of_Characters - 4;
193
194         --  If this is not a Global Symbol Definition section, skip to the
195         --  next section.
196
197         if Code /= GSD then
198            for J in 1 .. Number_Of_Characters loop
199               Read (File, B);
200            end loop;
201
202         else
203            --  Skip over the next 4 bytes
204
205            Get (Dummy);
206            Get (Dummy);
207            Number_Of_Characters := Number_Of_Characters - 4;
208
209            --  Get each subsection in turn
210
211            loop
212               Get (Code);
213               Get (Nchars);
214               Get (Dummy);
215               Get (Flags);
216               Number_Of_Characters := Number_Of_Characters - 8;
217               Nchars := Nchars - 8;
218
219               --  If this is a symbol and the V_DEF flag is set, get symbol
220
221               if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
222
223                  --  First, reach the symbol length
224
225                  for J in 1 .. 25 loop
226                     Read (File, B);
227                     Nchars := Nchars - 1;
228                     Number_Of_Characters := Number_Of_Characters - 1;
229                  end loop;
230
231                  Length := Byte'Pos (B);
232                  LSymb := 0;
233
234                  --  Get the symbol characters
235
236                  for J in 1 .. Nchars loop
237                     Read (File, B);
238                     Number_Of_Characters := Number_Of_Characters - 1;
239
240                     if Length > 0 then
241                        LSymb := LSymb + 1;
242                        Symbol (LSymb) := B;
243                        Length := Length - 1;
244                     end if;
245                  end loop;
246
247                  --  Check if it is a symbol from a generic body
248
249                  OK := True;
250
251                  for J in 1 .. LSymb - 2 loop
252                     if Symbol (J) = 'G' and then Symbol (J + 1) = 'P'
253                       and then Symbol (J + 2) in '0' .. '9'
254                     then
255                        OK := False;
256                        exit;
257                     end if;
258                  end loop;
259
260                  if OK then
261
262                     --  Create the new Symbol
263
264                     declare
265                        S_Data : Symbol_Data;
266
267                     begin
268                        S_Data.Name := new String'(Symbol (1 .. LSymb));
269
270                        --  The symbol kind (Data or Procedure) depends on the
271                        --  V_NORM flag.
272
273                        if (Flags and V_NORM_Mask) = 0 then
274                           S_Data.Kind := Data;
275                        else
276                           S_Data.Kind := Proc;
277                        end if;
278
279                        --  Put the new symbol in the table
280
281                        Symbol_Table.Append (Complete_Symbols, S_Data);
282                     end;
283                  end if;
284
285               else
286                  --  As it is not a symbol subsection, skip to the next
287                  --  subsection.
288
289                  for J in 1 .. Nchars loop
290                     Read (File, B);
291                     Number_Of_Characters := Number_Of_Characters - 1;
292                  end loop;
293               end if;
294
295               --  Exit the GSD section when number of characters reaches zero
296
297               exit when Number_Of_Characters = 0;
298            end loop;
299         end if;
300      end loop;
301
302      --  The object file has been processed, close it
303
304      Close (File);
305
306   exception
307      --  For any exception, output an error message, close the object file
308      --  and return with Success = False.
309
310      when X : others =>
311         Put_Line ("unexpected exception raised while processing """
312                   & Object_File & """");
313         Put_Line (Exception_Information (X));
314         Close (File);
315         Success := False;
316   end Process;
317
318end Processing;
319