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) 2003-2010, 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 Alpha version of this package
29 package body Processing
is
31 type Number
is mod 2**16;
32 -- 16 bits unsigned number for number of characters
34 EMH
: constant Number
:= 8;
35 -- Code for the Module Header section
37 GSD
: constant Number
:= 10;
38 -- Code for the Global Symbol Definition section
40 C_SYM
: constant Number
:= 1;
41 -- Code for a Symbol subsection
43 V_DEF_Mask
: constant Number
:= 2 ** 1;
44 V_NORM_Mask
: constant Number
:= 2 ** 6;
49 Number_Of_Characters
: Natural := 0;
50 -- The number of characters of each section
52 Native_Format
: Boolean;
53 -- True if records are decoded by the system (like on VMS)
56 -- If true, a pad byte must be skipped before reading the next record
58 -- The following variables are used by procedure Process when reading an
62 Length
: Natural := 0;
66 Nchars
: Natural := 0;
69 Symbol
: String (1 .. 255);
72 procedure Get
(N
: out Number
);
73 -- Read two bytes from the object file LSB first as unsigned 16 bit number
75 procedure Get
(N
: out Natural);
76 -- Read two bytes from the object file, LSByte first, as a Natural
82 procedure Get
(N
: out Number
) is
87 LSByte
:= Byte
'Pos (C
);
89 N
:= LSByte
+ (256 * Byte
'Pos (C
));
92 procedure Get
(N
: out Natural) is
96 N
:= Natural (Result
);
104 (Object_File
: String;
105 Success
: out Boolean)
107 OK
: Boolean := True;
110 -- Open the object file with Byte_IO. Return with Success = False if
114 Open
(File
, In_File
, Object_File
);
118 ("*** Unable to open object file """ & Object_File
& """");
123 -- Assume that the object file has a correct format
127 -- Check the file format in case of cross-tool
130 Get
(Number_Of_Characters
);
133 if Code
= Dummy
and then Number_Of_Characters
= Natural (EMH
) then
135 -- Looks like a cross tool
137 Native_Format
:= False;
138 Number_Of_Characters
:= Natural (Dummy
) - 4;
139 Has_Pad
:= (Number_Of_Characters
mod 2) = 1;
141 elsif Code
= EMH
then
142 Native_Format
:= True;
143 Number_Of_Characters
:= Number_Of_Characters
- 6;
147 Put_Line
("file """ & Object_File
& """ is not an object file");
153 -- Skip the EMH section
155 for J
in 1 .. Number_Of_Characters
loop
159 -- Get the different sections one by one from the object file
161 while not End_Of_File
(File
) loop
163 if not Native_Format
then
165 -- Skip pad byte if present
171 -- Skip record length
177 Get
(Number_Of_Characters
);
179 if not Native_Format
then
180 if Natural (Dummy
) /= Number_Of_Characters
then
184 raise Constraint_Error
;
187 Has_Pad
:= (Number_Of_Characters
mod 2) = 1;
190 -- The header is 4 bytes length
192 Number_Of_Characters
:= Number_Of_Characters
- 4;
194 -- If this is not a Global Symbol Definition section, skip to the
198 for J
in 1 .. Number_Of_Characters
loop
203 -- Skip over the next 4 bytes
207 Number_Of_Characters
:= Number_Of_Characters
- 4;
209 -- Get each subsection in turn
216 Number_Of_Characters
:= Number_Of_Characters
- 8;
217 Nchars
:= Nchars
- 8;
219 -- If this is a symbol and the V_DEF flag is set, get symbol
221 if Code
= C_SYM
and then ((Flags
and V_DEF_Mask
) /= 0) then
223 -- First, reach the symbol length
225 for J
in 1 .. 25 loop
227 Nchars
:= Nchars
- 1;
228 Number_Of_Characters
:= Number_Of_Characters
- 1;
231 Length
:= Byte
'Pos (B
);
234 -- Get the symbol characters
236 for J
in 1 .. Nchars
loop
238 Number_Of_Characters
:= Number_Of_Characters
- 1;
243 Length
:= Length
- 1;
247 -- Check if it is a symbol from a generic body
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'
262 -- Create the new Symbol
265 S_Data
: Symbol_Data
;
268 S_Data
.Name
:= new String'(Symbol (1 .. LSymb));
270 -- The symbol kind (Data or Procedure) depends on the
273 if (Flags and V_NORM_Mask) = 0 then
279 -- Put the new symbol in the table
281 Symbol_Table.Append (Complete_Symbols, S_Data);
286 -- As it is not a symbol subsection, skip to the next
289 for J in 1 .. Nchars loop
291 Number_Of_Characters := Number_Of_Characters - 1;
295 -- Exit the GSD section when number of characters reaches zero
297 exit when Number_Of_Characters = 0;
302 -- The object file has been processed, close it
307 -- For any exception, output an error message, close the object file
308 -- and return with Success = False.
311 Put_Line ("unexpected exception raised while processing """
312 & Object_File & """");
313 Put_Line (Exception_Information (X));