431 lines
11 KiB
Ada
431 lines
11 KiB
Ada
|
------------------------------------------------------------------------------
|
||
|
-- --
|
||
|
-- 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;
|