------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
-- --
|
-- --
|
-- GNAT COMPILER COMPONENTS --
|
-- GNAT COMPILER COMPONENTS --
|
-- --
|
-- --
|
-- S Y M B O L S . P R O C E S S I N G --
|
-- S Y M B O L S . P R O C E S S I N G --
|
-- --
|
-- --
|
-- B o d y --
|
-- B o d y --
|
-- --
|
-- --
|
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
|
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
|
-- --
|
-- --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- 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- --
|
-- 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- --
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
-- 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 --
|
-- 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 --
|
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
-- --
|
-- --
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
-- --
|
-- --
|
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
|
|
-- This is the VMS Alpha version of this package
|
-- This is the VMS Alpha version of this package
|
|
|
separate (Symbols)
|
separate (Symbols)
|
package body Processing is
|
package body Processing is
|
|
|
type Number is mod 2**16;
|
type Number is mod 2**16;
|
-- 16 bits unsigned number for number of characters
|
-- 16 bits unsigned number for number of characters
|
|
|
GSD : constant Number := 10;
|
GSD : constant Number := 10;
|
-- Code for the Global Symbol Definition section
|
-- Code for the Global Symbol Definition section
|
|
|
C_SYM : constant Number := 1;
|
C_SYM : constant Number := 1;
|
-- Code for a Symbol subsection
|
-- Code for a Symbol subsection
|
|
|
V_DEF_Mask : constant Number := 2**1;
|
V_DEF_Mask : constant Number := 2**1;
|
V_NORM_Mask : constant Number := 2**6;
|
V_NORM_Mask : constant Number := 2**6;
|
|
|
B : Byte;
|
B : Byte;
|
|
|
Number_Of_Characters : Natural := 0;
|
Number_Of_Characters : Natural := 0;
|
-- The number of characters of each section
|
-- The number of characters of each section
|
|
|
-- The following variables are used by procedure Process when reading an
|
-- The following variables are used by procedure Process when reading an
|
-- object file.
|
-- object file.
|
|
|
Code : Number := 0;
|
Code : Number := 0;
|
Length : Natural := 0;
|
Length : Natural := 0;
|
|
|
Dummy : Number;
|
Dummy : Number;
|
|
|
Nchars : Natural := 0;
|
Nchars : Natural := 0;
|
Flags : Number := 0;
|
Flags : Number := 0;
|
|
|
Symbol : String (1 .. 255);
|
Symbol : String (1 .. 255);
|
LSymb : Natural;
|
LSymb : Natural;
|
|
|
procedure Get (N : out Number);
|
procedure Get (N : out Number);
|
-- Read two bytes from the object file LSB first as unsigned 16 bit number
|
-- Read two bytes from the object file LSB first as unsigned 16 bit number
|
|
|
procedure Get (N : out Natural);
|
procedure Get (N : out Natural);
|
-- Read two bytes from the object file, LSByte first, as a Natural
|
-- Read two bytes from the object file, LSByte first, as a Natural
|
|
|
---------
|
---------
|
-- Get --
|
-- Get --
|
---------
|
---------
|
|
|
procedure Get (N : out Number) is
|
procedure Get (N : out Number) is
|
C : Byte;
|
C : Byte;
|
LSByte : Number;
|
LSByte : Number;
|
begin
|
begin
|
Read (File, C);
|
Read (File, C);
|
LSByte := Byte'Pos (C);
|
LSByte := Byte'Pos (C);
|
Read (File, C);
|
Read (File, C);
|
N := LSByte + (256 * Byte'Pos (C));
|
N := LSByte + (256 * Byte'Pos (C));
|
end Get;
|
end Get;
|
|
|
procedure Get (N : out Natural) is
|
procedure Get (N : out Natural) is
|
Result : Number;
|
Result : Number;
|
begin
|
begin
|
Get (Result);
|
Get (Result);
|
N := Natural (Result);
|
N := Natural (Result);
|
end Get;
|
end Get;
|
|
|
-------------
|
-------------
|
-- Process --
|
-- Process --
|
-------------
|
-------------
|
|
|
procedure Process
|
procedure Process
|
(Object_File : String;
|
(Object_File : String;
|
Success : out Boolean)
|
Success : out Boolean)
|
is
|
is
|
OK : Boolean := True;
|
OK : Boolean := True;
|
|
|
begin
|
begin
|
-- Open the object file with Byte_IO. Return with Success = False if
|
-- Open the object file with Byte_IO. Return with Success = False if
|
-- this fails.
|
-- this fails.
|
|
|
begin
|
begin
|
Open (File, In_File, Object_File);
|
Open (File, In_File, Object_File);
|
exception
|
exception
|
when others =>
|
when others =>
|
Put_Line
|
Put_Line
|
("*** Unable to open object file """ & Object_File & """");
|
("*** Unable to open object file """ & Object_File & """");
|
Success := False;
|
Success := False;
|
return;
|
return;
|
end;
|
end;
|
|
|
-- Assume that the object file has a correct format
|
-- Assume that the object file has a correct format
|
|
|
Success := True;
|
Success := True;
|
|
|
-- Get the different sections one by one from the object file
|
-- Get the different sections one by one from the object file
|
|
|
while not End_Of_File (File) loop
|
while not End_Of_File (File) loop
|
|
|
Get (Code);
|
Get (Code);
|
Get (Number_Of_Characters);
|
Get (Number_Of_Characters);
|
Number_Of_Characters := Number_Of_Characters - 4;
|
Number_Of_Characters := Number_Of_Characters - 4;
|
|
|
-- If this is not a Global Symbol Definition section, skip to the
|
-- If this is not a Global Symbol Definition section, skip to the
|
-- next section.
|
-- next section.
|
|
|
if Code /= GSD then
|
if Code /= GSD then
|
|
|
for J in 1 .. Number_Of_Characters loop
|
for J in 1 .. Number_Of_Characters loop
|
Read (File, B);
|
Read (File, B);
|
end loop;
|
end loop;
|
|
|
else
|
else
|
|
|
-- Skip over the next 4 bytes
|
-- Skip over the next 4 bytes
|
|
|
Get (Dummy);
|
Get (Dummy);
|
Get (Dummy);
|
Get (Dummy);
|
Number_Of_Characters := Number_Of_Characters - 4;
|
Number_Of_Characters := Number_Of_Characters - 4;
|
|
|
-- Get each subsection in turn
|
-- Get each subsection in turn
|
|
|
loop
|
loop
|
Get (Code);
|
Get (Code);
|
Get (Nchars);
|
Get (Nchars);
|
Get (Dummy);
|
Get (Dummy);
|
Get (Flags);
|
Get (Flags);
|
Number_Of_Characters := Number_Of_Characters - 8;
|
Number_Of_Characters := Number_Of_Characters - 8;
|
Nchars := Nchars - 8;
|
Nchars := Nchars - 8;
|
|
|
-- If this is a symbol and the V_DEF flag is set, get the
|
-- If this is a symbol and the V_DEF flag is set, get the
|
-- symbol.
|
-- symbol.
|
|
|
if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
|
if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
|
-- First, reach the symbol length
|
-- First, reach the symbol length
|
|
|
for J in 1 .. 25 loop
|
for J in 1 .. 25 loop
|
Read (File, B);
|
Read (File, B);
|
Nchars := Nchars - 1;
|
Nchars := Nchars - 1;
|
Number_Of_Characters := Number_Of_Characters - 1;
|
Number_Of_Characters := Number_Of_Characters - 1;
|
end loop;
|
end loop;
|
|
|
Length := Byte'Pos (B);
|
Length := Byte'Pos (B);
|
LSymb := 0;
|
LSymb := 0;
|
|
|
-- Get the symbol characters
|
-- Get the symbol characters
|
|
|
for J in 1 .. Nchars loop
|
for J in 1 .. Nchars loop
|
Read (File, B);
|
Read (File, B);
|
Number_Of_Characters := Number_Of_Characters - 1;
|
Number_Of_Characters := Number_Of_Characters - 1;
|
if Length > 0 then
|
if Length > 0 then
|
LSymb := LSymb + 1;
|
LSymb := LSymb + 1;
|
Symbol (LSymb) := B;
|
Symbol (LSymb) := B;
|
Length := Length - 1;
|
Length := Length - 1;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
-- Check if it is a symbol from a generic body
|
-- Check if it is a symbol from a generic body
|
|
|
OK := True;
|
OK := True;
|
|
|
for J in 1 .. LSymb - 2 loop
|
for J in 1 .. LSymb - 2 loop
|
if Symbol (J) = 'G' and then Symbol (J + 1) = 'P'
|
if Symbol (J) = 'G' and then Symbol (J + 1) = 'P'
|
and then Symbol (J + 2) in '0' .. '9'
|
and then Symbol (J + 2) in '0' .. '9'
|
then
|
then
|
OK := False;
|
OK := False;
|
exit;
|
exit;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
if OK then
|
if OK then
|
|
|
-- Create the new Symbol
|
-- Create the new Symbol
|
|
|
declare
|
declare
|
S_Data : Symbol_Data;
|
S_Data : Symbol_Data;
|
|
|
begin
|
begin
|
S_Data.Name := new String'(Symbol (1 .. LSymb));
|
S_Data.Name := new String'(Symbol (1 .. LSymb));
|
|
|
-- The symbol kind (Data or Procedure) depends on the
|
-- The symbol kind (Data or Procedure) depends on the
|
-- V_NORM flag.
|
-- V_NORM flag.
|
|
|
if (Flags and V_NORM_Mask) = 0 then
|
if (Flags and V_NORM_Mask) = 0 then
|
S_Data.Kind := Data;
|
S_Data.Kind := Data;
|
|
|
else
|
else
|
S_Data.Kind := Proc;
|
S_Data.Kind := Proc;
|
end if;
|
end if;
|
|
|
-- Put the new symbol in the table
|
-- Put the new symbol in the table
|
|
|
Symbol_Table.Append (Complete_Symbols, S_Data);
|
Symbol_Table.Append (Complete_Symbols, S_Data);
|
end;
|
end;
|
end if;
|
end if;
|
|
|
else
|
else
|
-- As it is not a symbol subsection, skip to the next
|
-- As it is not a symbol subsection, skip to the next
|
-- subsection.
|
-- subsection.
|
|
|
for J in 1 .. Nchars loop
|
for J in 1 .. Nchars loop
|
Read (File, B);
|
Read (File, B);
|
Number_Of_Characters := Number_Of_Characters - 1;
|
Number_Of_Characters := Number_Of_Characters - 1;
|
end loop;
|
end loop;
|
end if;
|
end if;
|
|
|
-- Exit the GSD section when number of characters reaches 0
|
-- Exit the GSD section when number of characters reaches 0
|
|
|
exit when Number_Of_Characters = 0;
|
exit when Number_Of_Characters = 0;
|
end loop;
|
end loop;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
-- The object file has been processed, close it
|
-- The object file has been processed, close it
|
|
|
Close (File);
|
Close (File);
|
|
|
exception
|
exception
|
-- For any exception, output an error message, close the object file
|
-- For any exception, output an error message, close the object file
|
-- and return with Success = False.
|
-- and return with Success = False.
|
|
|
when X : others =>
|
when X : others =>
|
Put_Line ("unexpected exception raised while processing """
|
Put_Line ("unexpected exception raised while processing """
|
& Object_File & """");
|
& Object_File & """");
|
Put_Line (Exception_Information (X));
|
Put_Line (Exception_Information (X));
|
Close (File);
|
Close (File);
|
Success := False;
|
Success := False;
|
end Process;
|
end Process;
|
|
|
end Processing;
|
end Processing;
|
|
|
