URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [symbols-processing-vms-alpha.adb] - Blame information for rev 729

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         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) 2003-2010, 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 Alpha version of this package
 
separate (Symbols)
package body Processing is
 
   type Number is mod 2**16;
   --  16 bits unsigned number for number of characters
 
   EMH : constant Number := 8;
   --  Code for the Module Header section
 
   GSD : constant Number := 10;
   --  Code for the Global Symbol Definition section
 
   C_SYM : constant Number := 1;
   --  Code for a Symbol subsection
 
   V_DEF_Mask  : constant Number := 2 ** 1;
   V_NORM_Mask : constant Number := 2 ** 6;
   --  Comments ???
 
   B : Byte;
 
   Number_Of_Characters : Natural := 0;
   --  The number of characters of each section
 
   Native_Format : Boolean;
   --  True if records are decoded by the system (like on VMS)
 
   Has_Pad : Boolean;
   --  If true, a pad byte must be skipped before reading the next record
 
   --  The following variables are used by procedure Process when reading an
   --  object file.
 
   Code   : Number := 0;
   Length : Natural := 0;
 
   Dummy : Number;
 
   Nchars : Natural := 0;
   Flags  : Number  := 0;
 
   Symbol : String (1 .. 255);
   LSymb  : Natural;
 
   procedure Get (N : out Number);
   --  Read two bytes from the object file LSB first as unsigned 16 bit number
 
   procedure Get (N : out Natural);
   --  Read two bytes from the object file, LSByte first, as a Natural
 
   ---------
   -- Get --
   ---------
 
   procedure Get (N : out Number) is
      C : Byte;
      LSByte : Number;
   begin
      Read (File, C);
      LSByte := Byte'Pos (C);
      Read (File, C);
      N := LSByte + (256 * Byte'Pos (C));
   end Get;
 
   procedure Get (N : out Natural) is
      Result : Number;
   begin
      Get (Result);
      N := Natural (Result);
   end Get;
 
   -------------
   -- Process --
   -------------
 
   procedure Process
     (Object_File : String;
      Success     : out Boolean)
   is
      OK : Boolean := True;
 
   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;
 
      --  Check the file format in case of cross-tool
 
      Get (Code);
      Get (Number_Of_Characters);
      Get (Dummy);
 
      if Code = Dummy and then Number_Of_Characters = Natural (EMH) then
 
         --  Looks like a cross tool
 
         Native_Format := False;
         Number_Of_Characters := Natural (Dummy) - 4;
         Has_Pad := (Number_Of_Characters mod 2) = 1;
 
      elsif Code = EMH then
         Native_Format := True;
         Number_Of_Characters := Number_Of_Characters - 6;
         Has_Pad := False;
 
      else
         Put_Line ("file """ & Object_File & """ is not an object file");
         Close (File);
         Success := False;
         return;
      end if;
 
      --  Skip the EMH section
 
      for J in 1 .. Number_Of_Characters loop
         Read (File, B);
      end loop;
 
      --  Get the different sections one by one from the object file
 
      while not End_Of_File (File) loop
 
         if not Native_Format then
 
            --  Skip pad byte if present
 
            if Has_Pad then
               Get (B);
            end if;
 
            --  Skip record length
 
            Get (Dummy);
         end if;
 
         Get (Code);
         Get (Number_Of_Characters);
 
         if not Native_Format then
            if Natural (Dummy) /= Number_Of_Characters then
 
               --  Format error
 
               raise Constraint_Error;
            end if;
 
            Has_Pad := (Number_Of_Characters mod 2) = 1;
         end if;
 
         --  The header is 4 bytes length
 
         Number_Of_Characters := Number_Of_Characters - 4;
 
         --  If this is not a Global Symbol Definition section, skip to the
         --  next section.
 
         if Code /= GSD then
            for J in 1 .. Number_Of_Characters loop
               Read (File, B);
            end loop;
 
         else
            --  Skip over the next 4 bytes
 
            Get (Dummy);
            Get (Dummy);
            Number_Of_Characters := Number_Of_Characters - 4;
 
            --  Get each subsection in turn
 
            loop
               Get (Code);
               Get (Nchars);
               Get (Dummy);
               Get (Flags);
               Number_Of_Characters := Number_Of_Characters - 8;
               Nchars := Nchars - 8;
 
               --  If this is a symbol and the V_DEF flag is set, get symbol
 
               if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
 
                  --  First, reach the symbol length
 
                  for J in 1 .. 25 loop
                     Read (File, B);
                     Nchars := Nchars - 1;
                     Number_Of_Characters := Number_Of_Characters - 1;
                  end loop;
 
                  Length := Byte'Pos (B);
                  LSymb := 0;
 
                  --  Get the symbol characters
 
                  for J in 1 .. Nchars loop
                     Read (File, B);
                     Number_Of_Characters := Number_Of_Characters - 1;
 
                     if Length > 0 then
                        LSymb := LSymb + 1;
                        Symbol (LSymb) := B;
                        Length := Length - 1;
                     end if;
                  end loop;
 
                  --  Check if it is a symbol from a generic body
 
                  OK := True;
 
                  for J in 1 .. LSymb - 2 loop
                     if Symbol (J) = 'G' and then Symbol (J + 1) = 'P'
                       and then Symbol (J + 2) in '0' .. '9'
                     then
                        OK := False;
                        exit;
                     end if;
                  end loop;
 
                  if OK then
 
                     --  Create the new Symbol
 
                     declare
                        S_Data : Symbol_Data;
 
                     begin
                        S_Data.Name := new String'(Symbol (1 .. LSymb));
 
                        --  The symbol kind (Data or Procedure) depends on the
                        --  V_NORM flag.
 
                        if (Flags and V_NORM_Mask) = 0 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;
 
               else
                  --  As it is not a symbol subsection, skip to the next
                  --  subsection.
 
                  for J in 1 .. Nchars loop
                     Read (File, B);
                     Number_Of_Characters := Number_Of_Characters - 1;
                  end loop;
               end if;
 
               --  Exit the GSD section when number of characters reaches zero
 
               exit when Number_Of_Characters = 0;
            end loop;
         end if;
      end loop;
 
      --  The object file has been processed, close it
 
      Close (File);
 
   exception
      --  For any exception, output an error message, close the object file
      --  and return with Success = False.
 
      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;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [symbols-processing-vms-alpha.adb] - Blame information for rev 729

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
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
28			`separate (Symbols)`
29			`package 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
318			`end Processing;`