Commit 65b10832 by Vincent Celier Committed by Arnaud Charlet

gnatsym.adb: Adapt to modification of package Symbols...

2005-06-14  Vincent Celier  <celier@adacore.com>

	* gnatsym.adb: Adapt to modification of package Symbols: procedure
	Process is now in package Processing.

	* symbols.ads, symbols.adb:
	(Processing): New package, containing procedure Process

	* symbols-vms-alpha.adb:
	Replaced by symbols-vms.adb and symbols-processing-vms-alpha.adb

	* symbols-vms.adb, symbols-processing-vms-alpha.adb,
	symbols-processing-vms-ia64.adb: New files.

From-SVN: r101018
parent df0db19f
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2005 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- --
......@@ -253,7 +253,7 @@ begin
Write_Line ("""");
end if;
Process (Object_Files.Table (Object_File).all, Success);
Processing.Process (Object_Files.Table (Object_File).all, Success);
end loop;
-- Finalize the object file
......
------------------------------------------------------------------------------
-- --
-- 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-2005 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- 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
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;
B : Byte;
Number_Of_Characters : Natural := 0;
-- The number of characters of each section
-- 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
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;
-- Get the different sections one by one from the object file
while not End_Of_File (File) loop
Get (Code);
Get (Number_Of_Characters);
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 the
-- 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;
-- 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.Increment_Last (Complete_Symbols);
Complete_Symbols.Table
(Symbol_Table.Last (Complete_Symbols)) := S_Data;
end;
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 0
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;
------------------------------------------------------------------------------
-- --
-- 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-2005 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- 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;
H : Integer;
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;
Sttype : Integer;
Stbind : Integer;
Stshndx : Integer;
Section_Headers : Section_Header_Ptr;
Offset : Natural := 0;
procedure Get_Byte (B : out Byte);
procedure Get_Half (H : out Integer);
procedure Get_Word (W : out Integer);
procedure Reset;
procedure Get_Byte (B : out Byte) is
begin
Byte_IO.Read (File, B);
Offset := Offset + 1;
end Get_Byte;
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;
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;
procedure Reset is
begin
Offset := 0;
Byte_IO.Reset (File);
end Reset;
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
Get_Half (H);
-- Skip e_machine
Get_Half (H);
-- 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
Get_Half (H);
-- Skip e_phentsize
Get_Half (H);
-- Skip e_phnum
Get_Half (H);
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 (B);
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;
if (Sttype = 1 or else Sttype = 2)
and then Stbind /= 0
and then Stshndx /= 0
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.Increment_Last (Complete_Symbols);
Complete_Symbols.Table
(Symbol_Table.Last (Complete_Symbols)) := S_Data;
end;
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;
......@@ -36,7 +36,8 @@ package body Symbols is
Symbol_Vector : constant String := "SYMBOL_VECTOR=(";
Equal_Data : constant String := "=DATA)";
Equal_Procedure : constant String := "=PROCEDURE)";
Gsmatch : constant String := "gsmatch=lequal,";
Gsmatch : constant String := "gsmatch=";
Gsmatch_Lequal : constant String := "gsmatch=lequal,";
Symbol_File_Name : String_Access := null;
-- Name of the symbol file
......@@ -69,50 +70,12 @@ package body Symbols is
package Byte_IO is new Ada.Sequential_IO (Byte);
use Byte_IO;
type Number is mod 2**16;
-- 16 bits unsigned number for number of characters
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;
File : Byte_IO.File_Type;
-- Each object file is read as a stream of bytes (characters)
B : Byte;
Number_Of_Characters : Natural := 0;
-- The number of characters of each section
-- 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;
function Equal (Left, Right : Symbol_Data) return Boolean;
-- Test for equality of symbols
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
function Image (N : Integer) return String;
-- Returns the image of N, without the initial space
......@@ -129,27 +92,6 @@ package body Symbols is
Left.Present = Right.Present;
end Equal;
---------
-- 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;
-----------
-- Image --
-----------
......@@ -343,7 +285,7 @@ package body Symbols is
return;
end if;
-- Lines with "gsmatch=equal,<Major_ID>,<Minor_Id>
-- Lines with "gsmatch=lequal," or "gsmatch=equal,"
elsif Last > Gsmatch'Length
and then Line (1 .. Gsmatch'Length) = Gsmatch
......@@ -355,19 +297,41 @@ package body Symbols is
ID : Integer;
begin
-- First, look for the first coma
loop
if Line (Finish) not in '0' .. '9'
or else Finish >= Last - 1
then
if Start >= Last - 1 then
OK := False;
exit;
end if;
exit when Line (Finish + 1) = ',';
elsif Line (Start) = ',' then
Start := Start + 1;
exit;
Finish := Finish + 1;
else
Start := Start + 1;
end if;
end loop;
Finish := Start;
-- If the comma is found, get the Major and the Minor IDs
if OK then
loop
if Line (Finish) not in '0' .. '9'
or else Finish >= Last - 1
then
OK := False;
exit;
end if;
exit when Line (Finish + 1) = ',';
Finish := Finish + 1;
end loop;
end if;
if OK then
ID := Integer'Value (Line (Start .. Finish));
OK := ID /= 0;
......@@ -445,150 +409,11 @@ package body Symbols is
end if;
end Initialize;
-------------
-- Process --
-------------
procedure Process
(Object_File : String;
Success : out Boolean)
is
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;
-- Get the different sections one by one from the object file
while not End_Of_File (File) loop
Get (Code);
Get (Number_Of_Characters);
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 the
-- 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;
-- 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.Increment_Last (Complete_Symbols);
Complete_Symbols.Table
(Symbol_Table.Last (Complete_Symbols)) := S_Data;
end;
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 0
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.
----------------
-- Processing --
----------------
when X : others =>
Put_Line ("unexpected exception raised while processing """
& Object_File & """");
Put_Line (Exception_Information (X));
Close (File);
Success := False;
end Process;
package body Processing is separate;
--------------
-- Finalize --
......@@ -668,6 +493,11 @@ package body Symbols is
Success := False;
return;
-- Any symbol that is undefined in the reference symbol file
-- triggers an increase of the Major ID, because the new
-- version of the library is no longer compatible with
-- existing executables.
elsif Soft_Major_ID then
Major_ID := Major_ID + 1;
Minor_ID := 0;
......@@ -677,6 +507,11 @@ package body Symbols is
Original_Symbols.Table (Index_1).Present := False;
Free (Original_Symbols.Table (Index_1).Name);
if Soft_Minor_ID then
Minor_ID := Minor_ID + 1;
Soft_Minor_ID := False;
end if;
end if;
end loop;
......@@ -738,7 +573,7 @@ package body Symbols is
-- Put the version IDs
Put (File, Gsmatch);
Put (File, Gsmatch_Lequal);
Put (File, Image (Major_ID));
Put (File, ',');
Put_Line (File, Image (Minor_ID));
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2005 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- --
......@@ -54,18 +54,26 @@ package body Symbols is
Success := False;
end Initialize;
-------------
-- Process --
-------------
----------------
-- Processing --
----------------
procedure Process
(Object_File : String;
Success : out Boolean)
is
pragma Unreferenced (Object_File);
begin
Success := False;
end Process;
package body Processing is
-------------
-- Process --
-------------
procedure Process
(Object_File : String;
Success : out Boolean)
is
pragma Unreferenced (Object_File);
begin
Success := False;
end Process;
end Processing;
--------------
-- Finalize --
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2003-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2005 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- --
......@@ -44,7 +44,7 @@ package Symbols is
-- all symbols are already found in the reference file or with an
-- incremented minor ID, if not.
Controlled,
Controlled,
-- Fail if symbols are not the same as those in the reference file
Restricted);
......@@ -86,11 +86,20 @@ package Symbols is
-- Processing any object file. Depending on the platforms and the
-- circumstances, additional messages may be issued if Quiet is False.
procedure Process
(Object_File : String;
Success : out Boolean);
-- Get the symbols from an object file. Success is set to True if the
-- object file exists and has the expected format.
package Processing is
-- This package, containing a single visible procedure Process, exists so
-- that it can be a subunits, for some platforms (such as VMS Alpha and
-- IA64), the body of package Symbols is common, while the subunit
-- Processing is not.
procedure Process
(Object_File : String;
Success : out Boolean);
-- Get the symbols from an object file. Success is set to True if the
-- object file exists and has the expected format.
end Processing;
procedure Finalize
(Quiet : Boolean;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment